{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DoAndIfThenElse #-}
-- |
-- 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
  , done
  , peek8, poke8, peek8_32
  , reChunkIn
  , Padding(..)
  ) where

import Data.Bits ((.|.), (.&.), shiftL, shiftR)
import qualified Data.ByteString as B
import Data.ByteString.Internal (ByteString(..), mallocByteString)
import Data.Word (Word8, Word16, Word32)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr)
import Foreign.Ptr (Ptr, castPtr, minusPtr, plusPtr)
import Foreign.Storable (peek, peekElemOff, poke, peekByteOff)
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


data Padding = Padded | Don'tCare | Unpadded deriving Padding -> Padding -> Bool
(Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool) -> Eq Padding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Padding -> Padding -> Bool
$c/= :: Padding -> Padding -> Bool
== :: Padding -> Padding -> Bool
$c== :: Padding -> Padding -> Bool
Eq

-- | Encode a string into base64 form.  The result will always be a multiple
-- of 4 bytes in length.
encodeWith :: Padding -> EncodeTable -> ByteString -> ByteString
encodeWith :: Padding -> EncodeTable -> ByteString -> ByteString
encodeWith !Padding
padding (ET ForeignPtr Word8
alfaFP ForeignPtr Word16
encodeTable) (PS ForeignPtr Word8
sfp Int
soff 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` Int
4 =
        [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"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
+ Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
  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
alfaFP ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
aptr ->
    ForeignPtr Word16 -> (Ptr Word16 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word16
encodeTable ((Ptr Word16 -> IO ByteString) -> IO ByteString)
-> (Ptr Word16 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ep ->
      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 aidx :: Int -> IO Word8
aidx 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)
            finish :: Int -> m ByteString
finish !Int
n = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 Int
n)
            fill :: Ptr Word16 -> Ptr Word8 -> Int -> IO ByteString
fill !Ptr Word16
dp !Ptr Word8
sp !Int
n
              | Ptr Word8
sp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 Ptr Any -> Ptr Any -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Any
forall b. Ptr b
sEnd = Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
forall b. Ptr Word8 -> Ptr b -> Int -> IO ByteString
complete (Ptr Word16 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
dp) Ptr Word8
sp Int
n
              | 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` Int
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` Int
2)
              let w :: Word32
w = (Word32
i Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
j Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
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` Int
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` Int
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
.&. Word32
0xfff)
              Ptr Word16 -> Ptr Word8 -> Int -> IO ByteString
fill (Ptr Word16
dp Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Ptr Word8
sp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            complete :: Ptr Word8 -> Ptr b -> Int -> IO ByteString
complete Ptr Word8
dp Ptr b
sp Int
n
                | Ptr b
sp Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr b
forall b. Ptr b
sEnd = Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish Int
n
                | Bool
otherwise  = {-# SCC "encode/complete" #-} do
              let peekSP :: Int -> (b -> b) -> IO b
peekSP Int
m 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
m)
                  twoMore :: Bool
twoMore    = Ptr b
sp Ptr b -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall b. Ptr b
sEnd
                  equals :: Word8
equals     = Word8
0x3d :: Word8
                  doPad :: Bool
doPad = Padding
padding Padding -> Padding -> Bool
forall a. Eq a => a -> a -> Bool
== Padding
Padded
                  {-# INLINE equals #-}
              !Int
a <- Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP Int
0 ((Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
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
.&. Int
0xfc))
              !Int
b <- Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP Int
0 ((Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
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
.&. Int
0x03))

              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

              if Bool
twoMore
                then do
                  !Int
b' <- Int -> (Int -> Int) -> IO Int
forall b b. Num b => Int -> (b -> b) -> IO b
peekSP Int
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` Int
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
.&. Int
0xf0))
                  !Word8
c <- 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 Int
1 ((Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
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
.&. Int
0x0f))
                  Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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'
                  Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
c

                  if Bool
doPad
                    then Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) Word8
equals IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
                    else Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                else do
                  Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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

                  if Bool
doPad
                    then do
                      Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) Word8
