{-# OPTIONS_HADDOCK hide, prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# 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 Data.ByteString.Base32.Internal (enc_tab, dec_tab)
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word8, Word32)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (peekElemOff, pokeElemOff)
import System.IO.Unsafe (unsafeDupablePerformIO)

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

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

-- | Translate base32 bytestring to its 5-bit-value bytestring.  Each
--   input byte is looked up in 'dec_tab'; if any byte is not a valid
--   bech32 char, returns 'Nothing'.
as_word5 :: BS.ByteString -> Maybe BS.ByteString
as_word5 :: ByteString -> Maybe ByteString
as_word5 (BI.PS ForeignPtr Word8
sfp Int
soff Int
l) = case ByteString
dec_tab of
  BI.PS ForeignPtr Word8
tfp Int
toff Int
_ -> IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ do
    fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
BI.mallocByteString Int
l
    ok <- withForeignPtr fp  $ \Ptr Word8
dst ->
          ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sp0 ->
          ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
tfp ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tp0 -> do
            let !sp :: Ptr Word8
sp = Ptr Word8
sp0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff :: Ptr Word8
                !tp :: Ptr Word8
tp = Ptr Word8
tp0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
toff :: Ptr Word8
                loop :: Int -> Word8 -> IO Bool
loop !Int
i !Word8
acc
                  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l    = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! Word8
acc Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
                  | Bool
otherwise = do
                      c <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
sp Int
i
                      n <- peekElemOff tp (fi c)
                      pokeElemOff dst i (n .&. 0x1f)
                      loop (i + 1) (acc .|. n)
            Int -> Word8 -> IO Bool
loop Int
0 Word8
0
    pure $! if ok then Just (BI.PS fp 0 l) else Nothing

-- | Translate a 5-bit-value bytestring to its bech32 base32
--   bytestring.
as_base32 :: BS.ByteString -> BS.ByteString
as_base32 :: ByteString -> ByteString
as_base32 (BI.PS ForeignPtr Word8
sfp Int
soff Int
l) = case ByteString
enc_tab of
  BI.PS ForeignPtr Word8
tfp Int
toff Int
_ ->
    Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
l ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sp0 ->
      ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
tfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tp0 -> do
        let !sp :: Ptr Word8
sp = Ptr Word8
sp0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff :: Ptr Word8
            !tp :: Ptr Word8
tp = Ptr Word8
tp0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
toff :: Ptr Word8
            loop :: Int -> IO ()
loop !Int
i
              | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l    = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              | Bool
otherwise = do
                  v <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
sp Int
i
                  c <- peekElemOff tp (fi v)
                  pokeElemOff dst i c
                  loop (i + 1)
        Int -> IO ()
loop Int
0

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

-- | Build the bech32 HRP expansion: high-5-bits of each HRP byte,
--   then a single 0, then low-5-bits of each HRP byte.
hrp_expand :: BS.ByteString -> BS.ByteString
hrp_expand :: ByteString -> ByteString
hrp_expand (BI.PS ForeignPtr Word8
sfp Int
soff Int
l) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sp0 -> do
      let !sp :: Ptr Word8
sp = Ptr Word8
sp0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
soff :: Ptr Word8
          loop_hi :: Int -> IO ()
loop_hi !Int
i
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l    = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise = do
                c <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
sp Int
i
                pokeElemOff dst i (c `B.shiftR` 5)
                loop_hi (i + 1)
          loop_lo :: Int -> IO ()
loop_lo !Int
i
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l    = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise = do
                c <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
sp Int
i
                pokeElemOff dst (l + 1 + i) (c .&. 0x1f)
                loop_lo (i + 1)
      Int -> IO ()
loop_hi Int
0
      Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
l (Word8
0 :: Word8)
      Int -> IO ()
loop_lo Int
0

data Encoding =
    Bech32
  | Bech32m

zero6 :: BS.ByteString
zero6 :: ByteString
zero6 = Int -> Word8 -> ByteString
BS.replicate Int
6 Word8
0
{-# NOINLINE zero6 #-}

create_checksum
  :: Encoding -> BS.ByteString -> BS.ByteString -> BS.ByteString
create_checksum :: Encoding -> ByteString -> ByteString -> ByteString
create_checksum Encoding
enc ByteString
hrp ByteString
dat =
  let !pay :: ByteString
pay = [ByteString] -> ByteString
BS.concat [ByteString -> ByteString
hrp_expand ByteString
hrp, ByteString
dat, ByteString
zero6]
      !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
  in  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
6 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
0 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
pm Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
25) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
1 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
pm Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
20) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
2 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
pm Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
15) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
3 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
pm Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
10) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
4 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
pm Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR`  Int
5) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
5 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi  Word32
pm               Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f :: Word8)

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