{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Data.ByteString.Base64.Internal
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Fast and efficient encoding and decoding of base64-encoded strings.

module Data.ByteString.Base64.Internal
    (
      encodeWith
    , decodeWithTable
    , decodeLenientWithTable
    , mkEncodeTable
    , joinWith
    , done
    , peek8, poke8, peek8_32
    , reChunkIn
    ) where

import Data.Bits ((.|.), (.&.), shiftL, shiftR)
import qualified Data.ByteString as B
import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy,
                                 unsafeCreate)
import Data.Word (Word8, Word16, Word32)
import Control.Exception (assert)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr)
import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr)
import Foreign.Storable (peek, peekElemOff, poke)
import System.IO.Unsafe (unsafePerformIO)

peek8 :: Ptr Word8 -> IO Word8
peek8 :: Ptr Word8 -> IO Word8
peek8 = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek

poke8 :: Ptr Word8 -> Word8 -> IO ()
poke8 :: Ptr Word8 -> Word8 -> IO ()
poke8 = Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke

peek8_32 :: Ptr Word8 -> IO Word32
peek8_32 :: Ptr Word8 -> IO Word32
peek8_32 = (Word8 -> Word32) -> IO Word8 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word8 -> IO Word32)
-> (Ptr Word8 -> IO Word8) -> Ptr Word8 -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> IO Word8
peek8

-- | Encode a string into base64 form.  The result will always be a multiple
-- of 4 bytes in length.
encodeWith :: EncodeTable -> ByteString -> ByteString
encodeWith :: EncodeTable -> ByteString -> ByteString
encodeWith (ET alfaFP :: ForeignPtr Word8
alfaFP encodeTable :: ForeignPtr Word16
encodeTable) (PS sfp :: ForeignPtr Word8
sfp soff :: Int
soff slen :: Int
slen)
    | Int