equals
                      Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8
dp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3) Word8
equals
                      Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
                    else Int -> IO ByteString
forall (m :: * -> *). Monad m => Int -> m ByteString
finish (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)


        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
$ \Ptr Word8
dptr ->
          Ptr Word16 -> Ptr Word8 -> Int -> IO ByteString
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) Int
0

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 ForeignPtr Word8
afp Int
_ Int
_) =
    case ByteString
table of PS ForeignPtr Word8
fp Int
_ Int
_ -> 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 <- [Int
0..Int
63], Int
k <- [Int
0..Int
63] ]

-- | 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 :: Padding -> ForeignPtr Word8 -> ByteString -> Either String ByteString
decodeWithTable :: Padding
-> ForeignPtr Word8 -> ByteString -> Either [Char] ByteString
decodeWithTable Padding
_ ForeignPtr Word8
_ (PS ForeignPtr Word8
_ Int
_ Int
0) = ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right ByteString
B.empty
decodeWithTable Padding
padding ForeignPtr Word8
decodeFP bs :: ByteString
bs@(PS !ForeignPtr Word8
fp !Int
o !Int
l) = 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
$
   case Padding
padding of
     Padding
Padded
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> [Char] -> IO (Either [Char] ByteString)
forall a b. a -> IO (Either a b)
err [Char]
"Base64-encoded bytestring has invalid size"
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 -> [Char] -> IO (Either [Char] ByteString)
forall a b. a -> IO (Either a b)
err [Char]
"Base64-encoded bytestring required to be padded"
       | Bool
otherwise -> ByteString -> IO (Either [Char] ByteString)
go ByteString
bs
     Padding
Don'tCare
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> ByteString -> IO (Either [Char] ByteString)
go ByteString
bs
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> ByteString -> IO (Either [Char] ByteString)
go (ByteString -> ByteString -> ByteString
B.append ByteString
bs (Int -> Word8 -> ByteString
B.replicate Int
2 Word8
0x3d))
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 -> ByteString -> IO (Either [Char] ByteString)
go (ByteString -> ByteString -> ByteString
B.append ByteString
bs (Int -> Word8 -> ByteString
B.replicate Int
1 Word8
0x3d))
       | Bool
otherwise -> [Char] -> IO (Either [Char] ByteString)
forall a b. a -> IO (Either a b)
err [Char]
"Base64-encoded bytestring has invalid size"
     Padding
Unpadded
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> IO (Either [Char] ByteString) -> IO (Either [Char] ByteString)
forall b. IO (Either [Char] b) -> IO (Either [Char] b)
validateUnpadded (ByteString -> IO (Either [Char] ByteString)
go ByteString
bs)
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> IO (Either [Char] ByteString) -> IO (Either [Char] ByteString)
forall b. IO (Either [Char] b) -> IO (Either [Char] b)
validateUnpadded (ByteString -> IO (Either [Char] ByteString)
go (ByteString -> ByteString -> ByteString
B.append ByteString
bs (Int -> Word8 -> ByteString
B.replicate Int
2 Word8
0x3d)))
       | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 -> IO (Either [Char] ByteString) -> IO (Either [Char] ByteString)
forall b. IO (Either [Char] b) -> IO (Either [Char] b)
validateUnpadded (ByteString -> IO (Either [Char] ByteString)
go (ByteString -> ByteString -> ByteString
B.append ByteString
bs (Int -> Word8 -> ByteString
B.replicate Int
1 Word8
0x3d)))
       | Bool
otherwise -> [Char] -> IO (Either [Char] ByteString)
forall a b. a -> IO (Either a b)
err [Char]
"Base64-encoded bytestring has invalid size"
  where
    err :: a -> IO (Either a b)
err = 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

    (Int
q, Int
r) = (ByteString -> Int
B.length ByteString
bs) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4

    dlen :: Int
dlen = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3

    validateUnpadded :: IO (Either [Char] b) -> IO (Either [Char] b)
