{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Haskoin.Address.Base58
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- Support for Bitcoin SegWit (BTC) Bech32 addresses. This module is a modified
-- version of Marko Bencun's reference implementation.
module Haskoin.Address.Bech32
  ( -- * Bech32
    HRP,
    Bech32,
    Bech32Encoding (..),
    bech32Const,
    Data,
    bech32Encode,
    bech32Decode,
    toBase32,
    toBase256,
    segwitEncode,
    segwitDecode,
    Word5 (..),
    word5,
    fromWord5,
  )
where

import Control.Monad (guard)
import Data.Array
  ( Array,
    assocs,
    bounds,
    listArray,
    (!),
    (//),
  )
import Data.Bits
  ( Bits,
    testBit,
    unsafeShiftL,
    unsafeShiftR,
    xor,
    (.&.),
    (.|.),
  )
import Data.ByteString qualified as B
import Data.Char (toUpper)
import Data.Foldable (foldl')
import Data.Functor.Identity (Identity, runIdentity)
import Data.Ix (Ix (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as E
import Data.Word (Word8)

data Bech32Encoding = Bech32 | Bech32m
  deriving (Bech32Encoding -> Bech32Encoding -> Bool
(Bech32Encoding -> Bech32Encoding -> Bool)
-> (Bech32Encoding -> Bech32Encoding -> Bool) -> Eq Bech32Encoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bech32Encoding -> Bech32Encoding -> Bool
== :: Bech32Encoding -> Bech32Encoding -> Bool
$c/= :: Bech32Encoding -> Bech32Encoding -> Bool
/= :: Bech32Encoding -> Bech32Encoding -> Bool
Eq, Int -> Bech32Encoding -> ShowS
[Bech32Encoding] -> ShowS
Bech32Encoding -> [Char]
(Int -> Bech32Encoding -> ShowS)
-> (Bech32Encoding -> [Char])
-> ([Bech32Encoding] -> ShowS)
-> Show Bech32Encoding
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bech32Encoding -> ShowS
showsPrec :: Int -> Bech32Encoding -> ShowS
$cshow :: Bech32Encoding -> [Char]
show :: Bech32Encoding -> [Char]
$cshowList :: [Bech32Encoding] -> ShowS
showList :: [Bech32Encoding] -> ShowS
Show, Eq Bech32Encoding
Eq Bech32Encoding =>
(Bech32Encoding -> Bech32Encoding -> Ordering)
-> (Bech32Encoding -> Bech32Encoding -> Bool)
-> (Bech32Encoding -> Bech32Encoding -> Bool)
-> (Bech32Encoding -> Bech32Encoding -> Bool)
-> (Bech32Encoding -> Bech32Encoding -> Bool)
-> (Bech32Encoding -> Bech32Encoding -> Bech32Encoding)
-> (Bech32Encoding -> Bech32Encoding -> Bech32Encoding)
-> Ord Bech32Encoding
Bech32Encoding -> Bech32Encoding -> Bool
Bech32Encoding -> Bech32Encoding -> Ordering
Bech32Encoding -> Bech32Encoding -> Bech32Encoding
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Bech32Encoding -> Bech32Encoding -> Ordering
compare :: Bech32Encoding -> Bech32Encoding -> Ordering
$c< :: Bech32Encoding -> Bech32Encoding -> Bool
< :: Bech32Encoding -> Bech32Encoding -> Bool
$c<= :: Bech32Encoding -> Bech32Encoding -> Bool
<= :: Bech32Encoding -> Bech32Encoding -> Bool
$c> :: Bech32Encoding -> Bech32Encoding -> Bool
> :: Bech32Encoding -> Bech32Encoding -> Bool
$c>= :: Bech32Encoding -> Bech32Encoding -> Bool
>= :: Bech32Encoding -> Bech32Encoding -> Bool
$cmax :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
max :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
$cmin :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
min :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
Ord, Int -> Bech32Encoding
Bech32Encoding -> Int
Bech32Encoding -> [Bech32Encoding]
Bech32Encoding -> Bech32Encoding
Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
Bech32Encoding
-> Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
(Bech32Encoding -> Bech32Encoding)
-> (Bech32Encoding -> Bech32Encoding)
-> (Int -> Bech32Encoding)
-> (Bech32Encoding -> Int)
-> (Bech32Encoding -> [Bech32Encoding])
-> (Bech32Encoding -> Bech32Encoding -> [Bech32Encoding])
-> (Bech32Encoding -> Bech32Encoding -> [Bech32Encoding])
-> (Bech32Encoding
    -> Bech32Encoding -> Bech32Encoding -> [Bech32Encoding])
-> Enum Bech32Encoding
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Bech32Encoding -> Bech32Encoding
succ :: Bech32Encoding -> Bech32Encoding
$cpred :: Bech32Encoding -> Bech32Encoding
pred :: Bech32Encoding -> Bech32Encoding
$ctoEnum :: Int -> Bech32Encoding
toEnum :: Int -> Bech32Encoding
$cfromEnum :: Bech32Encoding -> Int
fromEnum :: Bech32Encoding -> Int
$cenumFrom :: Bech32Encoding -> [Bech32Encoding]
enumFrom :: Bech32Encoding -> [Bech32Encoding]
$cenumFromThen :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
enumFromThen :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
$cenumFromTo :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
enumFromTo :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
$cenumFromThenTo :: Bech32Encoding
-> Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
enumFromThenTo :: Bech32Encoding
-> Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
Enum)

-- | Bech32 human-readable string.
type Bech32 = Text

-- | Human-readable part of 'Bech32' address.
type HRP = Text

-- | Data part of 'Bech32' address.
type Data = [Word8]

(.>>.), (.<<.) :: (Bits a) => a -> Int -> a
.>>. :: forall a. Bits a => a -> Int -> a
(.>>.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR
.<<. :: forall a. Bits a => a -> Int -> a
(.<<.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL

-- | Five-bit word for Bech32.
newtype Word5
  = UnsafeWord5 Word8
  deriving (Word5 -> Word5 -> Bool
(Word5 -> Word5 -> Bool) -> (Word5 -> Word5 -> Bool) -> Eq Word5
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word5 -> Word5 -> Bool
== :: Word5 -> Word5 -> Bool
$c/= :: Word5 -> Word5 -> Bool
/= :: Word5 -> Word5 -> Bool
Eq, Eq Word5
Eq Word5 =>
(Word5 -> Word5 -> Ordering)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Bool)
-> (Word5 -> Word5 -> Word5)
-> (Word5 -> Word5 -> Word5)
-> Ord Word5
Word5 -> Word5 -> Bool
Word5 -> Word5 -> Ordering
Word5 -> Word5 -> Word5
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Word5 -> Word5 -> Ordering
compare :: Word5 -> Word5 -> Ordering
$c< :: Word5 -> Word5 -> Bool
< :: Word5 -> Word5 -> Bool
$c<= :: Word5 -> Word5 -> Bool
<= :: Word5 -> Word5 -> Bool
$c> :: Word5 -> Word5 -> Bool
> :: Word5 -> Word5 -> Bool
$c>= :: Word5 -> Word5 -> Bool
>= :: Word5 -> Word5 -> Bool
$cmax :: Word5 -> Word5 -> Word5
max :: Word5 -> Word5 -> Word5
$cmin :: Word5 -> Word5 -> Word5
min :: Word5 -> Word5 -> Word5
Ord)

instance Ix Word5 where
  range :: (Word5, Word5) -> [Word5]
range (UnsafeWord5 Word8
m, UnsafeWord5 Word8
n) = (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word5
UnsafeWord5 ([Word8] -> [Word5]) -> [Word8] -> [Word5]
forall a b. (a -> b) -> a -> b
$ (Word8, Word8) -> [Word8]
forall a. Ix a => (a, a) -> [a]
range (Word8
m, Word8
n)
  index :: (Word5, Word5) -> Word5 -> Int
index (UnsafeWord5 Word8
m, UnsafeWord5 Word8
n) (UnsafeWord5 Word8
i) = (Word8, Word8) -> Word8 -> Int
forall a. Ix a => (a, a) -> a -> Int
index (Word8
m, Word8
n) Word8
i
  inRange :: (Word5, Word5) -> Word5 -> Bool
inRange (Word5
m, Word5
n) Word5
i = Word5
m Word5 -> Word5 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word5
i Bool -> Bool -> Bool
&& Word5
i Word5 -> Word5 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word5
n

-- | Convert an integer number into a five-bit word.
word5 :: (Integral a) => a -> Word5
word5 :: forall a. Integral a => a -> Word5
word5 a
x = Word8 -> Word5
UnsafeWord5 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
31)
{-# INLINE word5 #-}
{-# SPECIALIZE INLINE word5 :: Word8 -> Word5 #-}

-- | Convert a five-bit word into a number.
fromWord5 :: (Num a) => Word5 -> a
fromWord5 :: forall a. Num a => Word5 -> a
fromWord5 (UnsafeWord5 Word8
x) = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
{-# INLINE fromWord5 #-}
{-# SPECIALIZE INLINE fromWord5 :: Word5 -> Word8 #-}

-- | 'Bech32' character map as array of five-bit integers to character.
charset :: Array Word5 Char
charset :: Array Word5 Char
charset =
  (Word5, Word5) -> [Char] -> Array Word5 Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Word8 -> Word5
UnsafeWord5 Word8
0, Word8 -> Word5
UnsafeWord5 Word8
31) [Char]
"qpzry9x8gf2tvdw0s3jn54khce6mua7l"

-- | Convert a character to its five-bit value from 'Bech32' 'charset'.
charsetMap :: Char -> Maybe Word5
charsetMap :: Char -> Maybe Word5
charsetMap Char
c
  | (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char (Maybe Word5) -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char (Maybe Word5)
inv) Char
upperC = Array Char (Maybe Word5)
inv Array Char (Maybe Word5) -> Char -> Maybe Word5
forall i e. Ix i => Array i e -> i -> e
! Char
upperC
  | Bool
otherwise = Maybe Word5
forall a. Maybe a
Nothing
  where
    upperC :: Char
upperC = Char -> Char
toUpper Char
c
    inv :: Array Char (Maybe Word5)
inv = (Char, Char) -> [Maybe Word5] -> Array Char (Maybe Word5)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Char
'0', Char
'Z') (Maybe Word5 -> [Maybe Word5]
forall a. a -> [a]
repeat Maybe Word5
forall a. Maybe a
Nothing) Array Char (Maybe Word5)
-> [(Char, Maybe Word5)] -> Array Char (Maybe Word5)
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// ((Word5, Char) -> (Char, Maybe Word5))
-> [(Word5, Char)] -> [(Char, Maybe Word5)]
forall a b. (a -> b) -> [a] -> [b]
map (Word5, Char) -> (Char, Maybe Word5)
forall {a}. (a, Char) -> (Char, Maybe a)
swap (Array Word5 Char -> [(Word5, Char)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs Array Word5 Char
charset)
    swap :: (a, Char) -> (Char, Maybe a)
swap (a
a, Char
b) = (Char -> Char
toUpper Char
b, a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | Calculate or validate 'Bech32' checksum.
bech32Polymod :: [Word5] -> Word
bech32Polymod :: [Word5] -> Word
bech32Polymod [Word5]
values = (Word -> Word5 -> Word) -> Word -> [Word5] -> Word
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word -> Word5 -> Word
forall {a}. (Bits a, Num a) => a -> Word5 -> a
go Word
1 [Word5]
values Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3fffffff
  where
    go :: a -> Word5 -> a
go a
chk Word5
value =
      (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Bits a => a -> a -> a
xor a
chk' [a
g | (a
g, Int
i) <- [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
generator [Int
25 ..], a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
chk Int
i]
      where
        generator :: [a]
generator = [a
0x3b6a57b2, a
0x26508e6d, a
0x1ea119fa, a
0x3d4233dd, a
0x2a1462b3]
        chk' :: a
chk' = a
chk a -> Int -> a
forall a. Bits a => a -> Int -> a
.<<. Int
5 a -> a -> a
forall a. Bits a => a -> a -> a
`xor` Word5 -> a
forall a. Num a => Word5 -> a
fromWord5 Word5
value

-- | Convert human-readable part of 'Bech32' string into a list of five-bit
-- words.
bech32HRPExpand :: HRP -> [Word5]
bech32HRPExpand :: Text -> [Word5]
bech32HRPExpand Text
hrp =
  (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Word5
UnsafeWord5 (Word8 -> Word5) -> (Word8 -> Word8) -> Word8 -> Word5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
5)) [Word8]
hrpBytes
    [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word8 -> Word5
UnsafeWord5 Word8
0]
    [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word5
forall a. Integral a => a -> Word5
word5 [Word8]
hrpBytes
  where
    hrpBytes :: [Word8]
hrpBytes = ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
hrp

bech32Const :: Bech32Encoding -> Word
bech32Const :: Bech32Encoding -> Word
bech32Const Bech32Encoding
Bech32 = Word
0x00000001
bech32Const Bech32Encoding
Bech32m = Word
0x2bc830a3

-- | Calculate Bech32 checksum for a string of five-bit words.
bech32CreateChecksum :: Bech32Encoding -> HRP -> [Word5] -> [Word5]
bech32CreateChecksum :: Bech32Encoding -> Text -> [Word5] -> [Word5]
bech32CreateChecksum Bech32Encoding
enc Text
hrp [Word5]
dat = [Word -> Word5
forall a. Integral a => a -> Word5
word5 (Word
polymod Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.>>. Int
i) | Int
i <- [Int
25, Int
20 .. Int
0]]
  where
    values :: [Word5]
values = Text -> [Word5]
bech32HRPExpand Text
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word5]
dat
    w5 :: [Word5]
w5 = [Word5]
values [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ (Word8 -> Word5) -> [Word8] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word5
UnsafeWord5 [Word8
0, Word8
0, Word8
0, Word8
0, Word8
0, Word8
0]
    polymod :: Word
polymod = [Word5] -> Word
bech32Polymod [Word5]
w5 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Bech32Encoding -> Word
bech32Const Bech32Encoding
enc

-- | Verify Bech32 checksum for a human-readable part and string of five-bit words.
bech32VerifyChecksum :: HRP -> [Word5] -> Maybe Bech32Encoding
bech32VerifyChecksum :: Text -> [Word5] -> Maybe Bech32Encoding
bech32VerifyChecksum Text
hrp [Word5]
dat =
  let poly :: Word
poly = [Word5] -> Word
bech32Polymod (Text -> [Word5]
bech32HRPExpand Text
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word5]
dat)
   in if
          | Word
poly Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Bech32Encoding -> Word
bech32Const Bech32Encoding
Bech32 -> Bech32Encoding -> Maybe Bech32Encoding
forall a. a -> Maybe a
Just Bech32Encoding
Bech32
          | Word
poly Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Bech32Encoding -> Word
bech32Const Bech32Encoding
Bech32m -> Bech32Encoding -> Maybe Bech32Encoding
forall a. a -> Maybe a
Just Bech32Encoding
Bech32m
          | Bool
otherwise -> Maybe Bech32Encoding
forall a. Maybe a
Nothing

-- | Maximum length of a Bech32 result.
maxBech32Length :: Int
maxBech32Length :: Int
maxBech32Length = Int
90

-- | Encode string of five-bit words into 'Bech32' using a provided
-- human-readable part. Can fail if 'HRP' is invalid or result would be longer
-- than 90 characters.
bech32Encode :: Bech32Encoding -> HRP -> [Word5] -> Maybe Bech32
bech32Encode :: Bech32Encoding -> Text -> [Word5] -> Maybe Text
bech32Encode Bech32Encoding
enc Text
hrp [Word5]
dat = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
checkHRP Text
hrp
  let dat' :: [Word5]
dat' = [Word5]
dat [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ Bech32Encoding -> Text -> [Word5] -> [Word5]
bech32CreateChecksum Bech32Encoding
enc (Text -> Text
T.toLower Text
hrp) [Word5]
dat
      rest :: [Char]
rest = (Word5 -> Char) -> [Word5] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Array Word5 Char
charset Array Word5 Char -> Word5 -> Char
forall i e. Ix i => Array i e -> i -> e
!) [Word5]
dat'
      result :: Text
result = [Text] -> Text
T.concat [Text -> Text
T.toLower Text
hrp, [Char] -> Text
T.pack [Char]
"1", [Char] -> Text
T.pack [Char]
rest]
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
result Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxBech32Length
  Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result

-- | Check that human-readable part is valid for a 'Bech32' string.
checkHRP :: HRP -> Bool
checkHRP :: Text -> Bool
checkHRP Text
hrp =
  Bool -> Bool
not (Text -> Bool
T.null Text
hrp)
    Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (\Char
char -> Char
char Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x21' Bool -> Bool -> Bool
&& Char
char Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7e') Text
hrp

-- | Decode human-readable 'Bech32' string into a human-readable part and a
-- string of five-bit words.
bech32Decode :: Bech32 -> Maybe (Bech32Encoding, HRP, [Word5])
bech32Decode :: Text -> Maybe (Bech32Encoding, Text, [Word5])
bech32Decode Text
bech32 = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
bech32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxBech32Length
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
bech32 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bech32 Bool -> Bool -> Bool
|| Text
lowerBech32 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bech32
  let (Text
hrp, Text
dat) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"1" Text
lowerBech32
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
dat Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6
  Text
hrp' <- Text -> Text -> Maybe Text
T.stripSuffix Text
"1" Text
hrp
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
checkHRP Text
hrp'
  [Word5]
dat' <- (Char -> Maybe Word5) -> [Char] -> Maybe [Word5]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> Maybe Word5
charsetMap ([Char] -> Maybe [Word5]) -> [Char] -> Maybe [Word5]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
dat
  Bech32Encoding
enc <- Text -> [Word5] -> Maybe Bech32Encoding
bech32VerifyChecksum Text
hrp' [Word5]
dat'
  (Bech32Encoding, Text, [Word5])
-> Maybe (Bech32Encoding, Text, [Word5])
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bech32Encoding
enc, Text
hrp', Int -> [Word5] -> [Word5]
forall a. Int -> [a] -> [a]
take (Text -> Int
T.length Text
dat Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6) [Word5]
dat')
  where
    lowerBech32 :: Text
lowerBech32 = Text -> Text
T.toLower Text
bech32

type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]]

yesPadding :: Pad Identity
yesPadding :: Pad Identity
yesPadding Int
_ Int
0 Word
_ [[Word]]
result = [[Word]] -> Identity [[Word]]
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Word]]
result
yesPadding Int
_ Int
_ Word
padValue [[Word]]
result = [[Word]] -> Identity [[Word]]
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Word]] -> Identity [[Word]]) -> [[Word]] -> Identity [[Word]]
forall a b. (a -> b) -> a -> b
$ [Word
padValue] [Word] -> [[Word]] -> [[Word]]
forall a. a -> [a] -> [a]
: [[Word]]
result
{-# INLINE yesPadding #-}

noPadding :: Pad Maybe
noPadding :: Pad Maybe
noPadding Int
frombits Int
bits Word
padValue [[Word]]
result = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
frombits Bool -> Bool -> Bool
&& Word
padValue Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
  [[Word]] -> Maybe [[Word]]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Word]]
result
{-# INLINE noPadding #-}

-- | Big endian conversion of a bytestring from base \(2^{frombits}\) to base
-- \(2^{tobits}\). {frombits} and {twobits} must be positive and
-- \(2^{frombits}\) and \(2^{tobits}\) must be smaller than the size of Word.
-- Every value in 'dat' must be strictly smaller than \(2^{frombits}\).
convertBits :: (Functor f) => [Word] -> Int -> Int -> Pad f -> f [Word]
convertBits :: forall (f :: * -> *).
Functor f =>
[Word] -> Int -> Int -> Pad f -> f [Word]
convertBits [Word]
dat Int
frombits Int
tobits Pad f
pad = [[Word]] -> [Word]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word]] -> [Word])
-> ([[Word]] -> [[Word]]) -> [[Word]] -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word]] -> [[Word]]
forall a. [a] -> [a]
reverse ([[Word]] -> [Word]) -> f [[Word]] -> f [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word] -> Word -> Int -> [[Word]] -> f [[Word]]
forall {a}.
Integral a =>
[a] -> Word -> Int -> [[Word]] -> f [[Word]]
go [Word]
dat Word
0 Int
0 []
  where
    go :: [a] -> Word -> Int -> [[Word]] -> f [[Word]]
