-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

-- | This package provides an implementation of the bech32 encoding. In essence,
-- this encoding is comprised of three parts:
--
-- - A human readable prefix
-- - A base32-encoded payload (with a modified alphabet to avoid similar letters)
-- - A checksum calculated on the prefix and the encoded payload
--
-- The implementation is optimized on mainly three aspects:
--
-- - Low-level memory manipulation with typed pointers is used to traverse the
--   input string and to write the encoded value. Each byte is encoded
--   on-the-fly, which requires keeping track of a residue (since we encode from
--   8 bit to 5 bit, but can only read 8 bit at the same, the remainder is
--   stored and passed to the next builder loop).
--
-- - Since the checksum is calculated by folding over the encoded bytestring, it
--   can be computed in-place, as the string is being encoded. This is exactly
--   what this implementation does as well. In such way that once the string is
--   encoded, the checksum is already calculated and only need to be base32
--   encoded in turn.
--
-- - The first part of the checksum is pre-computed during the construction of the
--   HRP. It is indeed quite common for a single HRP to encode many payload. To
--   calculate the checksum, one must first expand the HRP which is in itself an
--   already 'costly' operation. Pre-calculating the expansion and the beginning
--   of the checksum shaves off some time .
--
module Data.ByteString.Bech32
    ( -- * Encoding
      encodeBech32

      -- * HumanReadablePart
    , HumanReadablePart(HumanReadablePart)
    , unHumanReadablePart
    ) where

import Relude

import Data.Bits
    ( Bits, testBit, unsafeShiftL, unsafeShiftR, (.&.), (.|.) )
import Data.ByteString.Internal
    ( ByteString (..) )
import Foreign.ForeignPtr
    ( withForeignPtr )
import Foreign.Ptr
    ( Ptr, plusPtr )
import Foreign.Storable
    ( peek, poke )
import GHC.Exts
    ( Addr#, indexWord8OffAddr#, word2Int# )
import GHC.ForeignPtr
    ( mallocPlainForeignPtrBytes )
import GHC.Word
    ( Word8 (..) )
import System.IO.Unsafe
    ( unsafeDupablePerformIO )

import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

-- | Encode some binary data to bech32 using the given human readable prefix.
encodeBech32 :: HumanReadablePart -> ByteString -> Text
encodeBech32 :: HumanReadablePart -> ByteString -> Text
encodeBech32 HumanReadablePart
hrp ByteString
bytes = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ HumanReadablePart -> Text
prefix HumanReadablePart
hrp
    , Text
"1"
    , Addr# -> Checksum -> ByteString -> Text
encodeDataPart Addr#
"qpzry9x8gf2tvdw0s3jn54khce6mua7l"# (HumanReadablePart -> Checksum
checksum HumanReadablePart
hrp) ByteString
bytes
    ]

--
-- HumanReadablePart
--

data HumanReadablePart = HumanReadablePartConstr
    { HumanReadablePart -> Text
prefix :: !Text
    , HumanReadablePart -> Checksum
checksum :: !Checksum
    } deriving Int -> HumanReadablePart -> ShowS
[HumanReadablePart] -> ShowS
HumanReadablePart -> String
(Int -> HumanReadablePart -> ShowS)
-> (HumanReadablePart -> String)
-> ([HumanReadablePart] -> ShowS)
-> Show HumanReadablePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HumanReadablePart] -> ShowS
$cshowList :: [HumanReadablePart] -> ShowS
show :: HumanReadablePart -> String
$cshow :: HumanReadablePart -> String
showsPrec :: Int -> HumanReadablePart -> ShowS
$cshowsPrec :: Int -> HumanReadablePart -> ShowS
Show

