-- |
-- Module      : Data.Memory.Encoding.Base32
-- License     : BSD-style
-- Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>
-- Stability   : experimental
-- Portability : unknown
--
-- Low-level Base32 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.Base32
    ( toBase32
    , unBase32Length
    , fromBase32
    ) where

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

-- | Transform a number of bytes pointed by.@src in the base32 binary representation in @dst
--
-- destination memory need to be of correct size, otherwise it will lead
-- to really bad things.
toBase32 :: Ptr Word8 -- ^ input
         -> Ptr Word8 -- ^ output
         -> Int       -- ^ input len
         -> IO ()
toBase32 :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toBase32 Ptr Word8
dst Ptr Word8
src Int
len = Int -> Int -> IO ()
loop Int
0 Int
0
  where
    eqChar :: Word8
    eqChar :: Word8
eqChar = Word8
0x3d

    peekOrZero :: Int -> IO Word8
    peekOrZero :: Int -> IO Word8
peekOrZero Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0
        | Bool
otherwise = Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i

    pokeOrPadding :: Int -- for the test
                  -> Int -- src index
                  -> Word8 -- the value
                  -> IO ()
    pokeOrPadding :: Int -> Int -> Word8 -> IO ()
pokeOrPadding Int
i Int
di Word8
v
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
len  = Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
v
        | Bool
otherwise = Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
eqChar

    loop :: Int -- index input
         -> Int -- index output
         -> IO ()
    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
i1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
            Word8
