{-# OPTIONS_HADDOCK hide, prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Data.ByteString.Base32 (
    encode
  , as_word5
  , as_base32

  -- not actually base32-related, but convenient to put here
  , Encoding(..)
  , create_checksum
  , verify
  , valid_hrp
  ) where

import Data.Bits ((.|.), (.&.))
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Builder.Extra as BE
import qualified Data.ByteString.Unsafe as BU
import qualified Data.Primitive.PrimArray as PA
import Data.Word (Word32)

_BECH32M_CONST :: Word32
_BECH32M_CONST :: Word32
_BECH32M_CONST = Word32
0x2bc830a3

fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE fi #-}

word32be :: BS.ByteString -> Word32
word32be :: ByteString -> Word32
word32be ByteString
s =
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
0) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
1) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
2) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL`  Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
3))
{-# INLINE word32be #-}

-- realization for small builders
toStrict :: BSB.Builder -> BS.ByteString
toStrict :: Builder -> ByteString
toStrict = ByteString -> ByteString
BS.toStrict
  (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> ByteString -> Builder -> ByteString
BE.toLazyByteStringWith (Int -> Int -> AllocationStrategy
BE.safeStrategy Int
128 Int
BE.smallChunkSize) ByteString
forall a. Monoid a => a
mempty

bech32_charset :: BS.ByteString
bech32_charset :: ByteString
bech32_charset = ByteString
"qpzry9x8gf2tvdw0s3jn54khce6mua7l"

-- adapted from emilypi's 'base32' library
encode :: BS.ByteString -> BS.ByteString
encode :: ByteString -> ByteString
encode ByteString
dat = Builder -> ByteString
toStrict (ByteString -> Builder
go ByteString
dat) where
  bech32_char :: Word8 -> Word8
bech32_char = Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word8 -> Word8) -> (Word8 -> Word8) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bech32_charset (Int -> Word8) -> (Word8 -> Int) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fi
  go :: ByteString -> Builder
go ByteString
bs = case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
5 ByteString
bs of
    (ByteString
chunk, ByteString
etc) -> case ByteString -> Int
BS.length ByteString
etc of
      -- https://datatracker.ietf.org/doc/html/rfc4648#section-6
      Int
0 | ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 -> case ByteString -> Maybe (ByteString, Word8)
BS.unsnoc ByteString
chunk of
            Maybe (ByteString, Word8)
Nothing -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible, chunk length is 5"
            Just (ByteString -> Word32
word32be -> Word32
w32, Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi -> Word32
w8) -> Word32 -> Word32 -> Builder
arrange Word32
w32 Word32
w8

        | ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
            let a :: Word8
a = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
0
                t :: Word8
t = Word8 -> Word8
bech32_char ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11111000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
3)
                u :: Word8
u = Word8 -> Word8
bech32_char ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
2)
            in  Word8 -> Builder
BSB.word8 Word8
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
u

        | ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 ->
            let a :: Word8
a = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
0
                b :: Word8
b = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
1
                t :: Word8
t = Word8 -> Word8
bech32_char ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11111000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
3)
                u :: Word8
u = Word8 -> Word8
bech32_char (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                          ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
2)
                      Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11000000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
6)
                v :: Word8
v = Word8 -> Word8
bech32_char ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111110) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
1)
                w :: Word8
w = Word8 -> Word8
bech32_char ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000001) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
4)
            in  Word8 -> Builder
BSB.word8 Word8
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
u Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
w

        | ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 ->
            let a :: Word8
a = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
0
                b :: Word8
b = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
1
                c :: Word8
c = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
2
                t :: Word8
t = Word8 -> Word8
bech32_char ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11111000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
3)
                u :: Word8
u = Word8 -> Word8
bech32_char (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                          ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
2)
                      Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11000000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
6)
                v :: Word8
v = Word8 -> Word8
bech32_char ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111110) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
1)
                w :: Word8
w = Word8 -> Word8
bech32_char (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                          ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000001) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
4)
                      Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11110000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
4)
                x :: Word8
x = Word8 -> Word8
bech32_char ((Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
1)
            in  Word8 -> Builder
BSB.word8 Word8
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
u Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
w
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
x

        | ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 ->
            let a :: Word8
a = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
0
                b :: Word8
b = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
1
                c :: Word8
c = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
2
                d :: Word8
d = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
chunk Int
3
                t :: Word8
t = Word8 -> Word8
bech32_char ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11111000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
3)
                u :: Word8
u = Word8 -> Word8
bech32_char (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                          ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
2)
                      Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11000000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
6)
                v :: Word8
v = Word8 -> Word8
bech32_char ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111110) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
1)
                w :: Word8
w = Word8 -> Word8
bech32_char (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                          ((Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000001) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
4)
                      Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11110000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
4)
                x :: Word8
x = Word8 -> Word8
bech32_char (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                          ((Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00001111) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
1)
                      Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
d Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b10000000) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
7)
                y :: Word8
y = Word8 -> Word8
bech32_char ((Word8
d Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01111100) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
2)
                z :: Word8
z = Word8 -> Word8
bech32_char ((Word8
d Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00000011) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
3)
            in  Word8 -> Builder
BSB.word8 Word8
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
u Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
w
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
z

        | Bool
otherwise -> Builder
forall a. Monoid a => a
mempty

      Int
_ -> case ByteString -> Maybe (ByteString, Word8)
BS.unsnoc ByteString
chunk of
        Maybe (ByteString, Word8)
Nothing -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible, chunk length is 5"
        Just (ByteString -> Word32
word32be -> Word32
w32, Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi -> Word32
w8) -> Word32 -> Word32 -> Builder
arrange Word32
w32 Word32
w8 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
go ByteString
etc

-- adapted from emilypi's 'base32' library
arrange :: Word32 -> Word32 -> BSB.Builder
arrange :: Word32 -> Word32 -> Builder
arrange Word32
w32 Word32
w8 =
  let mask :: Word32
mask = Word32
0b00011111
      bech32_char :: Word32 -> Word64
bech32_char = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fi (Word8 -> Word64) -> (Word32 -> Word8) -> Word32 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bech32_charset (Int -> Word8) -> (Word32 -> Int) -> Word32 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fi

      w8_0 :: Word64
w8_0 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
27))
      w8_1 :: Word64
w8_1 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
22))
      w8_2 :: Word64
w8_2 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
17))
      w8_3 :: Word64
w8_3 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
12))
      w8_4 :: Word64
w8_4 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
07))
      w8_5 :: Word64
w8_5 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
02))
      w8_6 :: Word64
w8_6 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
w32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
03 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
w8 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
05))
      w8_7 :: Word64
w8_7 = Word32 -> Word64
bech32_char (Word32
mask Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w8)

      w64 :: Word64
w64 = Word64
w8_0
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
8
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
16
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
24
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
32
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
40
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
48
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
w8_7 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
56

  in  Word64 -> Builder
BSB.word64LE Word64
w64

-- naive base32 -> word5
as_word5 :: BS.ByteString -> BS.ByteString
as_word5 :: ByteString -> ByteString
as_word5 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
f where
  f :: a -> a
f a
b = case Word8 -> ByteString -> Maybe Int
BS.elemIndex (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fi a
b) ByteString
bech32_charset of
    Maybe Int
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-bech32 (as_word5): input not bech32-encoded"
    Just Int
w -> Int -> a
forall a b. (Integral a, Num b) => a -> b
fi Int
w

-- naive word5 -> base32
as_base32 :: BS.ByteString -> BS.ByteString
as_base32 :: ByteString -> ByteString
as_base32 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bech32_charset (Int -> Word8) -> (Word8 -> Int) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fi)

polymod :: BS.ByteString -> Word32
polymod :: ByteString -> Word32
polymod = (Word32 -> Word8 -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Word32 -> Word8 -> Word32
forall {p}. Integral p => Word32 -> p -> Word32
alg Word32
1 where
  generator :: PrimArray Word32
generator = Int -> [Word32] -> PrimArray Word32
forall a. Prim a => Int -> [a] -> PrimArray a
PA.primArrayFromListN Int
5
    [Word32
0x3b6a57b2, Word32
0x26508e6d, Word32
0x1ea119fa, Word32
0x3d4233dd, Word32
0x2a1462b3]

  alg :: Word32 -> p -> Word32
alg !Word32
chk p
v =
    let !b :: Word32
b = Word32
chk Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
25
        c :: Word32
c = (Word32
chk Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x1ffffff) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
5 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` p -> Word32
forall a b. (Integral a, Num b) => a -> b
fi p
v
    in  Int -> Word32 -> Word32 -> Word32