slen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4 =
        [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "Data.ByteString.Base64.encode: input too long"
    | Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  let dlen :: Int
dlen = ((Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4
  ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
dlen
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
alfaFP ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \aptr :: Ptr Word8
aptr ->
    ForeignPtr Word16 -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word16
encodeTable ((Ptr Word16 -> IO ()) -> IO ()) -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ep :: Ptr Word16
ep ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sptr :: Ptr Word8
sptr -> do
        let aidx :: Int -> IO Word8
aidx n :: Int
n = Ptr Word8 -> IO Word8
peek8 (Ptr Word8
aptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
            sEnd :: Ptr b
sEnd = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
            fill :: Ptr Word16 -> Ptr Word8 -> IO ()
fill !Ptr Word16
dp !Ptr Word8
sp
              | Ptr Word8
sp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall b. Ptr b
sEnd = Ptr Word8 -> Ptr Word8 -> IO ()
forall b. Ptr Word8 -> Ptr b -> IO ()
complete (Ptr Word16 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
dp) Ptr Word8
sp
              | Bool
otherwise = {-# SCC "encode/fill" #-} do
              Word32
i <- Ptr Word8 -> IO Word32
peek8_32 Ptr Word8
sp
              Word32
j <- Ptr Word8 -> IO Word32
peek8_32 (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1)
              Word32
k <- Ptr Word8 -> IO Word32
peek8_32 (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2)
              let w :: Word32
w = (Word32
i Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
j Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
k
                  enc :: Word32 -> IO Word16
enc = Ptr Word16 -> Int -> IO Word16
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word16
ep (Int -> IO Word16) -> (Word32 -> Int) -> Word32 -> IO Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
              Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
dp (Word16 -> IO ()) -> IO Word16 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> IO Word16
enc (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 12)
              Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word16
dp Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) (Word16 -> IO ()) -> IO Word16 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> IO Word16
enc (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0xfff)
              Ptr Word16 -> Ptr Word8 -> IO ()
fill (Ptr Word16
dp Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 3)
            complete :: Ptr Word8 -> Ptr b -> IO ()
complete dp :: Ptr Word8
dp sp :: Ptr b
sp
                | Ptr b
sp Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr b
forall b. Ptr b
sEnd = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise  = {-# SCC "encode/complete" #-} do
              let peekSP :: Int -> (b -> b) -> IO b
peekSP n :: Int
n f :: b -> b
f = (b -> b
f (b -> b) -> (Word8 -> b) -> Word8 -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8 -> b) -> IO Word8 -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Word8
peek8 (Ptr b
sp Ptr b -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
                  twoMore :: Bool
twoMore    = Ptr b
sp Ptr b -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2 Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall b. Ptr b
sEnd
                  equals :: Word8
equals     = 0x3d :: Word8
                  {-# INLINE equals #-}
              !Int
a <- Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP 0 ((Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 2) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xfc))
              !Int
b <- Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP 0 ((Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 4) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x03))
              !Int
b' <- if Bool
twoMore
                     then Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP 1 ((Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 4) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xf0))
                     else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
b
              Ptr Word8 -> Word8 -> IO ()
poke8 Ptr Word8
dp (Word8 -> IO ()) -> IO Word8 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Word8
aidx Int
a
              Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Word8 -> IO ()) -> IO Word8 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Word8
aidx Int
b'
              !Word8
c <- if Bool
twoMore
                    then Int -> IO Word8
aidx (Int -> IO Word8) -> IO Int -> IO Word8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP 1 ((Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 2) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x0f))
                    else Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
equals
              Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) Word8
c
              Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 3) Word8
equals
        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Word8
dptr ->
          Ptr Word16 -> Ptr Word8 -> IO ()
fill (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dptr) (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff)
  ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp 0 Int
dlen

data EncodeTable = ET !(ForeignPtr Word8) !(ForeignPtr Word16)

-- The encoding table is constructed such that the expansion of a 12-bit
-- block to a 16-bit block can be done by a single Word16 copy from the
-- correspoding table entry to the target address. The 16-bit blocks are
-- stored in big-endian order, as the indices into the table are built in
-- big-endian order.
mkEncodeTable :: ByteString -> EncodeTable
mkEncodeTable :: ByteString -> EncodeTable
mkEncodeTable alphabet :: ByteString
alphabet@(PS afp :: ForeignPtr Word8
afp _ _) =
    case ByteString
table of PS fp :: ForeignPtr Word8
fp _ _ -> ForeignPtr Word8 -> ForeignPtr Word16 -> EncodeTable
ET ForeignPtr Word8
afp (ForeignPtr Word8 -> ForeignPtr Word16
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fp)
  where
    ix :: Int -> Word8
ix    = Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> (Int -> Word8) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
B.index ByteString
alphabet
    table :: ByteString
table = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word8]] -> [Word8]) -> [[Word8]] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [ [Int -> Word8
ix Int
j, Int -> Word8
ix Int
k] | Int
j <- [0..63], Int
k <- [0..63] ]

-- | Efficiently intersperse a terminator string into another at
-- regular intervals, and terminate the input with it.
--
-- Examples:
--
-- > joinWith "|" 2 "----" = "--|--|"
--
-- > joinWith "\r\n" 3 "foobarbaz" = "foo\r\nbar\r\nbaz\r\n"
-- > joinWith "x" 3 "fo" = "fox"
joinWith :: ByteString  -- ^ String to intersperse and end with
         -> Int         -- ^ Interval at which to intersperse, in bytes
         -> ByteString  -- ^ String to transform
         -> ByteString
joinWith :: ByteString -> Int -> ByteString -> ByteString
joinWith brk :: ByteString
brk@(PS bfp :: ForeignPtr Word8
bfp boff :: Int
boff blen :: Int
blen) every' :: Int
every' bs :: ByteString
bs@(PS sfp :: ForeignPtr Word8
sfp soff :: Int
soff slen :: Int
slen)
    | Int
every' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error "invalid interval"
    | Int
blen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0  = ByteString
bs
    | ByteString -> Bool
B.null ByteString
bs = ByteString
brk
    | Bool
otherwise =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
dlen ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Word8
dptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \bptr :: Ptr Word8
bptr -> do
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sptr :: Ptr Word8
sptr -> do
          let bp :: Ptr b
bp = Ptr Word8
bptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
boff
              sp0 :: Ptr b