validateUnpadded IO (Either [Char] b)
io = ForeignPtr Word8
-> (Ptr Word8 -> IO (Either [Char] b)) -> IO (Either [Char] b)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (Either [Char] b)) -> IO (Either [Char] b))
-> (Ptr Word8 -> IO (Either [Char] b)) -> IO (Either [Char] b)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
      let !end :: Int
end = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o
      Word8
a <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
      Word8
b <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2))

      let !pad :: Word8
pad = Word8
0x3d :: Word8
      if Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
pad Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
pad
      then [Char] -> IO (Either [Char] b)
forall a b. a -> IO (Either a b)
err [Char]
"Base64-encoded bytestring required to be unpadded"
      else IO (Either [Char] b)
io

    go :: ByteString -> IO (Either [Char] ByteString)
go (PS !ForeignPtr Word8
sfp !Int
soff !Int
slen) = 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 ->
        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 ->
        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
$ \Ptr Word8
dptr ->
          Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> ForeignPtr Word8
-> IO (Either [Char] ByteString)
decodeLoop Ptr Word8
decptr (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
sptr Int
soff) Ptr Word8
dptr (Ptr Word8
sptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
soff)) ForeignPtr Word8
dfp

decodeLoop
    :: Ptr Word8
      -- ^ decoding table pointer
    -> Ptr Word8
      -- ^ source pointer
    -> Ptr Word8
      -- ^ destination pointer
    -> Ptr Word8
      -- ^ source end pointer
    -> ForeignPtr Word8
      -- ^ destination foreign pointer (used for finalizing string)
    -> IO (Either String ByteString)
decodeLoop :: Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> ForeignPtr Word8
-> IO (Either [Char] ByteString)
decodeLoop !Ptr Word8
dtable !Ptr Word8
sptr !Ptr Word8
dptr !Ptr Word8
end !ForeignPtr Word8
dfp = Ptr Word8 -> Ptr Word8 -> IO (Either [Char] ByteString)
go Ptr Word8
dptr Ptr Word8
sptr
  where
    err :: Ptr a -> m (Either [Char] b)
err Ptr a
p = Either [Char] b -> m (Either [Char] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] b -> m (Either [Char] b))
-> ([Char] -> Either [Char] b) -> [Char] -> m (Either [Char] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] b
forall a b. a -> Either a b
Left
      ([Char] -> m (Either [Char] b)) -> [Char] -> m (Either [Char] b)
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid character at offset: "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Ptr a
p Ptr a -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)

    padErr :: Ptr a -> m (Either [Char] b)
padErr Ptr a
p =  Either [Char] b -> m (Either [Char] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] b -> m (Either [Char] b))
-> ([Char] -> Either [Char] b) -> [Char] -> m (Either [Char] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] b
forall a b. a -> Either a b
Left
      ([Char] -> m (Either [Char] b)) -> [Char] -> m (Either [Char] b)
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid padding at offset: "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Ptr a
p Ptr a -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)

    look :: Ptr Word8 -> IO Word32
    look :: Ptr Word8 -> IO Word32
look !Ptr Word8
p = do
      !Word8
i <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
0 :: IO Word8
      !Word8
v <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
dtable (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i) :: IO Word8
      Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v)

    go :: Ptr Word8 -> Ptr Word8 -> IO (Either [Char] ByteString)
go !Ptr Word8
dst !Ptr Word8
src
      | Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
4 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end = do
        !Word32
a <- Ptr Word8 -> IO Word32
look Ptr Word8
src
        !Word32
b <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        !Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
        !Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
        Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either [Char] ByteString)
forall a.
Ptr Word8
-> Ptr a
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either [Char] ByteString)
finalChunk Ptr Word8
dst Ptr Word8
src Word32
a Word32
b Word32
c Word32
d

      | Bool
otherwise = do
        !Word32
a <- Ptr Word8 -> IO Word32
look Ptr Word8
src
        !Word32
b <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        !Word32
c <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
        !Word32
d <- Ptr Word8 -> IO Word32
look (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
        Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either [Char] ByteString)