go [] Word
acc Int
bits [[Word]]
result =
      let padValue :: Word
padValue = (Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. (Int
tobits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bits)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
maxv
       in Pad f
pad Int
frombits Int
bits Word
padValue [[Word]]
result
    go (a
value : [a]
dat') Word
acc Int
bits [[Word]]
result =
      [a] -> Word -> Int -> [[Word]] -> f [[Word]]
go [a]
dat' Word
acc' (Int
bits' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
tobits) ([Word]
result' [Word] -> [[Word]] -> [[Word]]
forall a. a -> [a] -> [a]
: [[Word]]
result)
      where
        acc' :: Word
acc' = (Word
acc Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. Int
frombits) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. a -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
value
        bits' :: Int
bits' = Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
frombits
        result' :: [Word]
result' =
          [ (Word
acc' Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.>>. Int
b) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
maxv
            | Int
b <- [Int
bits' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tobits, Int
bits' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tobits .. Int
0]
          ]
    maxv :: Word
maxv = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. Int
tobits) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
{-# INLINE convertBits #-}

-- | Convert from eight-bit to five-bit word string, adding padding as required.
toBase32 :: [Word8] -> [Word5]
toBase32 :: [Word8] -> [Word5]
toBase32 [Word8]
dat =
  (Word -> Word5) -> [Word] -> [Word5]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Word5
forall a. Integral a => a -> Word5
word5 ([Word] -> [Word5]) -> [Word] -> [Word5]
forall a b. (a -> b) -> a -> b
$ Identity [Word] -> [Word]
forall a. Identity a -> a
runIdentity (Identity [Word] -> [Word]) -> Identity [Word] -> [Word]
forall a b. (a -> b) -> a -> b
$ [Word] -> Int -> Int -> Pad Identity -> Identity [Word]
forall (f :: * -> *).
Functor f =>
[Word] -> Int -> Int -> Pad f -> f [Word]
convertBits ((Word8 -> Word) -> [Word8] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8]
dat) Int
8 Int
5 Pad Identity
yesPadding

