-- |
-- Module      : Data.Memory.Encoding.Base64
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Low-level Base64 encoding and decoding.
--
-- If you just want to encode or decode some bytes, you probably want to use
-- the "Data.ByteArray.Encoding" module.
--
{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE UnboxedTuples     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE Rank2Types        #-}
module Data.Memory.Encoding.Base64
    ( toBase64
    , toBase64URL
    , toBase64OpenBSD
    , unBase64Length
    , unBase64LengthUnpadded
    , fromBase64
    , fromBase64URLUnpadded
    , fromBase64OpenBSD
    ) where

import           Control.Monad
import           Data.Memory.Internal.Compat
import           Data.Memory.Internal.CompatPrim
import           Data.Memory.Internal.Imports
import           Data.Bits ((.|.))
import           GHC.Prim
import           GHC.Word
import           Foreign.Storable
import           Foreign.Ptr (Ptr)

-- | Transform a number of bytes pointed by @src@ to base64 binary representation in @dst@
--
-- The destination memory need to be of correct size, otherwise it will lead
-- to really bad things.
toBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64 Ptr Word8
dst Ptr Word8
src Int
len = Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal Addr#
set Ptr Word8
dst Ptr Word8
src Int
len Bool
True
  where
        !set :: Addr#
set = Addr#
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"#

-- | Transform a number of bytes pointed by @src@ to, URL-safe base64 binary
-- representation in @dst@. The result will be either padded or unpadded,
-- depending on the boolean @padded@ argument.
--
-- The destination memory need to be of correct size, otherwise it will lead
-- to really bad things.
toBase64URL :: Bool -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64URL :: Bool -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64URL Bool
padded Ptr Word8
dst Ptr Word8
src Int
len = Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal Addr#
set Ptr Word8
dst Ptr Word8
src Int
len Bool
padded
  where
        !set :: Addr#
set = Addr#
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"#

toBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64OpenBSD Ptr Word8
dst Ptr Word8
src Int
len = Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal Addr#
set Ptr Word8
dst Ptr Word8
src Int
len Bool
False
  where
        !set :: Addr#
set = Addr#
"./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"#

toBase64Internal :: Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal :: Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal Addr#
table Ptr Word8
dst Ptr Word8
src Int
len Bool
padded = Int -> Int -> IO ()
loop Int
0 Int
0
  where
        eqChar :: Word8
eqChar = Word8
0x3d :: Word8

        loop :: Int -> Int -> IO ()
loop Int
i Int
di
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = do
                Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0 else Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                Word8
c <- if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0 else Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)

                let (Word8
w,Word8
x,Word8
y,Word8
z) = Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 Addr#
table Word8
a Word8
b Word8
c

                Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di     Word8
w
                Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
x

                if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
                    then
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
y
                    else
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
padded (Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
eqChar)
                if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
                    then
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
z
                    else
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
padded (Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
eqChar)

                Int -> Int -> IO ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)

convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 Addr#
table (W8# Word#
a) (W8# Word#
b) (W8# Word#
c) =
    let !w :: Word#
w = Word# -> Word#
narrow8Word# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
a Int#
2#)
        !x :: Word#
x = Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
and# (Word# -> Int# -> Word#
uncheckedShiftL# Word#
a Int#
4#) Word#
0x30##) (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
b Int#
4#)
        !y :: Word#
y = Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
and# (Word# -> Int# -> Word#
uncheckedShiftL# Word#
b Int#
2#) Word#
0x3c##) (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
c Int#
6#)
        !z :: Word#
z = Word# -> Word# -> Word#
and# Word#
c Word#
0x3f##
     in (Word# -> Word8
index Word#
w, Word# -> Word8
index Word#
x, Word# -> Word8
index Word#
y, Word# -> Word8
index Word#
z)
  where
        index :: Word# -> Word8
        index :: Word# -> Word8
index Word#
idx = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table (Word# -> Int#
word2Int# Word#
idx))

-- | Get the length needed for the destination buffer for a base64 decoding.
--
-- if the length is not a multiple of 4, Nothing is returned
unBase64Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length Ptr Word8
src Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1            = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
    | (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise          = do
        Word8
last1Byte <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Word8
last2Byte <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        let dstLen :: Int
dstLen = if Word8
last1Byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii
                        then if Word8
last2Byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii then Int
2 else Int
1
                        else Int
0
        Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Int
len 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen
  where
        eqAscii :: Word8
        eqAscii :: Word8
eqAscii = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'=')

