    {-# LANGUAGE ForeignFunctionInterface #-}

    -- |
    -- Module: Codec.Binary.QuotedPrintable
    -- Copyright: (c) 2012 Magnus Therning
    -- License: BSD3
    --
    -- Implementation of Quoted-Printable based on RFC 2045
    -- (<http://tools.ietf.org/html/rfc2045>).
    module Codec.Binary.QuotedPrintable
        ( qpEncode
        , qpEncodeSL
        , qpDecode
        , encode
        , decode
        ) where

    import Data.List
    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 :: 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 qp.h qp_enc"
        c_qp_enc :: Word8 -> Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO ()

    foreign import ccall "static qp.h qp_dec"
        c_qp_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt

    -- | Encoding function.
    --
    -- This function encodes /everything/ that is passed in, it will not try to
    -- guess the native line ending for your architecture.  In other words, if you
    -- are using this to encode text you need to split it into separate lines
    -- before encoding.
    --
    -- This function allocates enough space to hold twice the size of the indata
    -- (or at least 512 bytes) and then encodes as much as possible of the indata.
    -- That means there is a risk that the encoded data won't fit and in that case
    -- the second part of the pair contains the remainder of the indata.
    --
    -- >>> qpEncode $ Data.ByteString.Char8.pack "="
    -- ("=3D","")
    -- >>> snd $ qpEncode $ Data.ByteString.Char8.pack $ Data.List.take 171 $ repeat '='
    -- "="
    --
    -- All space (0x20) and tab (0x9) characters are encoded:
    --
    -- >>> qpEncode $ Data.ByteString.Char8.pack " \t"
    -- ("=20=09","")
    --
    -- Since the input is supposed to have been split prior to calling this
    -- function all occurances of CR and LF are encoded.
    --
    -- >>> qpEncode $ Data.ByteString.Char8.pack "\n\r\r\n\n\r"
    -- ("=0A=0D=0D=0A=0A=0D","")
    --
    -- Soft line breaks are inserted as needed
    --
    -- >>> qpEncode $ Data.ByteString.Char8.pack "========================="
    -- ("=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=\r\n=3D","")
    qpEncode :: BS.ByteString -> (BS.ByteString, BS.ByteString)
    qpEncode :: ByteString -> (ByteString, ByteString)
    qpEncode = Word8 -> ByteString -> (ByteString, ByteString)
    qpEnc' 1

    -- | Single line encoding function.
    --
    -- Like 'qpEncode', but without inserting soft line breaks.
    qpEncodeSL :: BS.ByteString -> (BS.ByteString, BS.ByteString)
    qpEncodeSL :: ByteString -> (ByteString, ByteString)
    qpEncodeSL = Word8 -> ByteString -> (ByteString, ByteString)
    qpEnc' 0

    qpEnc' :: Word8 -> BS.ByteString -> (BS.ByteString, BS.ByteString)
    qpEnc' :: Word8 -> ByteString -> (ByteString, ByteString)
    qpEnc' split :: Word8
    split bs :: 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
    BSU.unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (CStringLen -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ (inBuf :: Ptr CChar
    inBuf, inLen :: Int
    inLen) -> do
        let maxOutBuf :: Int
    maxOutBuf = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 512 (2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    inLen)
        Ptr Word8
    outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    maxOutBuf
        (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
    $ \ pOutLen :: 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
    $ \ pRemBuf :: 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
    $ \ pRemLen :: 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
    maxOutBuf)
                    Word8
    -> Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO ()
    c_qp_enc Word8
    split (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)
                    (ByteString, ByteString) -> IO (ByteString, ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString
    outBs, ByteString
    remBs)

    -- | Decoding function.
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack "foobar"
    -- Right "foobar"
    -- >>> qpDecode $ Data.ByteString.Char8.pack "1=20+=201=20=3D=202"
    -- Right "1 + 1 = 2"
    --
    -- The input data is allowed to use lowercase letters in the hexadecimal
    -- representation of an octets value, even though the standard says that only
    -- uppercase letters may be used:
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack "=3D"
    -- Right "="
    -- >>> qpDecode $ Data.ByteString.Char8.pack "=3d"
    -- Right "="
    --
    -- It also allows the input to encode _all_ octets in the hexadecimal
    -- representation:
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack "=20!"
    -- Right (" !","")
    -- >>> qpDecode $ Data.ByteString.Char8.pack "=20=21"
    -- Right (" !","")
    --
    -- A @Left@ value is only ever returned on decoding errors.
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack "=2"
    -- Right ("","=2")
    -- >>> qpDecode $ Data.ByteString.Char8.pack "=2g"
    -- Left ("","=2g")
    --
    -- Per the specification a CRLF pair is left in, but a single CR or LF is an
    -- error.
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack "\r\n"
    -- Right ("\r\n","")
    -- >>> qpDecode $ Data.ByteString.Char8.pack "\n"
    -- Left ("","\n")
    -- >>> qpDecode $ Data.ByteString.Char8.pack "\r"
    -- Left ("","\r")
    --
    -- the same goes for space and tab characters
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack " \t"
    -- Right (" \t","")
    --
    -- The function deals properly with soft line breaks.
    --
    -- >>> qpDecode $ Data.ByteString.Char8.pack " =\r\n"
    -- Right (" ","")
    qpDecode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString)
    qpDecode :: ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    qpDecode bs :: 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
    $ \ (inBuf :: Ptr CChar
    inBuf, inLen :: 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
    $ \ pOutLen :: 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
    $ \ pRemBuf :: 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
    $ \ pRemLen :: 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_qp_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
    == 0
                        then Either (ByteString, ByteString) (ByteString, ByteString)
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    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 (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)

    -- | Convenient function that calls 'qpEncode' repeatedly until the whole input
    -- data is encoded.
    encode :: BS.ByteString -> BS.ByteString
    encode :: ByteString -> ByteString
    encode = [ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Bool) -> [ByteString] -> [ByteString]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Bool
    BS.null) ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Maybe (ByteString, ByteString))
    -> ByteString -> [ByteString]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr ((ByteString, ByteString) -> Maybe (ByteString, ByteString)
    forall a. a -> Maybe a
    Just ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
    -> (ByteString -> (ByteString, ByteString))
    -> ByteString
    -> Maybe (ByteString, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> (ByteString, ByteString)
    qpEncode)

    -- | A synonym for 'qpDec'.
    decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString
    decode :: ByteString -> Either (ByteString, ByteString) ByteString
    decode = ((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
    forall b. (b, ByteString) -> Either (b, ByteString) b
    goR (Either (ByteString, ByteString) (ByteString, ByteString)
     -> Either (ByteString, ByteString) ByteString)
    -> (ByteString
        -> Either (ByteString, ByteString) (ByteString, ByteString))
    -> ByteString
    -> Either (ByteString, ByteString) ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    qpDecode
      where
        goR :: (b, ByteString) -> Either (b, ByteString) b
    goR a :: (b, ByteString)
    a@(d :: b
    d, r :: ByteString
    r) = if ByteString -> Bool
    BS.null ByteString
    r then b -> Either (b, ByteString) b
    forall a b. b -> Either a b
    Right b
    d else (b, ByteString) -> Either (b, ByteString) b
    forall a b. a -> Either a b
    Left (b, ByteString)
    a