{-# 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 Data.Memory.Internal.Compat
import Data.Memory.Internal.Imports
import Basement.Bits
import Basement.IntegralConv (integralUpsize)
import GHC.Prim
import GHC.Word
import Foreign.Storable
import Foreign.Ptr (Ptr)
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+/"#
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 forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
a <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- if Int
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= Int
len then forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0 else forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
Word8
c <- if Int
i forall a. Num a => a -> a -> a
+ Int
2 forall a. Ord a => a -> a -> Bool
>= Int
len then forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0 else forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall 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
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
w
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
1) Word8
x
if Int
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
< Int
len
then
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
2) Word8
y
else
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
padded (forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
2) Word8
eqChar)
if Int
i forall a. Num a => a -> a -> a
+ Int
2 forall a. Ord a => a -> a -> Bool
< Int
len
then
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
3) Word8
z
else
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
padded (forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
3) Word8
eqChar)
Int -> Int -> IO ()
loop (Int
iforall a. Num a => a -> a -> a
+Int
3) (Int
diforall 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 !Word8
a !Word8
b !Word8
c =
let !w :: Word8
w = Word8
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
2
!x :: Word8
x = ((Word8
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. CountOf Bool
4) forall bits. BitOps bits => bits -> bits -> bits
.&. Word8
0x30) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
b forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
4)
!y :: Word8
y = ((Word8
b forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. CountOf Bool
2) forall bits. BitOps bits => bits -> bits -> bits
.&. Word8
0x3c) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
c forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
6)
!z :: Word8
z = Word8
c forall bits. BitOps bits => bits -> bits -> bits
.&. Word8
0x3f
in (Word8 -> Word8
index Word8
w, Word8 -> Word8
index Word8
x, Word8 -> Word8
index Word8
y, Word8 -> Word8
index Word8
z)
where
index :: Word8 -> Word8
index :: Word8 -> Word8
index !Word8
idxb = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
table (Word# -> Int#
word2Int# Word#
idx))
where !(W# Word#
idx) = forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
idxb
unBase64Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length Ptr Word8
src Int
len
| Int
len forall a. Ord a => a -> a -> Bool
< Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
0
| (Int
len forall a. Integral a => a -> a -> a
`mod` Int
4) forall a. Eq a => a -> a -> Bool
/= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = do
Word8
last1Byte <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
len forall a. Num a => a -> a -> a
- Int
1)
Word8
last2Byte <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
len forall a. Num a => a -> a -> a
- Int
2)
let dstLen :: Int
dstLen = if Word8
last1Byte forall a. Eq a => a -> a -> Bool
== Word8
eqAscii
then if Word8
last2Byte forall a. Eq a => a -> a -> Bool
== Word8
eqAscii then Int
2 else Int
1
else Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int
len forall a. Integral a => a -> a -> a
`div` Int
4) forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
- Int
dstLen
where
eqAscii :: Word8
eqAscii :: Word8
eqAscii = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Char
'=')
unBase64LengthUnpadded :: Int -> Maybe Int
unBase64LengthUnpadded :: Int -> Maybe Int
unBase64LengthUnpadded Int
len = case Int
r of
Int
0 -> forall a. a -> Maybe a
Just (Int
3forall a. Num a => a -> a -> a
*Int
q)
Int
2 -> forall a. a -> Maybe a
Just (Int
3forall a. Num a => a -> a -> a
*Int
q forall a. Num a => a -> a -> a
+ Int
1)
Int
3 -> forall a. a -> Maybe a
Just (Int
3forall a. Num a => a -> a -> a
*Int
q forall a. Num a => a -> a -> a
+ Int
2)
Int
_ -> forall a. Maybe a
Nothing
where (Int
q, Int
r) = Int
len 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 forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Int
i forall a. Eq a => a -> a -> Bool
== Int
len forall a. Num a => a -> a -> a
- Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Int
i forall a. Eq a => a -> a -> Bool
== Int
len forall a. Num a => a -> a -> a
- Int
2 = do
Word8
a <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
case Word8 -> Word8 -> Either Int Word8
decode2 Word8
a Word8
b of
Left Int
ofs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
ofs)
Right Word8
x -> do
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Int
i forall a. Eq a => a -> a -> Bool
== Int
len forall a. Num a => a -> a -> a
- Int
3 = do
Word8
a <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
Word8
c <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
ofs)
Right (Word8
x,Word8
y) -> do
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
1) Word8
y
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = do
Word8
a <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
Word8
c <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
2)
Word8
d <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
ofs)
Right (Word8
x,Word8
y,Word8
z) -> do
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
1) Word8
y
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
2) Word8
z
Int -> Int -> IO (Maybe Int)
loop (Int
di forall a. Num a => a -> a -> a
+ Int
3) (Int
i 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
_ ) -> forall a b. a -> Either a b
Left Int
0
(Word8
_ , Word8
0xff) -> forall a b. a -> Either a b
Left Int
1
(Word8
ra , Word8
rb ) -> forall a b. b -> Either a b
Right ((Word8
ra forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rb 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
_ ) -> forall a b. a -> Either a b
Left Int
0
(Word8
_ , Word8
0xff, Word8
_ ) -> forall a b. a -> Either a b
Left Int
1
(Word8
_ , Word8
_ , Word8
0xff) -> forall a b. a -> Either a b
Left Int
2
(Word8
ra , Word8
rb , Word8
rc ) ->
let x :: Word8
x = (Word8
ra forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rb forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
y :: Word8
y = (Word8
rb forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rc forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
in 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
_ ) -> forall a b. a -> Either a b
Left Int
0
(Word8
_ , Word8
0xff, Word8
_ , Word8
_ ) -> forall a b. a -> Either a b
Left Int
1
(Word8
_ , Word8
_ , Word8
0xff, Word8
_ ) -> forall a b. a -> Either a b
Left Int
2
(Word8
_ , Word8
_ , Word8
_ , Word8
0xff) -> forall a b. a -> Either a b
Left Int
3
(Word8
ra , Word8
rb , Word8
rc , Word8
rd ) ->
let x :: Word8
x = (Word8
ra forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rb forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
y :: Word8
y = (Word8
rb forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rc forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
z :: Word8
z = (Word8
rc forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6) forall bits. BitOps bits => bits -> bits -> bits
.|. Word8
rd
in forall a b. b -> Either a b
Right (Word8
x,Word8
y,Word8
z)
rsetURL :: Word8 -> Word8
rsetURL :: Word8 -> Word8
rsetURL !Word8
w = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
widx))
where !(W# Word#
widx) = forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
w
!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 !Word8
w = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
widx))
where !(W# Word#
widx) = forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
w
!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"#
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 forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
== (Int
lenforall a. Num a => a -> a -> a
-Int
4) = do
Word8
a <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
Word8
c <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
2)
Word8
d <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall 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)
(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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
ofs)
Right (Word8
x,Word8
y,Word8
z) -> do
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbBytes forall a. Ord a => a -> a -> Bool
< Int
2) forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
1) Word8
y
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbBytes forall a. Ord a => a -> a -> Bool
< Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
2) Word8
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = do
Word8
a <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
Word8
c <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
2)
Word8
d <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
ofs)
Right (Word8
x,Word8
y,Word8
z) -> do
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
x
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
1) Word8
y
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
diforall a. Num a => a -> a -> a
+Int
2) Word8
z
Int -> Int -> IO (Maybe Int)
loop (Int
di forall a. Num a => a -> a -> a
+ Int
3) (Int
i 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
_ ) -> forall a b. a -> Either a b
Left Int
0
(Word8
_ , Word8
0xff, Word8
_ , Word8
_ ) -> forall a b. a -> Either a b
Left Int
1
(Word8
_ , Word8
_ , Word8
0xff, Word8
_ ) -> forall a b. a -> Either a b
Left Int
2
(Word8
_ , Word8
_ , Word8
_ , Word8
0xff) -> forall a b. a -> Either a b
Left Int
3
(Word8
ra , Word8
rb , Word8
rc , Word8
rd ) ->
let x :: Word8
x = (Word8
ra forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rb forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
y :: Word8
y = (Word8
rb forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
rc forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
z :: Word8
z = (Word8
rc forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6) forall bits. BitOps bits => bits -> bits -> bits
.|. Word8
rd
in forall a b. b -> Either a b
Right (Word8
x,Word8
y,Word8
z)
rset :: Word8 -> Word8
rset :: Word8 -> Word8
rset !Word8
w = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
widx))
where !(W# Word#
widx) = forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
w
!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"#