{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Address.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)
type Bech32 = Text
type HRP = Text
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
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
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 #-}
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 #-}
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"
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)
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
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
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
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
maxBech32Length :: Int
maxBech32Length :: Int
maxBech32Length = 90
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
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
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 #-}
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 #-}
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
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
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
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)
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