forall {t}. Bits t => Int -> t -> Word32 -> Word32
loop_gen Int
0 Word32
b Word32
c

  loop_gen :: Int -> t -> Word32 -> Word32
loop_gen Int
i t
b !Word32
chk
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 = Word32
chk
    | Bool
otherwise =
        let sor :: Word32
sor | t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit (t
b t -> Int -> t
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
i) Int
0 =
                    PrimArray Word32 -> Int -> Word32
forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray PrimArray Word32
generator Int
i
                | Bool
otherwise = Word32
0
        in  Int -> t -> Word32 -> Word32
loop_gen (Int -> Int
forall a. Enum a => a -> a
succ Int
i) t
b (Word32
chk Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
sor)

valid_hrp :: BS.ByteString -> Bool
valid_hrp :: ByteString -> Bool
valid_hrp ByteString
hrp
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
83 = Bool
False
    | Bool
otherwise = (Word8 -> Bool) -> ByteString -> Bool
BS.all (\Word8
b -> (Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
32) Bool -> Bool -> Bool
&& (Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
127)) ByteString
hrp
  where
    l :: Int
l = ByteString -> Int
BS.length ByteString
hrp

hrp_expand :: BS.ByteString -> BS.ByteString
hrp_expand :: ByteString -> ByteString
hrp_expand ByteString
bs = Builder -> ByteString
toStrict
  (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$  ByteString -> Builder
BSB.byteString ((Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
5) ByteString
bs)
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ((Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11111) ByteString
bs)

data Encoding =
    Bech32
  | Bech32m

create_checksum :: Encoding -> BS.ByteString -> BS.ByteString -> BS.ByteString
create_checksum :: Encoding -> ByteString -> ByteString -> ByteString
create_checksum Encoding
enc ByteString
hrp ByteString
dat =
  let pre :: ByteString
pre = ByteString -> ByteString
hrp_expand ByteString
hrp ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
dat
      pay :: ByteString
pay = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
           ByteString -> Builder
BSB.byteString ByteString
pre
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
"\NUL\NUL\NUL\NUL\NUL\NUL"
      pm :: Word32
pm = ByteString -> Word32
polymod ByteString
pay Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` case Encoding
enc of
        Encoding
Bech32  -> Word32
1
        Encoding
Bech32m -> Word32
_BECH32M_CONST

      code :: a -> a
code a
i = (Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fi (Word32
pm Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` a -> Int
forall a b. (Integral a, Num b) => a -> b
fi a
i) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0b11111)

  in  (Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
forall {a} {a}. (Bits a, Integral a, Num a) => a -> a
code ByteString
"\EM\DC4\SI\n\ENQ\NUL" -- BS.pack [25, 20, 15, 10, 5, 0]

verify :: Encoding -> BS.ByteString -> Bool
verify :: Encoding -> ByteString -> Bool
verify Encoding
enc ByteString
b32 = case Word8 -> ByteString -> Maybe Int
BS.elemIndexEnd Word8
0x31 ByteString
b32 of
  Maybe Int
Nothing  -> Bool
False
  Just Int
idx ->
    let (ByteString
hrp, Int -> ByteString -> ByteString
BS.drop Int
1 -> ByteString
dat) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
idx ByteString
b32
        bs :: ByteString
bs = ByteString -> ByteString
hrp_expand ByteString
hrp ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
as_word5 ByteString
dat
    in  ByteString -> Word32
polymod ByteString
bs Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== case Encoding
enc of
          Encoding
Bech32 -> Word32
1
          Encoding
Bech32m -> Word32
_BECH32M_CONST