{-# 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)
toBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64 :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64 dst :: Ptr Word8
dst src :: Ptr Word8
src len :: 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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"#
toBase64URL :: Bool -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64URL :: Bool -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64URL padded :: Bool
padded dst :: Ptr Word8
dst src :: Ptr Word8
src len :: 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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"#
toBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase64OpenBSD dst :: Ptr Word8
dst src :: Ptr Word8
src len :: 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 = "./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"#
toBase64Internal :: Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal :: Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> Bool -> IO ()
toBase64Internal table :: Addr#
table dst :: Ptr Word8
dst src :: Ptr Word8
src len :: Int
len padded :: Bool
padded = Int -> Int -> IO ()
loop 0 0
where
eqChar :: Word8
eqChar = 0x3d :: Word8
loop :: Int -> Int -> IO ()
loop i :: Int
i di :: 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
+ 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 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
+1)
Word8
c <- if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 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
+2)
let (w :: Word8
w,x :: Word8
x,y :: Word8
y,z :: 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
+1) Word8
x
if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
+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
+2) Word8
eqChar)
if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
+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
+3) Word8
eqChar)
Int -> Int -> IO ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3) (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+4)
convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 table :: Addr#
table (W8# a :: Word#
a) (W8# b :: Word#
b) (W8# c :: Word#
c) =
let !w :: Word#
w = Word# -> Word#
narrow8Word# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
a 2#)
!x :: Word#
x = Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
and# (Word# -> Int# -> Word#
uncheckedShiftL# Word#
a 4#) 0x30##) (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
b 4#)
!y :: Word#
y = Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
and# (Word# -> Int# -> Word#
uncheckedShiftL# Word#
b 2#) 0x3c##) (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
c 6#)
!z :: Word#
z = Word# -> Word# -> Word#
and# Word#
c 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 idx :: Word#
idx = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table (Word# -> Int#
word2Int# Word#
idx))
unBase64Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase64Length src :: Ptr Word8
src len :: Int
len
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 0
| (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 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
- 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
- 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 2 else 1
else 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` 4) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 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 '=')
unBase64LengthUnpadded :: Int -> Maybe Int
unBase64LengthUnpadded :: Int -> Maybe Int
unBase64LengthUnpadded len :: Int
len = case Int
r of
0 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q)
2 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
3 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
_ -> Maybe Int
forall a. Maybe a
Nothing
where (q :: Int
q, r :: Int
r) = Int
len Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 4
fromBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64OpenBSD :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase64OpenBSD dst :: Ptr Word8
dst src :: Ptr Word8
src len :: 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 dst :: Ptr Word8
dst src :: Ptr Word8
src len :: 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 rset :: Word8 -> Word8
rset dst :: Ptr Word8
dst src :: Ptr Word8
src len :: Int
len = Int -> Int -> IO (Maybe Int)
loop 0 0
where loop :: Int -> Int -> IO (Maybe Int)
loop di :: Int
di i :: 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
- 1 = 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
- 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
+1)
case Word8 -> Word8 -> Either Int Word8
decode2 Word8
a Word8
b of
Left ofs :: 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 x :: 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
- 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
+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
+2)
case Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8)
decode3 Word8
a Word8
b Word8
c of
Left ofs :: 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 (x :: Word8
x,y :: 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
+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
+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
+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
+3)
case Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c Word8
d of
Left ofs :: 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 (x :: Word8
x,y :: Word8
y,z :: 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
+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
+2) Word8
z
Int -> Int -> IO (Maybe Int)
loop (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
decode2 :: Word8 -> Word8 -> Either Int Word8
decode2 :: Word8 -> Word8 -> Either Int Word8
decode2 a :: Word8
a b :: Word8
b =
case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b) of
(0xff, _ ) -> Int -> Either Int Word8
forall a b. a -> Either a b
Left 0
(_ , 0xff) -> Int -> Either Int Word8
forall a b. a -> Either a b
Left 1
(ra :: Word8
ra , rb :: 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` 2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4))
decode3 :: Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8)
decode3 :: Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8)
decode3 a :: Word8
a b :: Word8
b c :: Word8
c =
case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b, Word8 -> Word8
rset Word8
c) of
(0xff, _ , _ ) -> Int -> Either Int (Word8, Word8)
forall a b. a -> Either a b
Left 0
(_ , 0xff, _ ) -> Int -> Either Int (Word8, Word8)
forall a b. a -> Either a b
Left 1
(_ , _ , 0xff) -> Int -> Either Int (Word8, Word8)
forall a b. a -> Either a b
Left 2
(ra :: Word8
ra , rb :: Word8
rb , rc :: Word8
rc ) ->
let x :: Word8
x = (Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4)
y :: Word8
y = (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 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 a :: Word8
a b :: Word8
b c :: Word8
c d :: Word8
d =
case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b, Word8 -> Word8
rset Word8
c, Word8 -> Word8
rset Word8
d) of
(0xff, _ , _ , _ ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 0
(_ , 0xff, _ , _ ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 1
(_ , _ , 0xff, _ ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 2
(_ , _ , _ , 0xff) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 3
(ra :: Word8
ra , rb :: Word8
rb , rc :: Word8
rc , rd :: Word8
rd ) ->
let x :: Word8
x = (Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4)
y :: Word8
y = (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 2)
z :: Word8
z = (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 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# w :: Word#
w)
| Int# -> Bool
booleanPrim (Word#
w Word# -> Word# -> Int#
`leWord#` 0xff##) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
w))
| Bool
otherwise = 0xff
where !rsetTable :: Addr#
rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\xff\xff\xff\xff\xff\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# w :: Word#
w)
| Int# -> Bool
booleanPrim (Word#
w Word# -> Word# -> Int#
`leWord#` 0xff##) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
w))
| Bool
otherwise = 0xff
where !rsetTable :: Addr#
rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\xff\xff\xff\xff\xff\xff\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 dst :: Ptr Word8
dst src :: Ptr Word8
src len :: Int
len
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 0 0
where loop :: Int -> Int -> IO (Maybe Int)
loop di :: Int
di i :: 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
-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
+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
+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
+3)
let (nbBytes :: Int
nbBytes, c' :: Word8
c',d' :: Word8
d') =
case (Word8
c,Word8
d) of
(0x3d, 0x3d) -> (2, 0x30, 0x30)
(0x3d, _ ) -> (0, Word8
c, Word8
d)
(_ , 0x3d) -> (1, Word8
c, 0x30)
(_ , _ ) -> (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 ofs :: 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 (x :: Word8
x,y :: Word8
y,z :: 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
< 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
+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
< 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
+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
+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
+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
+3)
case Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 Word8
a Word8
b Word8
c Word8
d of
Left ofs :: 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 (x :: Word8
x,y :: Word8
y,z :: 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
+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
+2) Word8
z
Int -> Int -> IO (Maybe Int)
loop (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 :: Word8
-> Word8 -> Word8 -> Word8 -> Either Int (Word8, Word8, Word8)
decode4 a :: Word8
a b :: Word8
b c :: Word8
c d :: Word8
d =
case (Word8 -> Word8
rset Word8
a, Word8 -> Word8
rset Word8
b, Word8 -> Word8
rset Word8
c, Word8 -> Word8
rset Word8
d) of
(0xff, _ , _ , _ ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 0
(_ , 0xff, _ , _ ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 1
(_ , _ , 0xff, _ ) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 2
(_ , _ , _ , 0xff) -> Int -> Either Int (Word8, Word8, Word8)
forall a b. a -> Either a b
Left 3
(ra :: Word8
ra , rb :: Word8
rb , rc :: Word8
rc , rd :: Word8
rd ) ->
let x :: Word8
x = (Word8
ra Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4)
y :: Word8
y = (Word8
rb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 2)
z :: Word8
z = (Word8
rc Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 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# w :: Word#
w)
| Int# -> Bool
booleanPrim (Word#
w Word# -> Word# -> Int#
`leWord#` 0xff##) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
rsetTable (Word# -> Int#
word2Int# Word#
w))
| Bool
otherwise = 0xff
!rsetTable :: Addr#
rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
\\xff\xff\xff\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"#