module Codec.Binary.Base64Url
( b64u_encode_part
, b64u_encode_final
, b64u_decode_part
, b64u_decode_final
, encode
, decode
) where
import Foreign
import Foreign.C.Types
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe
import System.IO.Unsafe as U
castEnum :: (Enum a, Enum b) => a -> b
castEnum = toEnum . fromEnum
foreign import ccall "static b64.h b64u_enc_part"
c_b64u_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO ()
foreign import ccall "static b64.h b64u_enc_final"
c_b64u_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
foreign import ccall "static b64.h b64u_dec_part"
c_b64u_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt
foreign import ccall "static b64.h b64u_dec_final"
c_b64u_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
b64u_encode_part :: BS.ByteString -> (BS.ByteString, BS.ByteString)
b64u_encode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do
let maxOutLen = inLen `div` 3 * 4
outBuf <- mallocBytes maxOutLen
alloca $ \ pOutLen ->
alloca $ \ pRemBuf ->
alloca $ \ pRemLen -> do
poke pOutLen (castEnum maxOutLen)
c_b64u_enc_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen
outLen <- peek pOutLen
remBuf <- peek pRemBuf
remLen <- peek pRemLen
remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen)
outBs <- unsafePackCStringFinalizer outBuf (castEnum outLen) (free outBuf)
return (outBs, remBs)
b64u_encode_final :: BS.ByteString -> Maybe BS.ByteString
b64u_encode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do
outBuf <- mallocBytes 4
alloca $ \ pOutLen -> do
r <- c_b64u_enc_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen
if r == 0
then do
outLen <- peek pOutLen
newOutBuf <- reallocBytes outBuf (castEnum outLen)
outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf)
return $ Just outBs
else free outBuf >> return Nothing
b64u_decode_part :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString)
b64u_decode_part bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do
let maxOutLen = inLen `div` 4 * 3
outBuf <- mallocBytes maxOutLen
alloca $ \ pOutLen ->
alloca $ \ pRemBuf ->
alloca $ \ pRemLen -> do
poke pOutLen (castEnum maxOutLen)
r <- c_b64u_dec_part (castPtr inBuf) (castEnum inLen) outBuf pOutLen pRemBuf pRemLen
outLen <- peek pOutLen
newOutBuf <- reallocBytes outBuf (castEnum outLen)
remBuf <- peek pRemBuf
remLen <- peek pRemLen
remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen)
outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf)
if r == 0
then return $ Right (outBs, remBs)
else return $ Left (outBs, remBs)
b64u_decode_final :: BS.ByteString -> Maybe BS.ByteString
b64u_decode_final bs = U.unsafePerformIO $ unsafeUseAsCStringLen bs $ \ (inBuf, inLen) -> do
outBuf <- mallocBytes 3
alloca $ \ pOutLen -> do
r <- c_b64u_dec_final (castPtr inBuf) (castEnum inLen) outBuf pOutLen
if r == 0
then do
outLen <- peek pOutLen
newOutBuf <- reallocBytes outBuf (castEnum outLen)
outBs <- unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf)
return $ Just outBs
else free outBuf >> return Nothing
encode :: BS.ByteString -> BS.ByteString
encode bs = let
(first, rest) = b64u_encode_part bs
Just final = b64u_encode_final rest
in first `BS.append` final
decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString
decode bs = either
Left
(\ (first, rest) ->
maybe
(Left (first, rest))
(\ fin -> Right (first `BS.append` fin))
(b64u_decode_final rest))
(b64u_decode_part bs)