{-# 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
    , 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)

-- | 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 m :: Word8
m, UnsafeWord5 n :: 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 m :: Word8
m, UnsafeWord5 n :: Word8
n) (UnsafeWord5 i :: 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 (m :: Word5
m, n :: Word5
n) i :: 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 x :: 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
.&. 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 x :: 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 0, Word8 -> Word5
UnsafeWord5 31) "qpzry9x8gf2tvdw0s3jn54khce6mua7l"

-- | Convert a character to its five-bit value from 'Bech32' 'charset'.
charsetMap :: Char -> Maybe Word5
charsetMap :: Char -> Maybe Word5
charsetMap c :: 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 ('0', '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
a, b :: 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 values :: [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 1 [Word5]
values Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. 0x3fffffff
  where
    go :: b -> Word5 -> b
go chk :: b
chk value :: 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 | (g :: b
g, i :: Int
i) <- [b] -> [Int] -> [(b, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b]
generator [25 ..], b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
chk Int
i]
      where
        generator :: [b]
generator = [0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3]
        chk' :: b
chk' = b
chk b -> Int -> b
forall a. Bits a => a -> Int -> a
.<<. 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
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
.>>. 5)) [Word8]
hrpBytes [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++
    [Word8 -> Word5
UnsafeWord5 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

-- | Calculate checksum for a string of five-bit words.
bech32CreateChecksum :: HRP -> [Word5] -> [Word5]
bech32CreateChecksum :: HRP -> [Word5] -> [Word5]
bech32CreateChecksum hrp :: HRP
hrp dat :: [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 <- [25,20 .. 0]]
  where
    values :: [Word5]
values = HRP -> [Word5]
bech32HRPExpand HRP
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word5]
dat
    polymod :: Word
polymod =
        [Word5] -> Word
bech32Polymod ([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 [0, 0, 0, 0, 0, 0]) Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` 1

-- | Verify checksum for a human-readable part and string of five-bit words.
bech32VerifyChecksum :: HRP -> [Word5] -> Bool
bech32VerifyChecksum :: HRP -> [Word5] -> Bool
bech32VerifyChecksum hrp :: HRP
hrp dat :: [Word5]
dat = [Word5] -> Word
bech32Polymod (HRP -> [Word5]
bech32HRPExpand HRP
hrp [Word5] -> [Word5] -> [Word5]
forall a. [a] -> [a] -> [a]
++ [Word5]
dat) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 1

-- | Maximum length of a Bech32 result.
maxBech32Length :: Int
maxBech32Length :: Int
maxBech32Length = 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 :: HRP -> [Word5] -> Maybe Bech32
bech32Encode :: HRP -> [Word5] -> Maybe HRP
bech32Encode hrp :: HRP
hrp dat :: [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]
++ HRP -> [Word5] -> [Word5]
bech32CreateChecksum (HRP -> HRP
T.toLower HRP
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 :: HRP
result = [HRP] -> HRP
T.concat [HRP -> HRP
T.toLower HRP
hrp, [Char] -> HRP
T.pack "1", [Char] -> HRP
T.pack [Char]
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
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 -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x21' Bool -> Bool -> Bool
&& Char
char Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x7e') HRP
hrp

-- | Decode human-readable 'Bech32' string into a human-readable part and a
-- string of five-bit words.
bech32Decode :: Bech32 -> Maybe (HRP, [Word5])
bech32Decode :: HRP -> Maybe (HRP, [Word5])
bech32Decode bech32 :: 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
dat) = HRP -> HRP -> (HRP, HRP)
T.breakOnEnd "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
>= 6
    HRP
hrp' <- HRP -> HRP -> Maybe HRP
T.stripSuffix "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) -> [Char] -> Maybe [Word5]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Word5
charsetMap ([Char] -> Maybe [Word5]) -> [Char] -> Maybe [Word5]
forall a b. (a -> b) -> a -> b
$ HRP -> [Char]
T.unpack HRP
dat
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HRP -> [Word5] -> Bool
bech32VerifyChecksum HRP
hrp' [Word5]
dat'
    (HRP, [Word5]) -> Maybe (HRP, [Word5])
forall (m :: * -> *) a. Monad m => a -> m a
return (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
- 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 _ 0 _ result :: [[Word]]
result        = [[Word]] -> Identity [[Word]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Word]]
result
yesPadding _ _ padValue :: Word
padValue result :: [[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 frombits :: Int
frombits bits :: Int
bits padValue :: Word
padValue result :: [[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
== 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 dat :: [Word]
dat frombits :: Int
frombits tobits :: Int
tobits pad :: 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 0 0 []
  where
    go :: [a] -> Word -> Int -> [[Word]] -> f [[Word]]
go [] acc :: Word
acc bits :: Int
bits result :: [[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 (value :: a
value:dat' :: [a]
dat') acc :: Word
acc bits :: Int
bits result :: [[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
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tobits .. 0]
            ]
    maxv :: Word
maxv = (1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
.<<. Int
tobits) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1
{-# INLINE convertBits #-}

-- | Convert from eight-bit to five-bit word string, adding padding as required.
toBase32 :: [Word8] -> [Word5]
toBase32 :: [Word8] -> [Word5]
toBase32 dat :: [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) 8 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 dat :: [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) 5 8 Pad Maybe
noPadding

-- | Check if witness version and program are valid.
segwitCheck :: Word8 -> Data -> Bool
segwitCheck :: Word8 -> [Word8] -> Bool
segwitCheck witver :: Word8
witver witprog :: [Word8]
witprog =
    Word8
witver Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 16 Bool -> Bool -> Bool
&&
    if Word8
witver Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0
        then [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
witprog Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
== 32
        else [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
witprog Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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
<= 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 :: HRP
addr = do
    (hrp' :: HRP
hrp', dat :: [Word5]
dat) <- HRP -> Maybe (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 witver :: Word8
witver:datBase32 :: [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
$ Word8 -> [Word8] -> Bool
segwitCheck 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
hrp witver :: Word8
witver witprog :: [Word8]
witprog = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word8 -> [Word8] -> Bool
segwitCheck Word8
witver [Word8]
witprog
    HRP -> [Word5] -> Maybe HRP
bech32Encode 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