-- | Get the length needed for the destination buffer for an
-- <http://tools.ietf.org/html/rfc4648#section-3.2 unpadded> base64 decoding.
--
-- If the length of the encoded string is a multiple of 4, plus one, Nothing is
-- returned. Any other value can be valid without padding.
unBase64LengthUnpadded :: Int -> Maybe Int
unBase64LengthUnpadded :: Int -> Maybe Int
unBase64LengthUnpadded Int
len = case Int
r of
    Int
0 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q)
    Int
2 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int
3 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    Int
_ -> Maybe Int
forall a. Maybe a
Nothing
  where (Int
q, Int
r) = Int
len Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4

fromBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64OpenBSD Ptr Word8
dst Ptr Word8
src Int
len = (Word8 -> Word8) -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64Unpadded Word8 -> Word8
rsetOpenBSD Ptr Word8
dst Ptr Word8
src Int
len

fromBase64URLUnpadded :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64URLUnpadded :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64URLUnpadded Ptr Word8
dst Ptr Word8
src Int
len = (Word8 -> Word8) -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64Unpadded Word8 -> Word8
rsetURL Ptr Word8
dst Ptr Word8
src Int
len

fromBase64Unpadded :: (Word8 -> Word8) -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64Unpadded :: (Word8 -> Word8) -> Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64Unpadded Word8 -> Word8
rset Ptr Word8
dst Ptr Word8
src Int
len = Int -> Int -> IO (Maybe Int)
loop Int
0 Int
0
  where loop :: Int -> Int -> IO (Maybe Int)
loop Int
di Int
i
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len       = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1   = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing -- Shouldn't happen if len is valid
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2   = do
                Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

                case Word8 -> Word8 -> Either Int Word8
decode2 Word8
a Word8
b of
                    Left Int
ofs -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ofs)
                    Right Word8
x  -> do
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
                        Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3   = do
                Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                Word8
c <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)

                case Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8)
decode3 Word8
a Word8
b Word8
c of
                    Left Int
ofs    -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ofs)
                    Right (Word8
x,Word8
y) -> do
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di     Word8
x
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
y
                        Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            | Bool
otherwise      = do
                Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                Word8
c <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
                Word8
d <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)

                case Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c Word8
d of
                    Left Int
ofs      -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ofs)
                    Right (Word8
x,Word8
y,Word8
z) -> do
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di     Word8
x
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
y
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
z
                        Int -> Int -> IO (Maybe Int)
loop (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)

        decode2 :: Word8 -> Word8 -> Either Int Word8
        decode2 :: Word8 -> Word8 -> Either Int Word8
decode2 Word8
a Word8
b =
            case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b) of
                (Word8
0xff, Word8
_   ) -> Int -> Either Int Word8
forall a b. a -> Either a b
Left Int
0
                (Word8
_   , Word8
0xff) -> Int -> Either Int Word8
forall a b. a -> Either a b
Left Int
1
                (Word8
ra  , Word8
rb  ) -> Word8 -> Either Int Word8
forall a b. b -> Either a b
Right ((Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4))

        decode3 :: Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8)
        decode3 :: Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8)
decode3 Word8
a Word8
b Word8
c =
            case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b, Word8 -> Word8
rset Word8
c) of
                (Word8
0xff, Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8)
forall a b. a -> Either a b
Left Int
0
                (Word8
_   , Word8
0xff, Word8
_   ) -> Int -> Either Int (Word8, Word8)
forall a b. a -> Either a b
Left Int
1
                (Word8
_   , Word8
_   , Word8
0xff) -> Int -> Either Int (Word8, Word8)
forall a b. a -> Either a b
Left Int
2
                (Word8
ra  , Word8
rb  , Word8
rc  ) ->
                    let x :: Word8
