    {-# LANGUAGE ForeignFunctionInterface #-}

    -- |
    -- Module: Codec.Binary.Base16
    -- Copyright: (c) 2012 Magnus Therning
    -- License: BSD3
    --
    -- Implemention of base 16 encoding (hex encoding) as specified in RFC 4648
    -- (<http://tools.ietf.org/html/rfc4648>).
    module Codec.Binary.Base16
        ( b16Enc
        , b16Dec
        , encode
        , decode
        ) where

    import Foreign
    import Foreign.C.Types
    import System.IO.Unsafe as U
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Unsafe as BSU

    castEnum :: (Enum a, Enum b) => a -> b
    castEnum :: forall a b. (Enum a, Enum b) => a -> b
    castEnum = Int -> b
    forall a. Enum a => Int -> a
    toEnum (Int -> b) -> (a -> Int) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Int
    forall a. Enum a => a -> Int
    fromEnum

    foreign import ccall "static b16.h b16_enc"
        c_b16_enc :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO ()

    foreign import ccall "static b16.h b16_dec"
        c_b16_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt

    -- | Encoding function.
    --
    -- This function, unlike some other encoding functions in the library, simply
    -- cannot fail.  Double the length of the input string is allocated for the
    -- encoded data, which is guaranteed to hold the result.
    --
    -- >>> b16Enc $ Data.ByteString.pack [0x00]
    -- "00"
    --
    -- >>> b16Enc $ Data.ByteString.Char8.pack "foobar"
    -- "666F6F626172"
    b16Enc :: BS.ByteString
        -> BS.ByteString -- ^ The encoded string
    b16Enc :: ByteString -> ByteString
    b16Enc ByteString
    bs = IO ByteString -> ByteString
    forall a. IO a -> a
    U.unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BSU.unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO ByteString) -> IO ByteString)
    -> (CStringLen -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ (Ptr CChar
    inBuf, Int
    inLen) -> do
        let maxOutLen :: Int
    maxOutLen = Int
    inLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2
        Ptr Word8
    outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    maxOutLen
        (Ptr CSize -> IO ByteString) -> IO ByteString
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
    -> (Ptr CSize -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ Ptr CSize
    pOutLen ->
            (Ptr (Ptr Word8) -> IO ByteString) -> IO ByteString
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr (Ptr Word8) -> IO ByteString) -> IO ByteString)
    -> (Ptr (Ptr Word8) -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ Ptr (Ptr Word8)
    pRemBuf ->
                (Ptr CSize -> IO ByteString) -> IO ByteString
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
    -> (Ptr CSize -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ Ptr CSize
    pRemLen -> do
                    Ptr CSize -> CSize -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CSize
    pOutLen (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    maxOutLen)
                    Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO ()
    c_b16_enc (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    inBuf) (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    inLen) Ptr Word8
    outBuf Ptr CSize
    pOutLen Ptr (Ptr Word8)
    pRemBuf Ptr CSize
    pRemLen
                    CSize
    outLen <- Ptr CSize -> IO CSize
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CSize
    pOutLen
                    Ptr Word8 -> Int -> IO () -> IO ByteString
    BSU.unsafePackCStringFinalizer Ptr Word8
    outBuf (CSize -> Int
    forall a b. (Enum a, Enum b) => a -> b
    castEnum CSize
    outLen) (Ptr Word8 -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr Word8
    outBuf)

    -- | Decoding function.
    --
    -- The returned value on success is @Right (\<decoded part>, \<undecoded
    -- part>)@ (the undecoded part is either a empty or a single byte), and on
    -- failure it's @Left (\<decoded part\>, \<undecodable part>)@.  Space equal to
    -- the length of the input string is allocated, which is more than enough to
    -- hold the decoded data.
    --
    -- >>> b16Dec $ Data.ByteString.Char8.pack "00"
    -- Right ("\NUL","")
    --
    -- >>> b16Dec $ Data.ByteString.Char8.pack "666F6F626172"
    -- Right ("foobar","")
    --
    -- >>> b16Dec $ Data.ByteString.Char8.pack "666F6F62617"
    -- Right ("fooba","7")
    -- >>> b16Dec $ Data.ByteString.Char8.pack "666F6F62617g"
    -- Left ("fooba","g")
    b16Dec :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString)
    b16Dec :: ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    b16Dec ByteString
    bs = IO (Either (ByteString, ByteString) (ByteString, ByteString))
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a. IO a -> a
    U.unsafePerformIO (IO (Either (ByteString, ByteString) (ByteString, ByteString))
     -> Either (ByteString, ByteString) (ByteString, ByteString))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> (CStringLen
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BSU.unsafeUseAsCStringLen ByteString
    bs ((CStringLen
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (CStringLen
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ (Ptr CChar
    inBuf, Int
    inLen) -> do
        Ptr Word8
    outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    inLen
        (Ptr CSize
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (Ptr CSize
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ Ptr CSize
    pOutLen ->
            (Ptr (Ptr Word8)
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr (Ptr Word8)
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (Ptr (Ptr Word8)
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ Ptr (Ptr Word8)
    pRemBuf ->
                (Ptr CSize
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (Ptr CSize
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ Ptr CSize
    pRemLen -> do
                    Ptr CSize -> CSize -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CSize
    pOutLen (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    inLen)
                    CInt
    r <- Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO CInt
    c_b16_dec (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    inBuf) (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    inLen) Ptr Word8
    outBuf Ptr CSize
    pOutLen Ptr (Ptr Word8)
    pRemBuf Ptr CSize
    pRemLen
                    CSize
    outLen <- Ptr CSize -> IO CSize
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CSize
    pOutLen
                    Ptr Word8
    newOutBuf <- Ptr Word8 -> Int -> IO (Ptr Word8)
    forall a. Ptr a -> Int -> IO (Ptr a)
    reallocBytes Ptr Word8
    outBuf (CSize -> Int
    forall a b. (Enum a, Enum b) => a -> b
    castEnum CSize
    outLen)
                    Ptr Word8
    remBuf <- Ptr (Ptr Word8) -> IO (Ptr Word8)
    forall a. Storable a => Ptr a -> IO a
    peek Ptr (Ptr Word8)
    pRemBuf
                    CSize
    remLen <- Ptr CSize -> IO CSize
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CSize
    pRemLen
                    ByteString
    remBs <- CStringLen -> IO ByteString
    BS.packCStringLen (Ptr Word8 -> Ptr CChar
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    remBuf, CSize -> Int
    forall a b. (Enum a, Enum b) => a -> b
    castEnum CSize
    remLen)
                    ByteString
    outBs <- Ptr Word8 -> Int -> IO () -> IO ByteString
    BSU.unsafePackCStringFinalizer Ptr Word8
    newOutBuf (CSize -> Int
    forall a b. (Enum a, Enum b) => a -> b
    castEnum CSize
    outLen) (Ptr Word8 -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr Word8
    newOutBuf)
                    if CInt
    r CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    == CInt
    0
                        then Either (ByteString, ByteString) (ByteString, ByteString)
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (ByteString, ByteString) (ByteString, ByteString)
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ (ByteString, ByteString)
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a b. b -> Either a b
    Right (ByteString
    outBs, ByteString
    remBs)
                        else Either (ByteString, ByteString) (ByteString, ByteString)
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (ByteString, ByteString) (ByteString, ByteString)
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ (ByteString, ByteString)
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a b. a -> Either a b
    Left (ByteString
    outBs, ByteString
    remBs)

    -- | A synonym for 'b16_enc'.
    encode :: BS.ByteString -> BS.ByteString
    encode :: ByteString -> ByteString
    encode = ByteString -> ByteString
    b16Enc

    -- | A synonum for 'b16_dec'.
    decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString
    decode :: ByteString -> Either (ByteString, ByteString) ByteString
    decode ByteString
    bs = case ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    b16Dec ByteString
    bs of
        Right a :: (ByteString, ByteString)
    a@(ByteString
    d, ByteString
    r) -> if ByteString -> Bool
    BS.null ByteString
    r
                then ByteString -> Either (ByteString, ByteString) ByteString
    forall a b. b -> Either a b
    Right ByteString
    d
                else (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString, ByteString)
    a
        Left (ByteString, ByteString)
    a -> (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString, ByteString)
    a