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