x = (Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
                        y :: Word8
y = (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
                     in (Word8, Word8) -> Either Int (Word8, Word8)
forall a b. b -> Either a b
Right (Word8
x,Word8
y)


        decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
        decode4 :: Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c Word8
d =
            case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b, Word8 -> Word8
rset Word8
c, Word8 -> Word8
rset Word8
d) of
                (Word8
0xff, Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
0
                (Word8
_   , Word8
0xff, Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
1
                (Word8
_   , Word8
_   , Word8
0xff, Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
2
                (Word8
_   , Word8
_   , Word8
_   , Word8
0xff) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
3
                (Word8
ra  , Word8
rb  , Word8
rc  , Word8
rd  ) ->
                    let x :: Word8
x = (Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
                        y :: Word8
y = (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
                        z :: Word8
z = (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
rd
                     in (Word8, Word8, Word8) -> Either Int (Word8, Word8, Word8)
forall a b. b -> Either a b
Right (Word8
x,Word8
y,Word8
z)

rsetURL :: Word8 -> Word8
rsetURL :: Word8 -> Word8
rsetURL (W8# Word#
w)
    | Int# -> Bool
booleanPrim (Word#
w Word# -> Word# -> Int#
`leWord#` Word#
0xff##) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
w))
    | Bool
otherwise                        = Word8
0xff
  where !rsetTable :: Addr#
rsetTable = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\
                     \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\xff\xff\xff\
                     \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\
                     \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\x3f\
                     \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\
                     \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

rsetOpenBSD :: Word8 -> Word8
rsetOpenBSD :: Word8 -> Word8
rsetOpenBSD (W8# Word#
w)
    | Int# -> Bool
booleanPrim (Word#
w Word# -> Word# -> Int#
`leWord#` Word#
0xff##) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
w))
    | Bool
otherwise                        = Word8
0xff
  where !rsetTable :: Addr#
rsetTable = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\
                     \\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\xff\xff\xff\xff\xff\xff\
                     \\xff\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\
                     \\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\xff\xff\xff\xff\xff\
                     \\xff\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\
                     \\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#


-- | convert from base64 in @src@ to binary in @dst@, using the number of bytes specified
--
-- the user should use unBase64Length to compute the correct length, or check that
-- the length specification is proper. no check is done here.
fromBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64 Ptr Word8
dst Ptr Word8
src Int
len
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise = Int -> Int -> IO (Maybe Int)
loop Int
0 Int
0
  where loop :: Int -> Int -> IO (Maybe Int)
loop Int
di Int
i
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4) = do
                Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                Word8
c <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
                Word8
d <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)

                let (Int
nbBytes, Word8
c',Word8
d') =
                        case (Word8
c,Word8
d) of
                            (Word8
0x3d, Word8
0x3d) -> (Int
2, Word8
0x30, Word8
0x30)
                            (Word8
0x3d, Word8
_   ) -> (Int
0, Word8
c, Word8
d) -- invalid: automatically 'c' will make it error out
                            (Word8
_   , Word8
0x3d) -> (Int
1, Word8
c, Word8
0x30)
                            (Word8
_   , Word8
_   ) -> (Int
0 :: Int, Word8
c, Word8
d)
                case Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c' Word8
d' of
                    Left Int
ofs -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ofs)
                    Right (Word8
x,Word8
y,Word8
z) -> do
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
y
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
z
                        Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            | Bool
otherwise    = do
                Word8
a <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                Word8
c <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
                Word8
d <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)

                case Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c Word8
d of
                    Left Int
ofs      -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ofs)
                    Right (Word8
x,Word8
y,Word8
z) -> do
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di     Word8
x
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
y
                        Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
z
                        Int -> Int -> IO (Maybe Int)
loop (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)

        decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
        decode4 :: Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c Word8
d =
            case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b, Word8 -> Word8
rset Word8
c, Word8 -> Word8
rset Word8
d) of
                (Word8
0xff, Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
0
                (Word8
_   , Word8
0xff, Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
1
                (Word8
_   , Word8
_   , Word8
0xff, Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
2
                (Word8
_   , Word8
_   , Word8
_   , Word8
0xff) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
3
                (Word8
ra  , Word8
rb  , Word8
rc  , Word8
rd  ) ->
                    let x :: Word8
x = (Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
                        y :: Word8
y = (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
                        z :: Word8
z = (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
rd
                     in (Word8, Word8, Word8) -> Either Int (Word8, Word8, Word8)
forall a b. b -> Either a b
Right (Word8
x,Word8
y,Word8
z)

        rset :: Word8 -> Word8
        rset :: Word8 -> Word8
rset (W8# Word#
w)
            | Int# -> Bool
booleanPrim (Word#
w Word# -> Word# -> Int#
`leWord#` Word#
0xff##) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
w))
            | Bool
otherwise                        = Word8
0xff

        !rsetTable :: Addr#
rsetTable = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\xff\x3f\
                     \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\xff\xff\xff\
                     \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\
                     \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\xff\
                     \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\
                     \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                     \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#