sp0 = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff
              sEnd :: Ptr b
sEnd = Ptr Any
forall b. Ptr b
sp0 Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
slen
              dLast :: Ptr b
dLast = Ptr Word8
dptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
dlen
              loop :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
loop !Ptr Word8
dp !Ptr Word8
sp !Int
written
                  | Ptr Word8
dp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
dLast = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  | Bool
otherwise = do
                let chunkSize :: Int
chunkSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
every (Ptr Any
forall b. Ptr b
sEnd Ptr Any -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sp)
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dp Ptr Word8
sp (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkSize)
                let dp' :: Ptr b
dp' = Ptr Word8
dp Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
chunkSize
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
forall b. Ptr b
dp' Ptr Word8
forall b. Ptr b
bp (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blen)
                let written' :: Int
written' = Int
written Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chunkSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blen
                Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
written' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dlen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  Ptr Word8 -> Ptr Word8 -> Int -> IO ()
loop (Ptr Any
forall b. Ptr b
dp' Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
blen) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
chunkSize) Int
written'
          Ptr Word8 -> Ptr Word8 -> Int -> IO ()
loop Ptr Word8
dptr Ptr Word8
forall b. Ptr b
sp0 0
  where dlast :: Int
dlast = Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numBreaks
        every :: Int
every = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
slen Int
every'
        dlen :: Int
dlen | Int
rmndr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0   = Int
dlast Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blen
             | Bool
otherwise   = Int
dlast
        (numBreaks :: Int
numBreaks, rmndr :: Int
rmndr) = Int
slen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
every

-- | Decode a base64-encoded string.  This function strictly follows
-- the specification in
-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>.
-- This function takes the decoding table (for @base64@ or @base64url@) as
-- the first paramert.
decodeWithTable :: ForeignPtr Word8 -> ByteString -> Either String ByteString
decodeWithTable :: ForeignPtr Word8 -> ByteString -> Either [Char] ByteString
decodeWithTable decodeFP :: ForeignPtr Word8
decodeFP (PS sfp :: ForeignPtr Word8
sfp soff :: Int
soff slen :: Int
slen)
    | Int
drem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left "invalid padding"
    | Int
dlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right ByteString
B.empty
    | Bool
otherwise = IO (Either [Char] ByteString) -> Either [Char] ByteString
forall a. IO a -> a
unsafePerformIO (IO (Either [Char] ByteString) -> Either [Char] ByteString)
-> IO (Either [Char] ByteString) -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
dlen
  ForeignPtr Word8
-> (Ptr Word8 -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
decodeFP ((Ptr Word8 -> IO (Either [Char] ByteString))
 -> IO (Either [Char] ByteString))
-> (Ptr Word8 -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
decptr -> do
    let finish :: Int -> m (Either a ByteString)
finish dbytes :: Int
dbytes = Either a ByteString -> m (Either a ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a ByteString -> m (Either a ByteString))
-> (ByteString -> Either a ByteString)
-> ByteString
-> m (Either a ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either a ByteString
forall a b. b -> Either a b
Right (ByteString -> m (Either a ByteString))
-> ByteString -> m (Either a ByteString)
forall a b. (a -> b) -> a -> b
$! if Int
dbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                                          then ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp 0 Int
dbytes
                                          else ByteString
B.empty
        bail :: a -> IO (Either a b)
bail = Either a b -> IO (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> IO (Either a b))
-> (a -> Either a b) -> a -> IO (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO (Either [Char] ByteString))
 -> IO (Either [Char] ByteString))
-> (Ptr Word8 -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
sptr -> do
      let sEnd :: Ptr b
sEnd = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
          look :: Ptr Word8 -> IO Word32
look p :: Ptr Word8
p = do
            Int
ix <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Word8
peek8 Ptr Word8
p
            Word8
v <- Ptr Word8 -> IO Word8
peek8 (Ptr Word8
decptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ix)
            Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$! Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v :: IO Word32
          fill :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Either [Char] ByteString)
fill !Ptr Word8
dp !Ptr Word8
sp !Int
n
            | Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall b. Ptr b
sEnd = Int -> IO (Either [Char] ByteString)
forall (m :: * -> *) a. Monad m => Int -> m (Either a ByteString)
finish Int
n
            | Bool
otherwise = {-# SCC "decodeWithTable/fill" #-} do
            Word32
a <- Ptr Word8 -> IO Word32
look Ptr Word8
sp
            Word32
b <- Ptr Word8 -> IO Word32
look (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1)
            Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2)
            Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 3)
            let w :: Word32
w = (Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 18) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 12) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                    (Word32
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 6) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d
            if Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done Bool -> Bool -> Bool
|| Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done
              then [Char] -> IO (Either [Char] ByteString)
forall a b. a -> IO (Either a b)
bail ([Char] -> IO (Either [Char] ByteString))
-> [Char] -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ "invalid padding near offset " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                   Int -> [Char]
forall a. Show a => a -> [Char]
show (Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)
              else if Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
x
              then [Char] -> IO (Either [Char] ByteString)
forall a b. a -> IO (Either a b)
bail ([Char] -> IO (Either [Char] ByteString))
-> [Char] -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ "invalid base64 encoding near offset " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                   Int -> [Char]
forall a. Show a => a -> [Char]
show (Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)
              else do
                Ptr Word8 -> Word8 -> IO ()
poke8 Ptr Word8
dp (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16)
                if Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done
                  then Int -> IO (Either [Char] ByteString)
forall (m :: * -> *) a. Monad m => Int -> m (Either a ByteString)
finish (Int -> IO (Either [Char] ByteString))
-> Int -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
                  else do
                    Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 8)
                    if Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done
                      then Int -> IO (Either [Char] ByteString)
forall (m :: * -> *) a. Monad m => Int -> m (Either a ByteString)
finish (Int -> IO (Either [Char] ByteString))
-> Int -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
                      else do
                        Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
                        Ptr Word8 -> Ptr Word8 -> Int -> IO (Either [Char] ByteString)
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 3) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+3)
      ForeignPtr Word8
-> (Ptr Word8 -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO (Either [Char] ByteString))
 -> IO (Either [Char] ByteString))
-> (Ptr Word8 -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Word8
dptr ->
        Ptr Word8 -> Ptr Word8 -> Int -> IO (Either [Char] ByteString)
fill Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff) 0
  where (di :: Int
di,drem :: Int
drem) = Int
slen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 4
        dlen :: Int
dlen = Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3

-- | Decode a base64-encoded string.  This function is lenient in
-- following the specification from
-- <http://tools.ietf.org/rfc/rfc4648 RFC 4648>, and will not
-- generate parse errors no matter how poor its input.  This function
-- takes the decoding table (for @base64@ or @base64url@) as the first
-- paramert.
decodeLenientWithTable :: ForeignPtr Word8 -> ByteString -> ByteString
decodeLenientWithTable :: ForeignPtr Word8 -> ByteString -> ByteString
decodeLenientWithTable decodeFP :: ForeignPtr Word8
decodeFP (PS sfp :: ForeignPtr Word8
sfp soff :: Int
soff slen :: Int
slen)
    | Int
dlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = ByteString
B.empty
    | Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr Word8
dfp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
dlen
  ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
decodeFP ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
decptr ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
sptr -> do
      let finish :: Int -> m ByteString
finish dbytes :: Int
dbytes
              | Int
dbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp 0 Int
dbytes)
              | Bool
otherwise  = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
          sEnd :: Ptr b
sEnd = Ptr Word8
sptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)
          fill :: Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
fill !Ptr Word8
dp !Ptr Word8
sp !Int
n
            | Ptr Word8
sp Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall b. Ptr b
sEnd = Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish Int
n
            | Bool