-- | Construct a human readable part from a text string, and pre-calculate the
-- checksum corresponding to it.
pattern HumanReadablePart :: Text -> HumanReadablePart
pattern $bHumanReadablePart :: Text -> HumanReadablePart
$mHumanReadablePart :: forall r. HumanReadablePart -> (Text -> r) -> (Void# -> r) -> r
HumanReadablePart { HumanReadablePart -> Text
unHumanReadablePart } <-
    HumanReadablePartConstr unHumanReadablePart _
  where
    HumanReadablePart Text
prefix =
        let
            checksum :: Checksum
checksum =
                (Checksum -> Word5 -> Checksum) -> Checksum -> [Word5] -> Checksum
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Word5 -> Checksum -> Checksum) -> Checksum -> Word5 -> Checksum
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word5 -> Checksum -> Checksum
polymodStep) (Word64 -> Checksum
Checksum Word64
1) ([Word5] -> Checksum) -> [Word5] -> Checksum
forall a b. (a -> b) -> a -> b
$ String -> [Word5]
expand (Text -> String
T.unpack Text
prefix)

            expand :: [Char] -> [Word5]
            expand :: String -> [Word5]
expand String
xs =
                [ Word8 -> Word5
coerce @Word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
x) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
5) | Char
x <- String
xs ]
                [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++
                [ Word8 -> Word5
coerce @Word8 Word8
0 ]
                [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++
                [ Word8 -> Word5
coerce @Word8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
x) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31) | Char
x <- String
xs ]
        in
            HumanReadablePartConstr :: Text -> Checksum -> HumanReadablePart
HumanReadablePartConstr {Text
prefix :: Text
prefix :: Text
prefix,Checksum
checksum :: Checksum
checksum :: Checksum
checksum}
{-# COMPLETE HumanReadablePart #-}

--
-- Main encoding loop
--

encodeDataPart :: Addr# -> Checksum -> ByteString -> Text
encodeDataPart :: Addr# -> Checksum -> ByteString -> Text
encodeDataPart !Addr#
alphabet !Checksum
chk0 =
    ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum)
-> ByteString -> ByteString
withAllocatedPointers (Int
-> Residue
-> Checksum
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO Checksum
base32 Int
0 (Word8 -> Residue
Residue Word8
0) Checksum
chk0)
  where
    withAllocatedPointers
        :: (Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum)
        -> ByteString
        -> ByteString
    withAllocatedPointers :: (Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum)
-> ByteString -> ByteString
withAllocatedPointers Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum
_fn ByteString
"" = ByteString
""
    withAllocatedPointers Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum
fn (PS !ForeignPtr Word8
inputForeignPtr !Int
_ !Int
inputLen) =
        let (!Int
q, !Int
r) = (Int
inputLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
5 in
        let !resultLen :: Int
resultLen = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1 in
        IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            ForeignPtr Word8
resultForeignPtr <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
resultLen
            ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
resultForeignPtr ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
resultPtr ->
                ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
inputForeignPtr ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
inputPtr -> do
                    Checksum
chk' <- Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum
fn (Int
resultLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Ptr Word8
inputPtr Ptr Word8
resultPtr
                    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
resultForeignPtr Int
0 Int
resultLen)
                          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Addr# -> Checksum -> ByteString
encodeChecksum Addr#
alphabet Checksum
chk')

    base32 :: Int -> Residue -> Checksum -> Int -> Ptr Word8 -> Ptr Word8 -> IO Checksum
    base32 :: Int
-> Residue
-> Checksum
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO Checksum
base32 !Int
n !Residue
r !Checksum
chk !Int
maxN !Ptr Word8
inputPtr !Ptr Word8
resultPtr
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxN = do
            let !w :: Word5
w = Residue -> Word5
coerce Residue
r
            Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
resultPtr (Addr#
alphabet Addr# -> Word5 -> Word8
`lookupWord5` Word5
w)
            Checksum -> IO Checksum
forall (m :: * -> *) a. Monad m => a -> m a
return (Checksum -> IO Checksum) -> Checksum -> IO Checksum
forall a b. (a -> b) -> a -> b
$ Word5 -> Checksum -> Checksum
polymodStep Word5
w Checksum
chk
        | Bool
otherwise = do
            (Word5
w, Residue
r', Ptr Word8
inputPtr') <- Int -> Residue -> Ptr Word8 -> IO (Word5, Residue, Ptr Word8)
peekWord5 Int
n Residue
r Ptr Word8
inputPtr
            Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
resultPtr (Addr#
alphabet Addr# -> Word5 -> Word8
`lookupWord5` Word5
w)
            let !chk' :: Checksum
chk' = Word5 -> Checksum -> Checksum
polymodStep Word5
w Checksum
chk
            Int
-> Residue
-> Checksum
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO Checksum
base32 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Residue
r' Checksum
chk' Int
maxN Ptr Word8
inputPtr' (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
resultPtr Int
1)

--
-- Checksum
--

newtype Checksum = Checksum Word64 deriving Int -> Checksum -> ShowS
[Checksum] -> ShowS
Checksum -> String
(Int -> Checksum -> ShowS)
-> (Checksum -> String) -> ([Checksum] -> ShowS) -> Show Checksum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Checksum] -> ShowS
$cshowList :: [Checksum] -> ShowS
show :: Checksum -> String
$cshow :: Checksum -> String
showsPrec :: Int -> Checksum -> ShowS
$cshowsPrec :: Int -> Checksum -> ShowS
Show