decodeChunk Ptr Word8
dst Ptr Word8
src Word32
a Word32
b Word32
c Word32
d

    -- | Decodes chunks of 4 bytes at a time, recombining into
    -- 3 bytes. Note that in the inner loop stage, no padding
    -- characters are admissible.
    --
    decodeChunk :: Ptr Word8
-> Ptr Word8
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either [Char] ByteString)
decodeChunk !Ptr Word8
dst !Ptr Word8
src !Word32
a !Word32
b !Word32
c !Word32
d
     | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Word8 -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
padErr Ptr Word8
src
     | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
padErr (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
     | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
padErr (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
     | Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
padErr (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
     | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Word8 -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err Ptr Word8
src
     | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
     | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
     | Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
3)
     | Bool
otherwise = do
       let !w :: Word32
w = ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
a Int
18)
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
b Int
12)
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
c Int
6)
             Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d) :: Word32

       Ptr Word8 -> Word8 -> IO ()
poke8 Ptr Word8
dst (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16))
       Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8))
       Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
       Ptr Word8 -> Ptr Word8 -> IO (Either [Char] ByteString)
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
3) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
4)

    -- | Decode the final 4 bytes in the string, recombining into
    -- 3 bytes. Note that in this stage, we can have padding chars
    -- but only in the final 2 positions.
    --
    finalChunk :: Ptr Word8
-> Ptr a
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Either [Char] ByteString)
finalChunk !Ptr Word8
dst !Ptr a
src Word32
a Word32
b Word32
c Word32
d
      | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr a -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
padErr Ptr a
src
      | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
padErr (Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
src Int
1)
      | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 Bool -> Bool -> Bool
&& Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0x63 = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
src Int
3) -- make sure padding is coherent.
      | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr a -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err Ptr a
src
      | Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
src Int
1)
      | Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
src Int
2)
      | Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xff = Ptr Any -> IO (Either [Char] ByteString)
forall (m :: * -> *) a b. Monad m => Ptr a -> m (Either [Char] b)
err (Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
src Int
3)
      | Bool
otherwise = do
        let !w :: Word32
w = ((Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
a Int
18)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
b Int
12)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
c Int
6)
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d) :: Word32

        Ptr Word8 -> Word8 -> IO ()
poke8 Ptr Word8
dst (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16))

        if Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63 Bool -> Bool -> Bool
&& Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63
        then Either [Char] ByteString -> IO (Either [Char] ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Ptr Word8
dst Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
        else if Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x63
          then do
            Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8))
            Either [Char] ByteString -> IO (Either [Char] ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Ptr Word8
dst Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))
          else do
            Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8))
            Ptr Word8 -> Word8 -> IO ()
poke8 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)
            Either [Char] ByteString -> IO (Either [Char] ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
0 (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Ptr Word8
dst Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr))


-- | 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 ForeignPtr Word8
decodeFP (PS ForeignPtr Word8
sfp Int
soff Int
slen)
    | Int
dlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 Int
dbytes
              | Int
dbytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
dfp Int
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 Bool
skipPad Ptr Word8
p0 Ptr Word8 -> Word32 -> IO ByteString
f = Ptr Word8 -> IO ByteString
go Ptr Word8
p0
                  where
                    go :: Ptr Word8 -> IO ByteString
go 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` (-Int
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` Int
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` Int
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` Int
18) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
bValue Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
12) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                              (Word32
cValue Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
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` Int
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
+ Int
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` Int
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` Int
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
+ Int
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` Int
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` Int
3) Ptr Word8
dNext (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
$ \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) Int
0
  where dlen :: Int
dlen = ((Int
slen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3

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

done :: Integral a => a
done :: a
done = a
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 (ByteString
y : [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
                    (Int
_, Int
0) -> ByteString
y ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
go [ByteString]
ys
                    (Int
d, Int
_) -> case Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) ByteString
y of
                                (ByteString
prefix, 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 ByteString
acc [] = [ByteString
acc]
    fixup ByteString
acc (ByteString
z : [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
                           (ByteString
prefix, 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