otherwise = {-# SCC "decodeLenientWithTable/fill" #-}
            let look :: Bool -> Ptr Word8
                     -> (Ptr Word8 -> Word32 -> IO ByteString)
                     -> IO ByteString
                {-# INLINE look #-}
                look :: Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
look skipPad :: Bool
skipPad p0 :: Ptr Word8
p0 f :: Ptr Word8 -> Word32 -> IO ByteString
f = Ptr Word8 -> IO ByteString
go Ptr Word8
p0
                  where
                    go :: Ptr Word8 -> IO ByteString
go p :: Ptr Word8
p | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall b. Ptr b
sEnd = Ptr Word8 -> Word32 -> IO ByteString
f (Ptr Any
forall b. Ptr b
sEnd Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-1)) Word32
forall a. Integral a => a
done
                         | Bool
otherwise = {-# SCC "decodeLenient/look" #-} do
                      Int
ix <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> IO Word8
peek8 Ptr Word8
p
                      Word8
v <- Ptr Word8 -> IO Word8
peek8 (Ptr Word8
decptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ix)
                      if Word8
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Integral a => a
x Bool -> Bool -> Bool
|| (Word8
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Integral a => a
done Bool -> Bool -> Bool
&& Bool
skipPad)
                        then Ptr Word8 -> IO ByteString
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1)
                        else Ptr Word8 -> Word32 -> IO ByteString
f (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v)
            in Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
look Bool
True Ptr Word8
sp ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
aNext !Word32
aValue ->
               Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
look Bool
True Ptr Word8
aNext ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
bNext !Word32
bValue ->
                 if Word32
aValue Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done Bool -> Bool -> Bool
|| Word32
bValue Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done
                 then Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish Int
n
                 else
                    Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
look Bool
False Ptr Word8
bNext ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
cNext !Word32
cValue ->
                    Bool
-> Ptr Word8
-> (Ptr Word8 -> Word32 -> IO ByteString)
-> IO ByteString
look Bool
False Ptr Word8
cNext ((Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ !Ptr Word8
dNext !Word32
dValue -> do
                      let w :: Word32
w = (Word32
aValue Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 18) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
bValue Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 12) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                              (Word32
cValue Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 6) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
dValue
                      Ptr Word8 -> Word8 -> IO ()
poke8 Ptr Word8
dp (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16)
                      if Word32
cValue Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done
                        then Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                        else do
                          Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 8)
                          if Word32
dValue Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Integral a => a
done
                            then Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
                            else do
                              Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
                              Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
fill (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 3) Ptr Word8
dNext (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+3)
      ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dfp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \dptr :: Ptr Word8
dptr ->
        Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
fill Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff) 0
  where dlen :: Int
dlen = ((Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3

x :: Integral a => a
x :: a
x = 255
{-# INLINE x #-}

done :: Integral a => a
done :: a
done = 99
{-# INLINE done #-}

-- This takes a list of ByteStrings, and returns a list in which each
-- (apart from possibly the last) has length that is a multiple of n
reChunkIn :: Int -> [ByteString] -> [ByteString]
reChunkIn :: Int -> [ByteString] -> [ByteString]
reChunkIn !Int
n = [ByteString] -> [ByteString]
go
  where
    go :: [ByteString] -> [ByteString]
go [] = []
    go (y :: ByteString
y : ys :: [ByteString]
ys) = case ByteString -> Int
B.length ByteString
y Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
n of
                    (_, 0) -> ByteString
y ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
go [ByteString]
ys
                    (d :: Int
d, _) -> case Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) ByteString
y of
                                (prefix :: ByteString
prefix, suffix :: ByteString
suffix) -> ByteString
prefix ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
fixup ByteString
suffix [ByteString]
ys
    fixup :: ByteString -> [ByteString] -> [ByteString]
fixup acc :: ByteString
acc [] = [ByteString
acc]
    fixup acc :: ByteString
acc (z :: ByteString
z : zs :: [ByteString]
zs) = case Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
acc) ByteString
z of
                           (prefix :: ByteString
prefix, suffix :: ByteString
suffix) ->
                             let acc' :: ByteString
acc' = ByteString
acc ByteString -> ByteString -> ByteString
`B.append` ByteString
prefix
                             in if ByteString -> Int
B.length ByteString
acc' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
                                then let zs' :: [ByteString]
zs' = if ByteString -> Bool
B.null ByteString
suffix
                                               then          [ByteString]
zs
                                               else ByteString
suffix ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
zs
                                     in ByteString
acc' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
go [ByteString]
zs'
                                else -- suffix must be null
                                    ByteString -> [ByteString] -> [ByteString]
fixup ByteString
acc' [ByteString]
zs