encodeChecksum :: Addr# -> Checksum -> ByteString
encodeChecksum :: Addr# -> Checksum -> ByteString
encodeChecksum !Addr#
alphabet !Checksum
chk =
    [ Addr#
alphabet Addr# -> Word5 -> Word8
`lookupWord5` Word64 -> Word5
word5 (Word64
polymod Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
i)
    | Int
i <- [Int
25, Int
20 .. Int
0 ]
    ] [Word8] -> ([Word8] -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& [Word8] -> ByteString
BS.pack
  where
    polymod :: Word64
polymod =
        let z :: Word5
z = Word8 -> Word5
coerce @Word8 Word8
0
        in (Checksum -> Word64
coerce ((Checksum -> Word5 -> Checksum) -> Checksum -> [Word5] -> Checksum
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Word5 -> Checksum -> Checksum) -> Checksum -> Word5 -> Checksum
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word5 -> Checksum -> Checksum
polymodStep) Checksum
chk [Word5
z,Word5
z,Word5
z,Word5
z,Word5
z,Word5
z]) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3fffffff) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
1

    word5 :: Word64 -> Word5
    word5 :: Word64 -> Word5
word5 = Word8 -> Word5
coerce (Word8 -> Word5) -> (Word64 -> Word8) -> Word64 -> Word5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Word64, Num Word8) => Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64 -> Word8) -> (Word64 -> Word64) -> Word64 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
31)
    {-# INLINE word5 #-}

polymodStep :: Word5 -> Checksum -> Checksum
polymodStep :: Word5 -> Checksum -> Checksum
polymodStep (Word5 !Word8
v) (Checksum !Word64
chk) =
    let chk' :: Word64
chk' = (Word64
chk Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
5) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v in
    Word64 -> Checksum
Checksum
        ( Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor (if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
chk Int
29 then Word64
0x2a1462b3 else Word64
0)
            ( Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor (if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
chk Int
28 then Word64
0x3d4233dd else Word64
0)
                ( Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor (if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
chk Int
27 then Word64
0x1ea119fa else Word64
0)
                    ( Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor (if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
chk Int
26 then Word64
0x26508e6d else Word64
0)
                        ( Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor (if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
chk Int
25 then Word64
0x3b6a57b2 else Word64
0)
                            Word64
chk'
                        )
                    )
                )
            )
        )

--
-- Base32
--

