{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
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 qualified Data.ByteString 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 qualified Data.Text as T
import qualified Data.Text.Encoding 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
/= :: Bech32Encoding -> Bech32Encoding -> Bool
$c/= :: Bech32Encoding -> Bech32Encoding -> Bool
== :: Bech32Encoding -> Bech32Encoding -> Bool
$c== :: Bech32Encoding -> Bech32Encoding -> Bool
Eq, Int -> Bech32Encoding -> ShowS
[Bech32Encoding] -> ShowS
Bech32Encoding -> String
(Int -> Bech32Encoding -> ShowS)
-> (Bech32Encoding -> String)
-> ([Bech32Encoding] -> ShowS)
-> Show Bech32Encoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bech32Encoding] -> ShowS
$cshowList :: [Bech32Encoding] -> ShowS
show :: Bech32Encoding -> String
$cshow :: Bech32Encoding -> String
showsPrec :: Int -> Bech32Encoding -> ShowS
$cshowsPrec :: Int -> 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
min :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
$cmin :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
max :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
$cmax :: Bech32Encoding -> Bech32Encoding -> Bech32Encoding
>= :: Bech32Encoding -> Bech32Encoding -> Bool
$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
compare :: Bech32Encoding -> Bech32Encoding -> Ordering
$ccompare :: Bech32Encoding -> Bech32Encoding -> Ordering
$cp1Ord :: Eq 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
enumFromThenTo :: Bech32Encoding
-> Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
$cenumFromThenTo :: Bech32Encoding
-> Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
enumFromTo :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
$cenumFromTo :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
enumFromThen :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
$cenumFromThen :: Bech32Encoding -> Bech32Encoding -> [Bech32Encoding]
enumFrom :: Bech32Encoding -> [Bech32Encoding]
$cenumFrom :: Bech32Encoding -> [Bech32Encoding]
fromEnum :: Bech32Encoding -> Int
$cfromEnum :: Bech32Encoding -> Int
toEnum :: Int -> Bech32Encoding
$ctoEnum :: Int -> Bech32Encoding
pred :: Bech32Encoding -> Bech32Encoding
$cpred :: Bech32Encoding -> Bech32Encoding
succ :: Bech32Encoding -> Bech32Encoding
$csucc :: 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
.>>. :: a -> Int -> a
(.>>.) = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR
.<<. :: 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
/= :: Word5 -> Word5 -> Bool
$c/= :: Word5 -> Word5 -> Bool
== :: Word5 -> Word5 -> Bool
$c== :: 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
min :: Word5 -> Word5 -> Word5
$cmin :: Word5 -> Word5 -> Word5
max :: Word5 -> Word5 -> Word5
$cmax :: Word5 -> Word5 -> Word5
>= :: Word5 -> Word5 -> Bool
$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
compare :: Word5 -> Word5 -> Ordering
$ccompare :: Word5 -> Word5 -> Ordering
$cp1Ord :: Eq 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 :: 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 :: 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) -> String -> 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) String
"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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word -> Word5 -> Word
forall b. (Bits b, Num b) => b -> Word5 -> b
go Word
1 [Word5]
values Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3fffffff
  where
    go :: b -> Word5 -> b
go b
chk Word5
value =
        (b -> b -> b) -> b -> [b] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> b -> b
forall a. Bits a => a -> a -> a
xor b
chk' [b
g | (b
g, Int
i) <- [b] -> [Int] -> [(b, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b]
generator [Int
25 ..], b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
chk Int
i]
      where
        generator :: [b]
generator = [b
0x3b6a57b2, b
0x26508e6d, b
0x1ea119fa, b
0x3d4233dd, b
0x2a1462b3]
        chk' :: b
chk' = b
chk b -> Int -> b
forall a. Bits a => a -> Int -> a
.<<. Int
5 b -> b -> b
forall a. Bits a => a -> a -> a
`xor` Word5 -> b
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 :: HRP -> [Word5]
bech32HRPExpand HRP
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
$ HRP -> ByteString
E.encodeUtf8 HRP
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 -> HRP -> [Word5] -> [Word5]
bech32CreateChecksum Bech32Encoding
enc HRP
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 = HRP -> [Word5]
bech32HRPExpand HRP
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 :: HRP -> [Word5] -> Maybe Bech32Encoding
bech32VerifyChecksum HRP
hrp [Word5]
dat =
    let poly :: Word
