{-# LANGUAGE BangPatterns #-}
module Codec.Base32.Impl
( decodeBs2Bs
, decodeBsL2BsL
, encodeBs2Bs
, encodeBsL2BsL
, Fmt(..)
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BS.C
import qualified Data.ByteString.Lazy as BS.L
import Control.Monad
import Data.Bits
import Data.Word
import Internal
data Fmt = Fmt'base32 | Fmt'base32hex
{-# INLINE decodeBs2Bs #-}
decodeBs2Bs :: Fmt -> BS.ByteString -> Either String BS.ByteString
decodeBs2Bs :: Fmt -> ByteString -> Either String ByteString
decodeBs2Bs !Fmt
fmt ByteString
bs0 = case Fmt -> ByteString -> DecodeRes
runDecode Fmt
fmt ByteString
bs0 of
DR'Final Builder
chunk -> ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
bsToStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString Builder
chunk
DR'Error Word
ofs DecodeError
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Word -> DecodeError -> String
showDecErr Word
ofs DecodeError
err
DR'Partial Builder
chunk0 ByteString -> DecodeRes
cont -> case ByteString -> DecodeRes
cont ByteString
forall a. Monoid a => a
mempty of
DR'Final Builder
chunk1 -> ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
bsToStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder
chunk0Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
chunk1)
DR'Partial Builder
_ ByteString -> DecodeRes
_ -> String -> Either String ByteString
forall a. HasCallStack => String -> a
error String
"decodeBs2Bs: the impossible just happened"
DR'Error Word
ofs DecodeError
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Word -> DecodeError -> String
showDecErr Word
ofs DecodeError
err
{-# INLINE decodeBsL2BsL #-}
decodeBsL2BsL :: Fmt -> BS.L.ByteString -> Either String BS.L.ByteString
decodeBsL2BsL :: Fmt -> ByteString -> Either String ByteString
decodeBsL2BsL !Fmt
fmt ByteString
bs0 = Builder
-> (ByteString -> DecodeRes)
-> [ByteString]
-> Either String ByteString
go Builder
forall a. Monoid a => a
mempty (Fmt -> ByteString -> DecodeRes
runDecode Fmt
fmt) ((ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.L.toChunks ByteString
bs0)
where
go :: Builder
-> (ByteString -> DecodeRes)
-> [ByteString]
-> Either String ByteString
go Builder
acc ByteString -> DecodeRes
runDec (ByteString
c:[ByteString]
cs) = case ByteString -> DecodeRes
runDec ByteString
c of
DR'Final Builder
_ -> String -> Either String ByteString
forall a. HasCallStack => String -> a
error String
"impossible"
DR'Error Word
ofs DecodeError
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$! Word -> DecodeError -> String
showDecErr Word
ofs DecodeError
err
DR'Partial Builder
chunk ByteString -> DecodeRes
cont -> Builder
-> (ByteString -> DecodeRes)
-> [ByteString]
-> Either String ByteString
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
chunk) ByteString -> DecodeRes
cont [ByteString]
cs
go Builder
acc ByteString -> DecodeRes
runDec [] = case ByteString -> DecodeRes
runDec ByteString
forall a. Monoid a => a
mempty of
DR'Final Builder
chunk -> ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$! Builder -> ByteString
BB.toLazyByteString (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
chunk)
DR'Partial Builder
_ ByteString -> DecodeRes
_ -> String -> Either String ByteString
forall a. HasCallStack => String -> a
error String
"decodeBsL2BsL: the impossible just happened"
DR'Error Word
ofs DecodeError
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Word -> DecodeError -> String
showDecErr Word
ofs DecodeError
err
encodeBs2Bs :: Fmt -> BS.ByteString -> BS.ByteString
encodeBs2Bs :: Fmt -> ByteString -> ByteString
encodeBs2Bs !Fmt
fmt = String -> ByteString
BS.C.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt -> Bool -> [Word8] -> String
slowEnc Fmt
fmt Bool
True ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
encodeBsL2BsL :: Fmt -> BS.L.ByteString -> BS.L.ByteString
encodeBsL2BsL :: Fmt -> ByteString -> ByteString
encodeBsL2BsL !Fmt
fmt = [ByteString] -> ByteString
BS.L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> [ByteString]
go ByteString
forall a. Monoid a => a
mempty ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.L.toChunks
where
go :: ByteString -> [ByteString] -> [ByteString]
go ByteString
rest [] = Fmt -> ByteString -> ByteString
encodeBs2Bs Fmt
fmt ByteString
rest ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: []
go ByteString
rest (ByteString
c:[ByteString]
cs)
| Int
rclen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = ByteString -> [ByteString] -> [ByteString]
go ByteString
rc [ByteString]
cs
| Bool
otherwise = Fmt -> ByteString -> ByteString
encodeBs2Bs Fmt
fmt ByteString
c' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
go ByteString
rest' [ByteString]
cs
where
rlen :: Int
rlen = ByteString -> Int
BS.length ByteString
rest
clen :: Int
clen = ByteString -> Int
BS.length ByteString
c
rc :: ByteString
rc = ByteString
rest ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
c
rclen :: Int
rclen = Int
rlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
clen
rlen' :: Int
rlen' = Int
rclen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
5
(ByteString
c',ByteString
rest') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
rclen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rlen') ByteString
rc
slowEnc :: Fmt -> Bool -> [Word8] -> [Char]
slowEnc :: Fmt -> Bool -> [Word8] -> String
slowEnc !Fmt
fmt Bool
doPad = [Word8] -> String
go0
where
go0 :: [Word8] -> String
go0 [] = []
go0 (Word8
x:[Word8]
xs) = Word8 -> Char
sym Word8
hi Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> [Word8] -> String
go1 Word8
lo [Word8]
xs
where
(Word8
hi,Word8
lo) = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x08
go1 :: Word8 -> [Word8] -> String
go1 Word8
rest [] = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x04) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
forall a. [a] -> [a]
pad String
"======"
go1 Word8
rest (Word8
x:[Word8]
xs) = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x04 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
hi) Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
sym Word8
mid Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> [Word8] -> String
go2 Word8
lo [Word8]
xs
where
(Word8
hi,Word8
tmp) = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x40
(Word8
mid,Word8
lo) = Word8
tmp Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x02
go2 :: Word8 -> [Word8] -> String
go2 Word8
rest [] = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x10) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
forall a. [a] -> [a]
pad String
"===="
go2 Word8
rest (Word8
x:[Word8]
xs) = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
hi) Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> [Word8] -> String
go3 Word8
lo [Word8]
xs
where
(Word8
hi,Word8
lo) = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x10
go3 :: Word8 -> [Word8] -> String
go3 Word8
rest [] = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x02) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
forall a. [a] -> [a]
pad String
"==="
go3 Word8
rest (Word8
x:[Word8]
xs) = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x02 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
hi) Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
sym Word8
mid Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> [Word8] -> String
go4 Word8
lo [Word8]
xs
where
(Word8
hi,Word8
tmp) = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x80
(Word8
mid,Word8
lo) = Word8
tmp Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x04
go4 :: Word8 -> [Word8] -> String
go4 Word8
rest [] = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x08) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
forall a. [a] -> [a]
pad String
"="
go4 Word8
rest (Word8
x:[Word8]
xs) = Word8 -> Char
sym (Word8
rest Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
0x08 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
hi) Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
sym Word8
lo Char -> String -> String
forall a. a -> [a] -> [a]
: [Word8] -> String
go0 [Word8]
xs
where
(Word8
hi,Word8
lo) = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
0x20
pad :: [a] -> [a]
pad [a]
x | Bool
doPad = [a]
x
| Bool
otherwise = []
sym :: Word8 -> Char
sym = case Fmt
fmt of
Fmt
Fmt'base32 -> Word8 -> Char
sym0
Fmt
Fmt'base32hex -> Word8 -> Char
symx
sym0 :: Word8 -> Char
sym0 :: Word8 -> Char
sym0 Word8
w
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
26 = Int -> Char
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x41)
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 = Int -> Char
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24)
| Bool
otherwise = Char
forall a. HasCallStack => a
undefined
symx :: Word8 -> Char
symx :: Word8 -> Char
symx Word8
w
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 = Int -> Char
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x30)
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 = Int -> Char
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
55)
| Bool
otherwise = Char
forall a. HasCallStack => a
undefined
data DecodeRes = DR'Final !BB.Builder
| DR'Partial !BB.Builder (BS.ByteString -> DecodeRes)
| DR'Error !Word DecodeError
instance Show DecodeRes where
show :: DecodeRes -> String
show (DR'Final Builder
x) = String
"DR'Final " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Builder -> ByteString
BB.toLazyByteString Builder
x)
show (DR'Partial Builder
x ByteString -> DecodeRes
_) = String
"DR'Partial " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Builder -> ByteString
BB.toLazyByteString Builder
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <cont>"
show (DR'Error Word
ofs DecodeError
err) = String
"DR'Err " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
ofs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DecodeError -> String
forall a. Show a => a -> String
show DecodeError
err
data DecodeError = Error'IncompleteInput
| Error'InvalidChar
| Error'InvalidPad
deriving Int -> DecodeError -> String -> String
[DecodeError] -> String -> String
DecodeError -> String
(Int -> DecodeError -> String -> String)
-> (DecodeError -> String)
-> ([DecodeError] -> String -> String)
-> Show DecodeError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DecodeError] -> String -> String
$cshowList :: [DecodeError] -> String -> String
show :: DecodeError -> String
$cshow :: DecodeError -> String
showsPrec :: Int -> DecodeError -> String -> String
$cshowsPrec :: Int -> DecodeError -> String -> String
Show
showDecErr :: Word -> DecodeError -> String
showDecErr :: Word -> DecodeError -> String
showDecErr Word
ofs DecodeError
Error'InvalidPad = String
"Base32-encoded data has invalid padding at offset: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
ofs
showDecErr Word
ofs DecodeError
Error'IncompleteInput = String
"Base32-encoded data ended prematurely at offset: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
ofs
showDecErr Word
ofs DecodeError
Error'InvalidChar = String
"Base32-encoded data has invalid character at offset: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
ofs
runDecode :: Fmt -> BS.ByteString -> DecodeRes
runDecode :: Fmt -> ByteString -> DecodeRes
runDecode !Fmt
fmt = Word -> ByteString -> ByteString -> DecodeRes
go Word
0 ByteString
forall a. Monoid a => a
mempty
where
go :: Word -> ByteString -> ByteString -> DecodeRes
go Word
ofs0 ByteString
buf0 ByteString
buf1
| Bool
doflush, ByteString -> Bool
BS.null ByteString
buf0 = Builder -> DecodeRes
DR'Final Builder
forall a. Monoid a => a
mempty
| Bool
doflush = case Fmt
-> ByteString -> Either (Word, DecodeError) (Builder, ByteString)
decodePaddedChunk Fmt
fmt ByteString
buf0 of
Left (Word
ofs,DecodeError
err) -> Word -> DecodeError -> DecodeRes
DR'Error (Word
ofs0Word -> Word -> Word
forall a. Num a => a -> a -> a
+Word
ofs) DecodeError
err
Right (Builder
out,ByteString
rest)
| ByteString -> Bool
BS.null ByteString
rest -> Builder -> DecodeRes
DR'Final Builder
out
| Bool
otherwise -> String -> DecodeRes
forall a. HasCallStack => String -> a
error String
"runDecode: the impossible just happened"
| Int
buf01len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 = Builder -> (ByteString -> DecodeRes) -> DecodeRes
DR'Partial Builder
forall a. Monoid a => a
mempty (Word -> ByteString -> ByteString -> DecodeRes
go Word
ofs0 ByteString
buf01)
| Bool
otherwise = case Fmt
-> ByteString -> Either (Word, DecodeError) (Builder, ByteString)
decodeChunks Fmt
fmt ByteString
buf01 of
Left (Word
ofs,DecodeError
err) -> Word -> DecodeError -> DecodeRes
DR'Error (Word
ofs0Word -> Word -> Word
forall a. Num a => a -> a -> a
+Word
ofs) DecodeError
err
Right (Builder
chunks,ByteString
rest) -> Builder -> (ByteString -> DecodeRes) -> DecodeRes
DR'Partial Builder
chunks (Word -> ByteString -> ByteString -> DecodeRes
go (Word
ofs0 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
buf01len Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
rest)) ByteString
rest)
where
buf01 :: ByteString
buf01 = ByteString
buf0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
buf1
buf01len :: Int
buf01len = ByteString -> Int
BS.length ByteString
buf01
doflush :: Bool
doflush = ByteString -> Bool
BS.null ByteString
buf1
decodeChunks :: Fmt -> BS.ByteString -> Either (Word,DecodeError) (BB.Builder,BS.ByteString)
decodeChunks :: Fmt
-> ByteString -> Either (Word, DecodeError) (Builder, ByteString)
decodeChunks !Fmt
fmt = Word
-> Builder
-> ByteString
-> Either (Word, DecodeError) (Builder, ByteString)
go Word
0 Builder
forall a. Monoid a => a
mempty
where
go :: Word
-> Builder
-> ByteString
-> Either (Word, DecodeError) (Builder, ByteString)
go !Word
ofs0 Builder
bb0 ByteString
bs0
| ByteString -> Bool
BS.null ByteString
bs0 = (Builder, ByteString)
-> Either (Word, DecodeError) (Builder, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder
bb0,ByteString
forall a. Monoid a => a
mempty)
| Bool
otherwise = case Fmt
-> ByteString -> Either (Word, DecodeError) (Builder, ByteString)
decodePaddedChunk Fmt
fmt ByteString
bs0 of
Left (Word
_, DecodeError
Error'IncompleteInput) -> (Builder, ByteString)
-> Either (Word, DecodeError) (Builder, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder
bb0,ByteString
bs0)
Left (Word
ofs1,DecodeError
err) -> (Word, DecodeError)
-> Either (Word, DecodeError) (Builder, ByteString)
forall a b. a -> Either a b
Left (Word
ofs0Word -> Word -> Word
forall a. Num a => a -> a -> a
+Word
ofs1, DecodeError
err)
Right (Builder
chunk, ByteString
rest) -> Word
-> Builder
-> ByteString
-> Either (Word, DecodeError) (Builder, ByteString)
go (Word
ofs0Word -> Word -> Word
forall a. Num a => a -> a -> a
+Word
8) (Builder
bb0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
chunk) ByteString
rest
decodePaddedChunk :: Fmt -> BS.ByteString -> Either (Word,DecodeError) (BB.Builder,BS.ByteString)
decodePaddedChunk :: Fmt
-> ByteString -> Either (Word, DecodeError) (Builder, ByteString)
decodePaddedChunk !Fmt
fmt ByteString
bs0
| Int
bs0len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 = (Word, DecodeError)
-> Either (Word, DecodeError) (Builder, ByteString)
forall a b. a -> Either a b
Left (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Int
bs0len, DecodeError
Error'IncompleteInput)
| Bool
otherwise = do
let (ByteString
digs,ByteString
padding) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x3d) (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
8 ByteString
bs0
let vlen :: Word
vlen = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
digs
[Word8]
vals <- [(Word, Char)]
-> ((Word, Char) -> Either (Word, DecodeError) Word8)
-> Either (Word, DecodeError) [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Word] -> String -> [(Word, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] (ByteString -> String
BS.C.unpack ByteString
digs)) (((Word, Char) -> Either (Word, DecodeError) Word8)
-> Either (Word, DecodeError) [Word8])
-> ((Word, Char) -> Either (Word, DecodeError) Word8)
-> Either (Word, DecodeError) [Word8]
forall a b. (a -> b) -> a -> b
$
\(Word
i,Char
c) -> Either (Word, DecodeError) Word8
-> (Word8 -> Either (Word, DecodeError) Word8)
-> Maybe Word8
-> Either (Word, DecodeError) Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Word, DecodeError) -> Either (Word, DecodeError) Word8
forall a b. a -> Either a b
Left (Word
i,DecodeError
Error'InvalidChar)) Word8 -> Either (Word, DecodeError) Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word8 -> Either (Word, DecodeError) Word8)
-> Maybe Word8 -> Either (Word, DecodeError) Word8
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Word8
desym Char
c
Int
olen <- case Word
vlen of
Word
0 -> (Word, DecodeError) -> Either (Word, DecodeError) Int
forall a b. a -> Either a b
Left (Word
0, DecodeError
Error'InvalidPad)
Word
1 -> (Word, DecodeError) -> Either (Word, DecodeError) Int
forall a b. a -> Either a b
Left (Word
1, DecodeError
Error'InvalidPad)
Word
2 -> Int -> Either (Word, DecodeError) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
Word
3 -> (Word, DecodeError) -> Either (Word, DecodeError) Int
forall a b. a -> Either a b
Left (Word
3, DecodeError
Error'InvalidPad)
Word
4 -> Int -> Either (Word, DecodeError) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
2
Word
5 -> Int -> Either (Word, DecodeError) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
3
Word
6 -> (Word, DecodeError) -> Either (Word, DecodeError) Int
forall a b. a -> Either a b
Left (Word
6, DecodeError
Error'InvalidPad)
Word
7 -> Int -> Either (Word, DecodeError) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4
Word
8 -> Int -> Either (Word, DecodeError) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
5
Word
_ -> Either (Word, DecodeError) Int
forall a. HasCallStack => a
undefined
[(Word, Word8)]
-> ((Word, Word8) -> Either (Word, DecodeError) ())
-> Either (Word, DecodeError) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Word] -> [Word8] -> [(Word, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
vlen ..] (ByteString -> [Word8]
BS.unpack ByteString
padding)) (((Word, Word8) -> Either (Word, DecodeError) ())
-> Either (Word, DecodeError) ())
-> ((Word, Word8) -> Either (Word, DecodeError) ())
-> Either (Word, DecodeError) ()
forall a b. (a -> b) -> a -> b
$
\(Word
i,Word8
c) -> Bool
-> Either (Word, DecodeError) () -> Either (Word, DecodeError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x3d) (Either (Word, DecodeError) () -> Either (Word, DecodeError) ())
-> Either (Word, DecodeError) () -> Either (Word, DecodeError) ()
forall a b. (a -> b) -> a -> b
$ (Word, DecodeError) -> Either (Word, DecodeError) ()
forall a b. a -> Either a b
Left (Word
i, DecodeError
Error'InvalidPad)
let buf64 :: Word64
buf64 = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (Word64 -> Int -> Word64) -> [Word64] -> [Int] -> [Word64]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL ((Word8 -> Word64) -> [Word8] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8]
vals) [Int
35, Int
30 .. Int
0]
buf8 :: [Word8]
buf8 = (Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> (Int -> Word64) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word64
buf64 :: Word64)) [Int
32, Int
24 .. Int
0]
Bool
-> Either (Word, DecodeError) () -> Either (Word, DecodeError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ([Word8] -> Bool) -> [Word8] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
olen [Word8]
buf8) (Either (Word, DecodeError) () -> Either (Word, DecodeError) ())
-> Either (Word, DecodeError) () -> Either (Word, DecodeError) ()
forall a b. (a -> b) -> a -> b
$ do
(Word, DecodeError) -> Either (Word, DecodeError) ()
forall a b. a -> Either a b
Left (Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
vlen Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1, DecodeError
Error'InvalidPad)
(Builder, ByteString)
-> Either (Word, DecodeError) (Builder, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Builder, ByteString)
-> Either (Word, DecodeError) (Builder, ByteString))
-> (Builder, ByteString)
-> Either (Word, DecodeError) (Builder, ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Builder
BB.byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
olen [Word8]
buf8, Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs0)
where
bs0len :: Int
bs0len = ByteString -> Int
BS.length ByteString
bs0
desym :: Char -> Maybe Word8
desym = case Fmt
fmt of
Fmt
Fmt'base32 -> Char -> Maybe Word8
desym0
Fmt
Fmt'base32hex -> Char -> Maybe Word8
desymx
desym0 :: Char -> Maybe Word8
desym0 :: Char -> Maybe Word8
desym0 Char
c0 = case Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c0 of
Int
c | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x32 -> Maybe Word8
forall a. Maybe a
Nothing
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x38 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
24)
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x41 -> Maybe Word8
forall a. Maybe a
Nothing
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x5b -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x41)
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x61 -> Maybe Word8
forall a. Maybe a
Nothing
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x7b -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x61)
| Bool
otherwise -> Maybe Word8
forall a. Maybe a
Nothing
desymx :: Char -> Maybe Word8
desymx :: Char -> Maybe Word8
desymx Char
c0 = case Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c0 of
Int
c | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x30 -> Maybe Word8
forall a. Maybe a
Nothing
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x3a -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x30)
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x41 -> Maybe Word8
forall a. Maybe a
Nothing
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x57 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
55)
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x61 -> Maybe Word8
forall a. Maybe a
Nothing
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x77 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
87)
| Bool
otherwise -> Maybe Word8
forall a. Maybe a
Nothing