newtype Word5 = Word5 Word8 deriving Int -> Word5 -> ShowS
[Word5] -> ShowS
Word5 -> String
(Int -> Word5 -> ShowS)
-> (Word5 -> String) -> ([Word5] -> ShowS) -> Show Word5
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word5] -> ShowS
$cshowList :: [Word5] -> ShowS
show :: Word5 -> String
$cshow :: Word5 -> String
showsPrec :: Int -> Word5 -> ShowS
$cshowsPrec :: Int -> Word5 -> ShowS
Show

newtype Residue = Residue Word8 deriving Int -> Residue -> ShowS
[Residue] -> ShowS
Residue -> String
(Int -> Residue -> ShowS)
-> (Residue -> String) -> ([Residue] -> ShowS) -> Show Residue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Residue] -> ShowS
$cshowList :: [Residue] -> ShowS
show :: Residue -> String
$cshow :: Residue -> String
showsPrec :: Int -> Residue -> ShowS
$cshowsPrec :: Int -> Residue -> ShowS
Show

-- | Lookup a Word5 using the given pointer and a previous 'Residue'. Returns
-- the looked up 'Word5', a 'Residue' and the pointer advanced to the next
-- word;
--
-- NOTE: @n = i .&. 7@ is a fast modulo equivalent to @n = i `mod` 8@
peekWord5 :: Int -> Residue -> Ptr Word8 -> IO (Word5, Residue, Ptr Word8)
peekWord5 :: Int -> Residue -> Ptr Word8 -> IO (Word5, Residue, Ptr Word8)
peekWord5 !((Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
7) -> !Int
n) (Residue !Word8
r) !Ptr Word8
ptr
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
        Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
3)
            , Word8 -> Residue
coerce ((Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.<<. Int
2)
            , Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1
            )
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = do
        Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce ((Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
r)
            , Word8 -> Residue
coerce (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111)
            , Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1
            )
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = do
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce (Word8
r Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
1)
            , Word8 -> Residue
coerce ((Word8
r Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11000001) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.<<. Int
4)
            , Ptr Word8
ptr
            )
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = do
        Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce ((Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
r)
            , Word8 -> Residue
coerce ((Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.<<. Int
1)
            , Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1
            )
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = do
        Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce ((Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
7) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
r)
            , Word8 -> Residue
coerce (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111111)
            , Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1
            )
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = do
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce (Word8
r Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
2)
            , Word8 -> Residue
coerce ((Word8
r Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b10000011) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.<<. Int
3)
            , Ptr Word8
ptr
            )
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = do
        Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce ((Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
r)
            , Word8 -> Residue
coerce (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111)
            , Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
1
            )
    | Bool
otherwise = do
        (Word5, Residue, Ptr Word8) -> IO (Word5, Residue, Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Word8 -> Word5
coerce Word8
r
            , Word8 -> Residue
coerce @Word8 Word8
0
            , Ptr Word8
ptr
            )

--
-- Bit Manipulation / Conversions
--

(.>>.) :: Bits a => a -> Int -> a
.>>. :: a -> Int -> a
(.>>.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR
{-# SPECIALIZE INLINE (.>>.) :: Word8 -> Int -> Word8 #-}
{-# SPECIALIZE INLINE (.>>.) :: Word -> Int -> Word #-}

(.<<.) :: Bits a => a -> Int -> a
.<<. :: a -> Int -> a
(.<<.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL
{-# SPECIALIZE INLINE (.<<.) :: Word8 -> Int -> Word8 #-}
{-# SPECIALIZE INLINE (.<<.) :: Word -> Int -> Word #-}

--
-- Dictionnary
--

-- | Fast array lookup of a word5 in an unboxed bytestring.
lookupWord5 :: Addr# -> Word5 -> Word8
lookupWord5 :: Addr# -> Word5 -> Word8
lookupWord5 Addr#
table (Word5 -> Word8
coerce -> (W8# Word#
i)) =
    Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table (Word# -> Int#
word2Int# Word#
i))
{-# INLINE lookupWord5 #-}