-- | Convert from five-bit word string to eight-bit word string, ignoring padding.
toBase256 :: [Word5] -> Maybe [Word8]
toBase256 :: [Word5] -> Maybe [Word8]
toBase256 [Word5]
dat =
  (Word -> Word8) -> [Word] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word] -> [Word8]) -> Maybe [Word] -> Maybe [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word] -> Int -> Int -> Pad Maybe -> Maybe [Word]
forall (f :: * -> *).
Functor f =>
[Word] -> Int -> Int -> Pad f -> f [Word]
convertBits ((Word5 -> Word) -> [Word5] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Word5 -> Word
forall a. Num a => Word5 -> a
fromWord5 [Word5]
dat) Int
5 Int
8 Pad Maybe
noPadding

-- | Check if witness version and program are valid.
segwitCheck :: Bech32Encoding -> Word8 -> Data -> Bool
segwitCheck :: Bech32Encoding -> Word8 -> [Word8] -> Bool
segwitCheck Bech32Encoding
enc Word8
witver [Word8]
witprog =
  Word8
witver Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
16
    Bool -> Bool -> Bool
&& if Word8
witver Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
      then Bech32Encoding
enc Bech32Encoding -> Bech32Encoding -> Bool
forall a. Eq a => a -> a -> Bool
== Bech32Encoding
Bech32 Bool -> Bool -> Bool
&& ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
witprog Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
20 Bool -> Bool -> Bool
|| [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
witprog Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32)
      else Bech32Encoding
