{-# 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 (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"

-- 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 (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
        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