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

module Data.ByteString.Bech32.Internal (
    as_word5
  , as_base32
  , 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.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word8, Word32)

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 #-}

-- 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
{-# INLINE toStrict #-}

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

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

word5 :: Word8 -> Maybe Word8
word5 :: Word8 -> Maybe Word8
word5 = \case
  Word8
113 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
00 -- 'q'
  Word8
112 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
01 -- 'p'
  Word8
122 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
02 -- 'z'
  Word8
114 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
03 -- 'r'
  Word8
121 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
04 -- 'y'
  Word8
57  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
05 -- '9'
  Word8
120 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
06 -- 'x'
  Word8
56  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
07 -- '8'
  Word8
103 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
08 -- 'g'
  Word8
102 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
09 -- 'f'
  Word8
50  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
10 -- '2'
  Word8
116 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
11 -- 't'
  Word8
118 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
12 -- 'v'
  Word8
100 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
13 -- 'd'
  Word8
119 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
14 -- 'w'
  Word8
48  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
15 -- '0'
  Word8
115 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
16 -- 's'
  Word8
51  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
17 -- '3'
  Word8
106 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
18 -- 'j'
  Word8
110 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
19 -- 'n'
  Word8
53  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
20 -- '5'
  Word8
52  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
21 -- '4'
  Word8
107 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
22 -- 'k'
  Word8
104 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
23 -- 'h'
  Word8
99  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
24 -- 'c'
  Word8
101 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
25 -- 'e'
  Word8
54  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
26 -- '6'
  Word8
109 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
27 -- 'm'
  Word8
117 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
28 -- 'u'
  Word8
97  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
29 -- 'a'
  Word8
55  -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
30 -- '7'
  Word8
108 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$! Word8
31 -- 'l'
  Word8
_   -> Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE word5 #-}

-- base32 -> word5
as_word5 :: BS.ByteString -> Maybe BS.ByteString
as_word5 :: ByteString -> Maybe ByteString
as_word5 = Builder -> ByteString -> Maybe ByteString
go Builder
forall a. Monoid a => a
mempty where
  go :: Builder -> ByteString -> Maybe ByteString
go Builder
acc ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
    Maybe (Word8, ByteString)
Nothing -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> ByteString
toStrict Builder
acc)
    Just (Word8
h, ByteString
t) -> do
      Word8
w5 <- Word8 -> Maybe Word8
word5 (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi Word8
h)
      Builder -> ByteString -> Maybe ByteString
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
w5) ByteString
t

-- word5 -> base32
as_base32 :: BS.ByteString -> BS.ByteString
as_base32 :: ByteString -> ByteString
as_base32 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (ByteString -> Int -> Word8
BU.unsafeIndex 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 :: Int -> Word32
  generator :: Int -> Word32
generator = \case
    Int
0 -> Word32
0x3b6a57b2
    Int
1 -> Word32
0x26508e6d
    Int
2 -> Word32
0x1ea119fa
    Int
3 -> Word32
0x3d4233dd
    Int
4 -> Word32
0x2a1462b3
    Int
_ -> [Char] -> Word32
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-bech32: internal error (please report this as a bug!)"

  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 = Int -> 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 hrp :: ByteString
hrp@(BI.PS ForeignPtr Word8
_ Int
_ Int
l)
  | 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

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
BU.unsafeDrop Int
1 -> ByteString
dat) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
idx ByteString
b32
        w5s :: Maybe ByteString
w5s = ByteString -> Maybe ByteString
as_word5 ByteString
dat
    in  case Maybe ByteString
w5s of
          Maybe ByteString
Nothing -> Bool
False
          Just ByteString
ws ->
            let bs :: ByteString
bs = ByteString -> ByteString
hrp_expand ByteString
hrp ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ws
            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