i2 <- Int -> IO Word8
peekOrZero (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Word8
i3 <- Int -> IO Word8
peekOrZero (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
            Word8
i4 <- Int -> IO Word8
peekOrZero (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
            Word8
i5 <- Int -> IO Word8
peekOrZero (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)

            let (Word8
o1,Word8
o2,Word8
o3,Word8
o4,Word8
o5,Word8
o6,Word8
o7,Word8
o8) = (Word8, Word8, Word8, Word8, Word8)
-> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
toBase32Per5Bytes (Word8
i1, Word8
i2, Word8
i3, Word8
i4, Word8
i5)

            Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di Word8
o1
            Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
o2
            Int -> Int -> Word8 -> IO ()
pokeOrPadding (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8
o3
            Int -> Int -> Word8 -> IO ()
pokeOrPadding (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
o4
            Int -> Int -> Word8 -> IO ()
pokeOrPadding (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word8
o5
            Int -> Int -> Word8 -> IO ()
pokeOrPadding (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Word8
o6
            Int -> Int -> Word8 -> IO ()
pokeOrPadding (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Word8
o7
            Int -> Int -> Word8 -> IO ()
pokeOrPadding (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Word8
o8

            Int -> Int -> IO ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
5) (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8)

toBase32Per5Bytes :: (Word8, Word8, Word8, Word8, Word8)
                  -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
toBase32Per5Bytes :: (Word8, Word8, Word8, Word8, Word8)
-> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
toBase32Per5Bytes (W8# Word#
i1, W8# Word#
i2, W8# Word#
i3, W8# Word#
i4, W8# Word#
i5) =
    (Word# -> Word8
index Word#
o1, Word# -> Word8
index Word#
o2, Word# -> Word8
index Word#
o3, Word# -> Word8
index Word#
o4, Word# -> Word8
index Word#
o5, Word# -> Word8
index Word#
o6, Word# -> Word8
index Word#
o7, Word# -> Word8
index Word#
o8)
  where
    -- 1111 1000 >> 3
    !o1 :: Word#
o1 =     (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i1 Word#
0xF8##) Int#
3#)
    -- 0000 0111 << 2 | 1100 0000 >> 6
    !o2 :: Word#
o2 = Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftL#  (Word# -> Word# -> Word#
and# Word#
i1 Word#
0x07##) Int#
2#) (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i2 Word#
0xC0##) Int#
6#)
    -- 0011 1110 >> 1
    !o3 :: Word#
o3 =     (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i2 Word#
0x3E##) Int#
1#)
    -- 0000 0001 << 4 | 1111 0000 >> 4
    !o4 :: Word#
o4 = Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftL#  (Word# -> Word# -> Word#
and# Word#
i2 Word#
0x01##) Int#
4#) (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i3 Word#
0xF0##) Int#
4#)
    -- 0000 1111 << 1 | 1000 0000 >> 7
    !o5 :: Word#
o5 = Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftL#  (Word# -> Word# -> Word#
and# Word#
i3 Word#
0x0F##) Int#
1#) (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i4 Word#
0x80##) Int#
7#)
    -- 0111 1100 >> 2
    !o6 :: Word#
o6 =     (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i4 Word#
0x7C##) Int#
2#)
    -- 0000 0011 << 3 | 1110 0000 >> 5
    !o7 :: Word#
o7 = Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftL#  (Word# -> Word# -> Word#
and# Word#
i4 Word#
0x03##) Int#
3#) (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
i5 Word#
0xE0##) Int#
5#)
    -- 0001 1111
    !o8 :: Word#
o8 =     ((Word# -> Word# -> Word#
and# Word#
i5 Word#
0x1F##))

    !set :: Addr#
set = Addr#
"ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"#

    index :: Word# -> Word8
    index :: Word# -> Word8
index Word#
idx = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
set (Word# -> Int#
word2Int# Word#
idx))

-- | Get the length needed for the destination buffer for a base32 decoding.
--
-- if the length is not a multiple of 8, Nothing is returned
unBase32Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase32Length :: Ptr Word8 -> Int -> IO (Maybe Int)
unBase32Length 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
8) 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)
        Word8
last3Byte <- 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
3)
        Word8
last4Byte <- 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
4)
        Word8
last5Byte <- 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
5)
        Word8
last6Byte <- 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
6)

        let dstLen :: Int
dstLen = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Int
caseByte Word8
last1Byte Word8
last2Byte Word8
last3Byte Word8
last4Byte Word8
last5Byte Word8
last6Byte
        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
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen
  where
    caseByte :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Int
    caseByte :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Int
caseByte Word8
last1 Word8
last2 Word8
last3 Word8
last4 Word8
last5 Word8
last6
        | Word8
last6 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii = Int
4
        | Word8
last5 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii = Int
3 -- error this padding is not expected (error will be detected in fromBase32)
        | Word8
last4 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii = Int
3
        | Word8
last3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii = Int
2
        | Word8
last2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii = Int
1 -- error this padding is not expected (error will be detected in fromBase32)
        | Word8
last1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
eqAscii = Int
1
        | Bool
otherwise        = Int
0

    eqAscii :: Word8
    eqAscii :: Word8
eqAscii = Word8
0x3D

-- | convert from base32 in @src to binary in @dst, using the number of bytes specified
--
-- the user should use unBase32Length to compute the correct length, or check that
-- the length specification is proper. no check is done here.
fromBase32 :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase32 :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromBase32 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 -- the index dst
         -> Int -- the index src
         -> IO (Maybe Int)
    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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) = do
            Word8
i1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
            Word8
i2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Word8
i3 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
            Word8
i4 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
            Word8
i5 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            Word8
i6 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
            Word8
i7 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
            Word8
i8 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)

            let (Int
nbBytes, Word8
i3', Word8
i4', Word8
i5', Word8
i6', Word8
i7', Word8
i8') =
                    case (Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) of
                        (Word8
0x3D, Word8
0x3D, Word8
0x3D, Word8
0x3D, Word8
0x3D, Word8
0x3D) -> (Int
6, Word8
0x41, Word8
0x41, Word8
0x41, Word8
0x41, Word8
0x41, Word8
0x41)
                        (Word8
0x3D, Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> (Int
0, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) -- invalid
                        (Word8
_   , Word8
0x3D, Word8
0x3D, Word8
0x3D, Word8
0x3D, Word8
0x3D) -> (Int
5, Word8
i3  , Word8
0x41, Word8
0x41, Word8
0x41, Word8
0x41, Word8
0x41)
                        (Word8
_   , Word8
0x3D, Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> (Int
0, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) -- invalid
                        (Word8
_   , Word8
_   , Word8
0x3D, Word8
0x3D, Word8
0x3D, Word8
0x3D) -> (Int
4, Word8
i3  , Word8
i4  , Word8
0x41, Word8
0x41, Word8
0x41, Word8
0x41)
                        (Word8
_   , Word8
_   , Word8
0x3D, Word8
_   , Word8
_   , Word8
_   ) -> (Int
0, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) -- invalid
                        (Word8
_   , Word8
_   , Word8
_   , Word8
0x3D, Word8
0x3D, Word8
0x3D) -> (Int
3, Word8
i3  , Word8
i4  , Word8
i5  , Word8
0x41, Word8
0x41, Word8
0x41)
                        (Word8
_   , Word8
_   , Word8
_   , Word8
0x3D, Word8
_   , Word8
_   ) -> (Int
0, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) -- invalid
                        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0x3D, Word8
0x3D) -> (Int
2, Word8
i3  , Word8
i4  , Word8
i5  , Word8
i6  , Word8
0x41, Word8
0x41)
                        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0x3D, Word8
_   ) -> (Int
0, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) -- invalid
                        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0x3D) -> (Int
1, Word8
i3  , Word8
i4  , Word8
i5  , Word8
i6  , Word8
i7  , Word8
0x41)
                        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> (Int
0 :: Int, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8)

            case (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
-> Either Int (Word8, Word8, Word8, Word8, Word8)
fromBase32Per8Bytes (Word8
i1, Word8
i2, Word8
i3', Word8
i4', Word8
i5', Word8
i6', Word8
i7', Word8
i8') 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
o1, Word8
o2, Word8
o3, Word8
o4, Word8
o5) -> do
                    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst  Int
di    Word8
o1
                    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
o2
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5) (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
o3
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) (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
3) Word8
o4
                    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
4) Word8
o5
                    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
i1 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
            Word8
i2 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Word8
i3 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
            Word8
i4 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
            Word8
i5 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            Word8
i6 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
            Word8
i7 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
            Word8
i8 <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)

            case (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
-> Either Int (Word8, Word8, Word8, Word8, Word8)
fromBase32Per8Bytes (Word8
i1, Word8
i2, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) 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
o1, Word8
o2, Word8
o3, Word8
o4, Word8
o5) -> do
                    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst  Int
di    Word8
o1
                    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
o2
                    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
o3
                    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
o4
                    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
4) Word8
o5
                    Int -> Int -> IO (Maybe Int)
loop (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
5) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8)

