    {-# LANGUAGE ForeignFunctionInterface #-}

    -- |
    -- Module: Codec.Binary.Base85
    -- Copyright: (c) 2012 Magnus Therning
    -- License: BSD3
    --
    -- Implemented as described at <http://en.wikipedia.org/wiki/Ascii85>.
    module Codec.Binary.Base85
       ( b85EncodePart
       , b85EncodeFinal
       , b85DecodePart
       , b85DecodeFinal
       , encode
       , decode
       ) where

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

    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 b85.h b85_enc_part"
        c_b85_enc_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO ()

    foreign import ccall "static b85.h b85_enc_final"
        c_b85_enc_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt

    foreign import ccall "static b85.h b85_dec_part"
        c_b85_dec_part :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt

    foreign import ccall "static b85.h b85_dec_final"
        c_b85_dec_final :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt

    -- | Encoding function.
    --
    -- Encodes as large a part as possible of the indata.
    --
    -- >>> b85EncodePart $ Data.ByteString.Char8.pack "foobar"
    -- ("AoDTs","ar")
    --
    -- It supports special handling of both all-zero groups and all-space groups.
    --
    -- >>> b85EncodePart $ Data.ByteString.Char8.pack "    "
    -- ("y", "")
    -- >>> b85EncodePart $ Data.ByteString.Char8.pack "\0\0\0\0"
    -- ("z", "")
    b85EncodePart :: BS.ByteString -> (BS.ByteString, BS.ByteString)
    b85EncodePart :: ByteString -> (ByteString, ByteString)
    b85EncodePart ByteString
    bs = IO (ByteString, ByteString) -> (ByteString, ByteString)
    forall a. IO a -> a
    U.unsafePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
    -> IO (ByteString, ByteString) -> (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> (CStringLen -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (CStringLen -> IO (ByteString, ByteString))
    -> IO (ByteString, 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. Integral a => a -> a -> a
    `div` Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    5
        outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    maxOutLen
        alloca $ \ Ptr CSize
    pOutLen ->
            (Ptr (Ptr Word8) -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr (Ptr Word8) -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (Ptr (Ptr Word8) -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ Ptr (Ptr Word8)
    pRemBuf ->
                (Ptr CSize -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (Ptr CSize -> IO (ByteString, ByteString))
    -> IO (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
    maxOutLen)
                    Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO ()
    c_b85_enc_part (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
                    outLen <- Ptr CSize -> IO CSize
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CSize
    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)
                    return (outBs, remBs)

    -- | Encoding function for the final block.
    --
    -- >>> b85EncodeFinal $ Data.ByteString.Char8.pack "ar"
    -- Just "@<)"
    b85EncodeFinal :: BS.ByteString -> Maybe BS.ByteString
    b85EncodeFinal :: ByteString -> Maybe ByteString
    b85EncodeFinal ByteString
    bs = IO (Maybe ByteString) -> Maybe ByteString
    forall a. IO a -> a
    U.unsafePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
    -> IO (Maybe ByteString) -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
    -> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ (Ptr CChar
    inBuf, Int
    inLen) -> do
        outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    5
        alloca $ \ Ptr CSize
    pOutLen -> do
            r <- Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
    c_b85_enc_final (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
            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

    -- | Decoding function.
    --
    -- Decode as large a portion of the input as possible.
    --
    -- >>> b85DecodePart $ Data.ByteString.Char8.pack "AoDTs"
    -- Right ("foob","")
    -- >>> b85DecodePart $ Data.ByteString.Char8.pack "AoDTs@<)"
    -- Right ("foob","@<)")
    -- >>> b85DecodePart $ Data.ByteString.Char8.pack "@<)"
    -- Right ("","@<)")
    --
    -- At least 512 bytes of data is allocated for the output, but because of the
    -- special handling of all-zero and all-space groups it is possible that the
    -- space won't be enough.  (To be sure to always fit the output one would have
    -- to allocate 5 times the length of the input.  It seemed a good trade-off to
    -- sometimes have to call the function more than once instead.)
    --
    -- >>> either snd snd $ b85DecodePart $ Data.ByteString.Char8.pack $ Prelude.take 129 $ repeat 'y'
    -- "y"
    b85DecodePart :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString)
    b85DecodePart :: ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    b85DecodePart 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
    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
        let maxOutLen :: Int
    maxOutLen = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    512 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    inLen Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    5 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4
        outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    maxOutLen
        alloca $ \ 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
    maxOutLen)
                    r <- Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO CInt
    c_b85_dec_part (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
                    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)

    -- | Decoding function for the final block.
    --
    -- >>> b85DecodeFinal $ Data.ByteString.Char8.pack "@<)"
    -- Just "ar"
    -- >>> b85DecodeFinal $ Data.ByteString.Char8.pack ""
    -- Just ""
    -- >>> b85DecodeFinal $ Data.ByteString.Char8.pack "AoDTs"
    -- Nothing
    b85DecodeFinal :: BS.ByteString -> Maybe BS.ByteString
    b85DecodeFinal :: ByteString -> Maybe ByteString
    b85DecodeFinal ByteString
    bs = IO (Maybe ByteString) -> Maybe ByteString
    forall a. IO a -> a
    U.unsafePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
    -> IO (Maybe ByteString) -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
    -> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ (Ptr CChar
    inBuf, Int
    inLen) -> do
        outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    4
        alloca $ \ Ptr CSize
    pOutLen -> do
            r <- Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
    c_b85_dec_final (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
            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

    -- | Convenience function that combines 'b85_encode_part' and
    -- 'b85_encode_final' to encode a complete string.
    --
    -- >>> encode  $ Data.ByteString.Char8.pack "foob"
    -- "AoDTs"
    -- >>> encode  $ Data.ByteString.Char8.pack "foobar"
    -- "AoDTs@<)"
    encode :: BS.ByteString -> BS.ByteString
    encode :: ByteString -> ByteString
    encode ByteString
    bs = ByteString
    first ByteString -> ByteString -> ByteString
    `BS.append` ByteString
    final
        where
            (ByteString
    first, ByteString
    rest) = ByteString -> (ByteString, ByteString)
    b85EncodePart ByteString
    bs
            Just ByteString
    final = ByteString -> Maybe ByteString
    b85EncodeFinal ByteString
    rest

    -- | Convenience function that combines 'b85_decode_part' and
    -- 'b85_decode_final' to decode a complete string.
    --
    -- >>> decode  $ Data.ByteString.Char8.pack "AoDTs"
    -- "foob"
    -- >>> encode  $ Data.ByteString.Char8.pack "AoDTs@<)"
    -- "foobar"
    decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString
    decode :: ByteString -> Either (ByteString, ByteString) ByteString
    decode ByteString
    bs = ((ByteString, ByteString)
     -> Either (ByteString, ByteString) ByteString)
    -> ((ByteString, ByteString)
        -> Either (ByteString, ByteString) ByteString)
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    handleFinal ([ByteString]
    -> ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    iterateDecode [] ByteString
    bs)
        where
            iterateDecode :: [ByteString]
    -> ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    iterateDecode [ByteString]
    bss ByteString
    re = case ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    b85DecodePart ByteString
    re of
                Right (ByteString
    d, ByteString
    r) ->
                    if ByteString -> Bool
    BS.null ByteString
    d
                        then (ByteString, ByteString)
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a b. b -> Either a b
    Right ([ByteString] -> ByteString
    BS.concat ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse [ByteString]
    bss), ByteString
    r)
                        else [ByteString]
    -> ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    iterateDecode (ByteString
    d ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : [ByteString]
    bss) ByteString
    r
                Left (ByteString
    d, ByteString
    r) -> (ByteString, ByteString)
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a b. a -> Either a b
    Left ([ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ ByteString
    d ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : [ByteString]
    bss, ByteString
    r)

            handleFinal :: (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    handleFinal a :: (ByteString, ByteString)
    a@(ByteString
    first, ByteString
    rest) = Either (ByteString, ByteString) ByteString
    -> (ByteString -> Either (ByteString, ByteString) ByteString)
    -> Maybe ByteString
    -> Either (ByteString, ByteString) ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                ((ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString, ByteString)
    a)
                (\ ByteString
    final -> ByteString -> Either (ByteString, ByteString) ByteString
    forall a b. b -> Either a b
    Right (ByteString
    first ByteString -> ByteString -> ByteString
    `BS.append` ByteString
    final))
                (ByteString -> Maybe ByteString
    b85DecodeFinal ByteString
    rest)