poly = [Word5] -> Word
bech32Polymod (HRP -> [Word5]
bech32HRPExpand HRP
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 -> HRP -> [Word5] -> Maybe HRP
bech32Encode Bech32Encoding
enc HRP
hrp [Word5]
dat = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HRP -> Bool
checkHRP HRP
hrp
    let dat' :: [Word5]
dat' = [Word5]
dat [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ Bech32Encoding -> HRP -> [Word5] -> [Word5]
bech32CreateChecksum Bech32Encoding
enc (HRP -> HRP
T.toLower HRP
hrp) [Word5]
dat
        rest :: String
rest = (Word5 -> Char) -> [Word5] -> String
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 :: HRP
result = [HRP] -> HRP
T.concat [HRP -> HRP
T.toLower HRP
hrp, String -> HRP
T.pack String
"1", String -> HRP
T.pack String
rest]
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HRP -> Int
T.length HRP
result Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxBech32Length
    HRP -> Maybe HRP
forall (m :: * -> *) a. Monad m => a -> m a
return HRP
result

-- | Check that human-readable part is valid for a 'Bech32' string.
checkHRP :: HRP -> Bool
checkHRP :: HRP -> Bool
checkHRP HRP
hrp =
    Bool -> Bool
not (HRP -> Bool
T.null HRP
hrp)
        Bool -> Bool -> Bool
&& (Char -> Bool) -> HRP -> 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') HRP
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 :: HRP -> Maybe (Bech32Encoding, HRP, [Word5])
bech32Decode HRP
bech32 = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HRP -> Int
T.length HRP
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
$ HRP -> HRP
T.toUpper HRP
bech32 HRP -> HRP -> Bool
forall a. Eq a => a -> a -> Bool
== HRP
bech32 Bool -> Bool -> Bool
|| HRP
lowerBech32 HRP -> HRP -> Bool
forall a. Eq a => a -> a -> Bool
== HRP
bech32
    let (HRP
hrp, HRP
dat) = HRP -> HRP -> (HRP, HRP)
T.breakOnEnd HRP
"1" HRP
lowerBech32
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HRP -> Int
T.length HRP
dat Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6
    HRP
hrp' <- HRP -> HRP -> Maybe HRP
T.stripSuffix HRP
"1" HRP
hrp
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HRP -> Bool
checkHRP HRP
hrp'
    [Word5]
dat' <- (Char -> Maybe Word5) -> String -> Maybe [Word5]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Word5
charsetMap (String -> Maybe [Word5]) -> String -> Maybe [Word5]
forall a b. (a -> b) -> a -> b
$ HRP -> String
T.unpack HRP
dat
    Bech32Encoding
enc <- HRP -> [Word5] -> Maybe Bech32Encoding
bech32VerifyChecksum HRP
hrp' [Word5]
dat'
    (Bech32Encoding, HRP, [Word5])
-> Maybe (Bech32Encoding, HRP, [Word5])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bech32Encoding
enc, HRP
hrp', Int -> [Word5] -> [Word5]
forall a. Int -> [a] -> [a]
take (HRP -> Int
T.length HRP
dat Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6) [Word5]
dat')
  where
    lowerBech32 :: HRP
lowerBech32 = HRP -> HRP
T.toLower HRP
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 (m :: * -> *) a. Monad m => a -> m a
return [[Word]]
result
yesPadding Int
_ Int
_ Word
padValue [[Word]]
result = [[Word]] -> Identity [[Word]]
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 (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 :: [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 (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 (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 (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 (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 :: HRP -> HRP -> Maybe (Word8, [Word8])
segwitDecode HRP
hrp HRP
addr = do
    (Bech32Encoding
enc, HRP
hrp', [Word5]
dat) <- HRP -> Maybe (Bech32Encoding, HRP, [Word5])
bech32Decode HRP
addr
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (HRP
hrp HRP -> HRP -> Bool
forall a. Eq a => a -> a -> Bool
== HRP
hrp') Bool -> Bool -> Bool
&& Bool -> Bool
not ([Word5] -> 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 (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 :: HRP -> Word8 -> [Word8] -> Maybe HRP
segwitEncode HRP
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 -> HRP -> [Word5] -> Maybe HRP
bech32Encode Bech32Encoding
enc HRP
hrp ([Word5] -> Maybe HRP) -> [Word5] -> Maybe HRP
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