fromBase32Per8Bytes :: (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
                    -> Either Int (Word8, Word8, Word8, Word8, Word8)
fromBase32Per8Bytes :: (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
-> Either Int (Word8, Word8, Word8, Word8, Word8)
fromBase32Per8Bytes (Word8
i1, Word8
i2, Word8
i3, Word8
i4, Word8
i5, Word8
i6, Word8
i7, Word8
i8) =
    case (Word8 -> Word8
rset Word8
i1, Word8 -> Word8
rset Word8
i2, Word8 -> Word8
rset Word8
i3, Word8 -> Word8
rset Word8
i4, Word8 -> Word8
rset Word8
i5, Word8 -> Word8
rset Word8
i6, Word8 -> Word8
rset Word8
i7, Word8 -> Word8
rset Word8
i8) of
        (Word8
0xFF, Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
0
        (Word8
_   , Word8
0xFF, Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
1
        (Word8
_   , Word8
_   , Word8
0xFF, Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
2
        (Word8
_   , Word8
_   , Word8
_   , Word8
0xFF, Word8
_   , Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
3
        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0xFF, Word8
_   , Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
4
        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0xFF, Word8
_   , Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
5
        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0xFF, Word8
_   ) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
6
        (Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
_   , Word8
0xFF) -> Int -> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. a -> Either a b
Left Int
7
        (Word8
ri1 , Word8
ri2 , Word8
ri3 , Word8
ri4 , Word8
ri5 , Word8
ri6 , Word8
ri7 , Word8
ri8 ) ->
                -- 0001 1111 << 3 | 0001 11xx >> 2
            let o1 :: Word8
o1 = (Word8
ri1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
ri2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
                -- 000x xx11 << 6 | 0001 1111 << 1 | 0001 xxxx >> 4
                o2 :: Word8
o2 = (Word8
ri2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
ri3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
ri4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
                -- 000x 1111 << 4 | 0001 111x >> 1
                o3 :: Word8
o3 = (Word8
ri4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
ri5 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1)
                -- 000x xxx1 << 7 | 0001 1111 << 2 | 0001 1xxx >> 3
                o4 :: Word8
o4 = (Word8
ri5 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
7) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
ri6 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
ri7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3)
                -- 000x x111 << 5 | 0001 1111
                o5 :: Word8
o5 = (Word8
ri7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
ri8
             in (Word8, Word8, Word8, Word8, Word8)
-> Either Int (Word8, Word8, Word8, Word8, Word8)
forall a b. b -> Either a b
Right (Word8
o1, Word8
o2, Word8
o3, Word8
o4, Word8
o5)
  where
    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\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\x1A\x1B\x1C\x1D\x1E\x1F\xFF\xFF\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\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
                 \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"#