{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Address.CashAddr (
CashPrefix,
CashVersion,
CashAddr,
Cash32,
cashAddrDecode,
cashAddrEncode,
cash32decodeType,
cash32encodeType,
cash32decode,
cash32encode,
) where
import Control.Monad
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.List
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Word
import Haskoin.Data
import Haskoin.Util
type CashPrefix = Text
type CashVersion = Word8
type CashAddr = Text
type Cash32 = Text
charset :: String
charset :: String
charset = String
"qpzry9x8gf2tvdw0s3jn54khce6mua7l"
base32char :: Char -> Maybe Word8
base32char :: Char -> Maybe Word8
base32char = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` String
charset)
cashAddrDecode :: Network -> CashAddr -> Maybe (CashVersion, ByteString)
cashAddrDecode :: Network -> Text -> Maybe (Word8, ByteString)
cashAddrDecode Network
net Text
ca = do
Text
epfx <- Network -> Maybe Text
getCashAddrPrefix Network
net
let (Text
cpfx, Text
cdat) = HasCallStack => Text -> Text -> (Text, Text)
T.breakOnEnd Text
":" (Text -> Text
T.toLower Text
ca)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Bool
T.null Text
cpfx Bool -> Bool -> Bool
|| HasCallStack => Text -> Text
T.init Text
cpfx forall a. Eq a => a -> a -> Bool
== Text
epfx)
(Text
dpfx, Word8
ver, ByteString
bs) <- Text -> Maybe (Text, Word8, ByteString)
cash32decodeType (Text
epfx forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
cdat)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
dpfx forall a. Eq a => a -> a -> Bool
== Text
epfx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ver, ByteString
bs)
cashAddrEncode :: Network -> CashVersion -> ByteString -> Maybe CashAddr
cashAddrEncode :: Network -> Word8 -> ByteString -> Maybe Text
cashAddrEncode Network
net Word8
cv ByteString
bs = do
Text
pfx <- Network -> Maybe Text
getCashAddrPrefix Network
net
Text -> Word8 -> ByteString -> Maybe Text
cash32encodeType Text
pfx Word8
cv ByteString
bs
cash32decodeType :: Cash32 -> Maybe (CashPrefix, CashVersion, ByteString)
cash32decodeType :: Text -> Maybe (Text, Word8, ByteString)
cash32decodeType Text
ca' = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Text
T.toUpper Text
ca' forall a. Eq a => a -> a -> Bool
== Text
ca' Bool -> Bool -> Bool
|| Text
ca forall a. Eq a => a -> a -> Bool
== Text
ca')
(Text
dpfx, ByteString
bs) <- Text -> Maybe (Text, ByteString)
cash32decode Text
ca
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs))
let vb :: Word8
vb = HasCallStack => ByteString -> Word8
B.head ByteString
bs
pay :: ByteString
pay = HasCallStack => ByteString -> ByteString
B.tail ByteString
bs
(Word8
ver, Int
len) <- Word8 -> Maybe (Word8, Int)
decodeVersionByte Word8
vb
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
pay forall a. Eq a => a -> a -> Bool
== Int
len)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
dpfx, Word8
ver, ByteString
pay)
where
ca :: Text
ca = Text -> Text
T.toLower Text
ca'
cash32encodeType :: CashPrefix -> CashVersion -> ByteString -> Maybe Cash32
cash32encodeType :: Text -> Word8 -> ByteString -> Maybe Text
cash32encodeType Text
pfx Word8
cv ByteString
bs = do
let len :: Int
len = ByteString -> Int
B.length ByteString
bs
Word8
vb <- Word8 -> Int -> Maybe Word8
encodeVersionByte Word8
cv Int
len
let pl :: ByteString
pl = Word8
vb Word8 -> ByteString -> ByteString
`B.cons` ByteString
bs
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ByteString -> Text
cash32encode Text
pfx ByteString
pl)
cash32decode :: Cash32 -> Maybe (CashPrefix, ByteString)
cash32decode :: Text -> Maybe (Text, ByteString)
cash32decode Text
text = do
let bs :: ByteString
bs = (Char -> Char) -> ByteString -> ByteString
C.map Char -> Char
toLower ByteString
bs'
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Char -> Char) -> ByteString -> ByteString
C.map Char -> Char
toUpper ByteString
bs' forall a. Eq a => a -> a -> Bool
== ByteString
bs' Bool -> Bool -> Bool
|| ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
bs')
let (ByteString
pfx', ByteString
dat) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C.breakEnd (forall a. Eq a => a -> a -> Bool
== Char
':') ByteString
bs
ByteString
pfx <-
if ByteString -> Bool
B.null ByteString
pfx' Bool -> Bool -> Bool
|| ByteString
pfx' forall a. Eq a => a -> a -> Bool
== Char -> ByteString
C.singleton Char
':'
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (HasCallStack => ByteString -> ByteString
B.init ByteString
pfx')
ByteString
b32 <- [Word8] -> ByteString
B.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Word8
base32char (ByteString -> String
C.unpack ByteString
dat)
let px :: ByteString
px = (Word8 -> Word8) -> ByteString -> ByteString
B.map (forall a. Bits a => a -> a -> a
.&. Word8
0x1f) ByteString
pfx
pd :: ByteString
pd = ByteString
px forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
0 forall a. Semigroup a => a -> a -> a
<> ByteString
b32
cs :: ByteString
cs = ByteString -> ByteString
cash32Polymod ByteString
pd
bb :: ByteString
bb = Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
b32 forall a. Num a => a -> a -> a
- Int
8) ByteString
b32
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
verifyCash32Polymod ByteString
cs)
let out :: ByteString
out = ByteString -> ByteString
toBase256 ByteString
bb
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Text
E.decodeUtf8 ByteString
pfx, ByteString
out)
where
bs' :: ByteString
bs' = Text -> ByteString
E.encodeUtf8 Text
text
cash32encode :: CashPrefix -> ByteString -> Cash32
cash32encode :: Text -> ByteString -> Text
cash32encode Text
pfx ByteString
bs =
let b32 :: ByteString
b32 = ByteString -> ByteString
toBase32 ByteString
bs
px :: ByteString
px = (Word8 -> Word8) -> ByteString -> ByteString
B.map (forall a. Bits a => a -> a -> a
.&. Word8
0x1f) (Text -> ByteString
E.encodeUtf8 Text
pfx)
pd :: ByteString
pd = ByteString
px forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
0 forall a. Semigroup a => a -> a -> a
<> ByteString
b32 forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
B.replicate Int
8 Word8
0
cs :: ByteString
cs = ByteString -> ByteString
cash32Polymod ByteString
pd
c32 :: ByteString
c32 = (Word8 -> Word8) -> ByteString -> ByteString
B.map Word8 -> Word8
f (ByteString
b32 forall a. Semigroup a => a -> a -> a
<> ByteString
cs)
f :: Word8 -> Word8
f = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
charset forall a. [a] -> Int -> a
!!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
in Text
pfx forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
E.decodeUtf8 ByteString
c32
toBase32 :: ByteString -> ByteString
toBase32 :: ByteString -> ByteString
toBase32 =
[Word8] -> ByteString
B.pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Int -> [Word] -> ([Word], Bool)
convertBits Bool
True Int
8 Int
5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
toBase256 :: ByteString -> ByteString
toBase256 :: ByteString -> ByteString
toBase256 =
[Word8] -> ByteString
B.pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Int -> [Word] -> ([Word], Bool)
convertBits Bool
False Int
5 Int
8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
decodeVersionByte :: Word8 -> Maybe (CashVersion, Int)
decodeVersionByte :: Word8 -> Maybe (Word8, Int)
decodeVersionByte Word8
vb = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
vb forall a. Bits a => a -> a -> a
.&. Word8
0x80 forall a. Eq a => a -> a -> Bool
== Word8
0)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ver, Int
len)
where
ver :: Word8
ver = Word8
vb forall a. Bits a => a -> Int -> a
`shiftR` Int
3
len :: Int
len = [Int]
ls forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
vb forall a. Bits a => a -> a -> a
.&. Word8
0x07)
ls :: [Int]
ls = [Int
20, Int
24, Int
28, Int
32, Int
40, Int
48, Int
56, Int
64]
encodeVersionByte :: CashVersion -> Int -> Maybe Word8
encodeVersionByte :: Word8 -> Int -> Maybe Word8
encodeVersionByte Word8
ver Int
len = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
ver forall a. Eq a => a -> a -> Bool
== Word8
ver forall a. Bits a => a -> a -> a
.&. Word8
0x0f)
Word8
l <- case Int
len of
Int
20 -> forall a. a -> Maybe a
Just Word8
0
Int
24 -> forall a. a -> Maybe a
Just Word8
1
Int
28 -> forall a. a -> Maybe a
Just Word8
2
Int
32 -> forall a. a -> Maybe a
Just Word8
3
Int
40 -> forall a. a -> Maybe a
Just Word8
4
Int
48 -> forall a. a -> Maybe a
Just Word8
5
Int
56 -> forall a. a -> Maybe a
Just Word8
6
Int
64 -> forall a. a -> Maybe a
Just Word8
7
Int
_ -> forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8
ver forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. Word8
l)
cash32Polymod :: ByteString -> ByteString
cash32Polymod :: ByteString -> ByteString
cash32Polymod ByteString
v =
[Word8] -> ByteString
B.pack
[forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
polymod forall a. Bits a => a -> Int -> a
`shiftR` (Int
5 forall a. Num a => a -> a -> a
* (Int
7 forall a. Num a => a -> a -> a
- Int
i))) forall a. Bits a => a -> a -> a
.&. Word8
0x1f | Int
i <- [Int
0 .. Int
7]]
where
polymod :: Word64
polymod = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' forall {p}. Integral p => Word64 -> p -> Word64
outer (Word64
1 :: Word64) ByteString
v forall a. Bits a => a -> a -> a
`xor` Word64
1
outer :: Word64 -> p -> Word64
outer Word64
c p
d =
let c0 :: Word8
c0 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
c forall a. Bits a => a -> Int -> a
`shiftR` Int
35) :: Word8)
c' :: Word64
c' = ((Word64
c forall a. Bits a => a -> a -> a
.&. Word64
0x07ffffffff) forall a. Bits a => a -> Int -> a
`shiftL` Int
5) forall a. Bits a => a -> a -> a
`xor` forall a b. (Integral a, Num b) => a -> b
fromIntegral p
d
in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall {a} {a}. (Bits a, Bits a) => a -> a -> (Int, a) -> a
inner Word8
c0) Word64
c' (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Word64]
generator)
generator :: [Word64]
generator =
[Word64
0x98f2bc8e61, Word64
0x79b76d99e2, Word64
0xf33e5fb3c4, Word64
0xae2eabe2a8, Word64
0x1e4f43e470]
inner :: a -> a -> (Int, a) -> a
inner a
c0 a
c (Int
b, a
g)
| a
c0 forall a. Bits a => a -> Int -> Bool
`testBit` Int
b = a
c forall a. Bits a => a -> a -> a
`xor` a
g
| Bool
otherwise = a
c
verifyCash32Polymod :: ByteString -> Bool
verifyCash32Polymod :: ByteString -> Bool
verifyCash32Polymod = (forall a. Eq a => a -> a -> Bool
== Int -> Word8 -> ByteString
B.replicate Int
8 Word8
0)