enc Bech32Encoding -> Bech32Encoding -> Bool
forall a. Eq a => a -> a -> Bool
== Bech32Encoding
Bech32m Bool -> Bool -> Bool
&& ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
witprog Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
witprog Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
40)

-- | Decode SegWit 'Bech32' address from a string and expected human-readable part.
segwitDecode :: HRP -> Bech32 -> Maybe (Word8, Data)
segwitDecode :: Text -> Text -> Maybe (Word8, [Word8])
segwitDecode Text
hrp Text
addr = do
  (Bech32Encoding
enc, Text
hrp', [Word5]
dat) <- Text -> Maybe (Bech32Encoding, Text, [Word5])
bech32Decode Text
addr
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Text
hrp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
hrp') Bool -> Bool -> Bool
&& Bool -> Bool
not ([Word5] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word5]
dat)
  let (UnsafeWord5 Word8
witver : [Word5]
datBase32) = [Word5]
dat
  [Word8]
decoded <- [Word5] -> Maybe [Word8]
toBase256 [Word5]
datBase32
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bech32Encoding -> Word8 -> [Word8] -> Bool
segwitCheck Bech32Encoding
enc Word8
witver [Word8]
decoded
  (Word8, [Word8]) -> Maybe (Word8, [Word8])
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
witver, [Word8]
decoded)

-- | Encode 'Data' as a SegWit 'Bech32' address. Needs human-readable part and
-- witness program version.
segwitEncode :: HRP -> Word8 -> Data -> Maybe Text
segwitEncode :: Text -> Word8 -> [Word8] -> Maybe Text
segwitEncode Text
hrp Word8
witver [Word8]
witprog = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bech32Encoding -> Word8 -> [Word8] -> Bool
segwitCheck Bech32Encoding
enc Word8
witver [Word8]
witprog
  Bech32Encoding -> Text -> [Word5] -> Maybe Text
bech32Encode Bech32Encoding
enc Text
hrp ([Word5] -> Maybe Text) -> [Word5] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Word5
UnsafeWord5 Word8
witver Word5 -> [Word5] -> [Word5]
forall a. a -> [a] -> [a]
: [Word8] -> [Word5]
toBase32 [Word8]
witprog
  where
    enc :: Bech32Encoding
enc = if Word8
witver Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Bech32Encoding
Bech32 else Bech32Encoding
Bech32m