{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Haskoin.Address.CashAddr
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

Support for Bitcoin Cash (BCH) CashAddr format.
-}
module Haskoin.Address.CashAddr
    ( -- * 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.Constants
import           Haskoin.Util

-- | 'CashAddr' prefix, usually shown before the colon in addresses, but sometimes
-- omitted. It is used in the checksum calculation to avoid parsing an address
-- from the wrong network.
type CashPrefix = Text

-- | 'CashAddr' version, until new address schemes appear it will be zero.
type CashVersion = Word8

-- | High level 'CashAddr' human-reabale string, with explicit or implicit prefix.
type CashAddr = Text

-- | Low level 'Cash32' is the human-readable low-level encoding used by 'CashAddr'. It
-- need not encode a valid address but any binary data.
type Cash32 = Text

-- | Symbols for encoding 'Cash32' data in human-readable strings.
charset :: String
charset :: String
charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"

-- | Get the 32-bit number associated with this 'Cash32' character.
base32char :: Char -> Maybe Word8
base32char :: Char -> Maybe Word8
base32char = (Int -> Word8) -> Maybe Int -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Int -> Maybe Word8)
-> (Char -> Maybe Int) -> Char -> Maybe Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` String
charset)

-- | High-Level: decode 'CashAddr' string if it is valid for the
-- provided 'Network'. Prefix may be omitted from the string.
cashAddrDecode :: Network -> CashAddr -> Maybe (CashVersion, ByteString)
cashAddrDecode :: Network -> CashAddr -> Maybe (Word8, ByteString)
cashAddrDecode net :: Network
net ca :: CashAddr
ca = do
    CashAddr
epfx <- Network -> Maybe CashAddr
getCashAddrPrefix Network
net
    let (cpfx :: CashAddr
cpfx, cdat :: CashAddr
cdat) = CashAddr -> CashAddr -> (CashAddr, CashAddr)
T.breakOnEnd ":" (CashAddr -> CashAddr
T.toLower CashAddr
ca)
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CashAddr -> Bool
T.null CashAddr
cpfx Bool -> Bool -> Bool
|| CashAddr -> CashAddr
T.init CashAddr
cpfx CashAddr -> CashAddr -> Bool
forall a. Eq a => a -> a -> Bool
== CashAddr
epfx)
    (dpfx :: CashAddr
dpfx, ver :: Word8
ver, bs :: ByteString
bs) <- CashAddr -> Maybe (CashAddr, Word8, ByteString)
cash32decodeType (CashAddr
epfx CashAddr -> CashAddr -> CashAddr
forall a. Semigroup a => a -> a -> a
<> ":" CashAddr -> CashAddr -> CashAddr
forall a. Semigroup a => a -> a -> a
<> CashAddr
cdat)
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CashAddr
dpfx CashAddr -> CashAddr -> Bool
forall a. Eq a => a -> a -> Bool
== CashAddr
epfx)
    (Word8, ByteString) -> Maybe (Word8, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ver, ByteString
bs)

-- | High-Level: encode 'CashAddr' string for the provided network and hash.
-- Fails if the 'CashVersion' or length of hash 'ByteString' is invalid.
cashAddrEncode :: Network -> CashVersion -> ByteString -> Maybe CashAddr
cashAddrEncode :: Network -> Word8 -> ByteString -> Maybe CashAddr
cashAddrEncode net :: Network
net cv :: Word8
cv bs :: ByteString
bs = do
    CashAddr
pfx <- Network -> Maybe CashAddr
getCashAddrPrefix Network
net
    CashAddr -> Word8 -> ByteString -> Maybe CashAddr
cash32encodeType CashAddr
pfx Word8
cv ByteString
bs

-- | Mid-Level: decode 'CashAddr' string containing arbitrary prefix, plus a
-- version byte before the 'ByteString' that encodes type and length.
cash32decodeType :: Cash32 -> Maybe (CashPrefix, CashVersion, ByteString)
cash32decodeType :: CashAddr -> Maybe (CashAddr, Word8, ByteString)
cash32decodeType ca' :: CashAddr
ca' = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CashAddr -> CashAddr
T.toUpper CashAddr
ca' CashAddr -> CashAddr -> Bool
forall a. Eq a => a -> a -> Bool
== CashAddr
ca' Bool -> Bool -> Bool
|| CashAddr
ca CashAddr -> CashAddr -> Bool
forall a. Eq a => a -> a -> Bool
== CashAddr
ca')
    (dpfx :: CashAddr
dpfx, bs :: ByteString
bs) <- CashAddr -> Maybe (CashAddr, ByteString)
cash32decode CashAddr
ca
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs))
    let vb :: Word8
vb = ByteString -> Word8
B.head ByteString
bs
        pay :: ByteString
pay = ByteString -> ByteString
B.tail ByteString
bs
    (ver :: Word8
ver, len :: Int
len) <- Word8 -> Maybe (Word8, Int)
decodeVersionByte Word8
vb
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
pay Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len)
    (CashAddr, Word8, ByteString)
-> Maybe (CashAddr, Word8, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (CashAddr
dpfx, Word8
ver, ByteString
pay)
  where
    ca :: CashAddr
ca = CashAddr -> CashAddr
T.toLower CashAddr
ca'

-- | Mid-Level: encode 'CashAddr' string containing arbitrary prefix and
-- 'CashVersion'. Length must be among those allowed by the standard.
cash32encodeType :: CashPrefix -> CashVersion -> ByteString -> Maybe Cash32
cash32encodeType :: CashAddr -> Word8 -> ByteString -> Maybe CashAddr
cash32encodeType pfx :: CashAddr
pfx cv :: Word8
cv bs :: 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
    CashAddr -> Maybe CashAddr
forall (m :: * -> *) a. Monad m => a -> m a
return (CashAddr -> ByteString -> CashAddr
cash32encode CashAddr
pfx ByteString
pl)

-- | Low-Level: decode 'Cash32' string. 'CashPrefix' must be part of the string.
-- No version or hash length validation is performed.
cash32decode :: Cash32 -> Maybe (CashPrefix, ByteString)
cash32decode :: CashAddr -> Maybe (CashAddr, ByteString)
cash32decode text :: CashAddr
text = do
    let bs :: ByteString
bs = (Char -> Char) -> ByteString -> ByteString
C.map Char -> Char
toLower ByteString
bs'
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Char -> Char) -> ByteString -> ByteString
C.map Char -> Char
toUpper ByteString
bs' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs' Bool -> Bool -> Bool
|| ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs')
    let (pfx' :: ByteString
pfx', dat :: ByteString
dat) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C.breakEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':') ByteString
bs
    ByteString
pfx <-
        if ByteString -> Bool
B.null ByteString
pfx' Bool -> Bool -> Bool
|| ByteString
pfx' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> ByteString
C.singleton ':'
            then Maybe ByteString
forall a. Maybe a
Nothing
            else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
B.init ByteString
pfx')
    ByteString
b32 <- [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> Maybe [Word8] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Maybe Word8) -> String -> Maybe [Word8]
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 (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f) ByteString
pfx
        pd :: ByteString
pd = ByteString
px ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton 0 ByteString -> ByteString -> ByteString
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 8) ByteString
b32
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
verifyCash32Polymod ByteString
cs)
    let out :: ByteString
out = ByteString -> ByteString
toBase256 ByteString
bb
    (CashAddr, ByteString) -> Maybe (CashAddr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> CashAddr
E.decodeUtf8 ByteString
pfx, ByteString
out)
  where
    bs' :: ByteString
bs' = CashAddr -> ByteString
E.encodeUtf8 CashAddr
text

-- | Low-Level: encode 'Cash32' string for 'CashPrefix' provided. Can encode
-- arbitrary data. No prefix or length validation is performed.
cash32encode :: CashPrefix -> ByteString -> Cash32
cash32encode :: CashAddr -> ByteString -> CashAddr
cash32encode pfx :: CashAddr
pfx bs :: ByteString
bs =
    let b32 :: ByteString
b32 = ByteString -> ByteString
toBase32 ByteString
bs
        px :: ByteString
px = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f) (CashAddr -> ByteString
E.encodeUtf8 CashAddr
pfx)
        pd :: ByteString
pd = ByteString
px ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton 0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b32 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
B.replicate 8 0
        cs :: ByteString
cs = ByteString -> ByteString
cash32Polymod ByteString
pd
        c32 :: ByteString
c32 = (Word8 -> Word8) -> ByteString -> ByteString
B.map Word8 -> Word8
f (ByteString
b32 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cs)
        f :: Word8 -> Word8
f = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Word8 -> Int) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Int) -> (Word8 -> Char) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
charset String -> Int -> Char
forall a. [a] -> Int -> a
!!) (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    in CashAddr
pfx CashAddr -> CashAddr -> CashAddr
forall a. Semigroup a => a -> a -> a
<> ":" CashAddr -> CashAddr -> CashAddr
forall a. Semigroup a => a -> a -> a
<> ByteString -> CashAddr
E.decodeUtf8 ByteString
c32

-- | Convert base of 'ByteString' from eight bits per byte to five bits per
-- byte, adding padding as necessary.
toBase32 :: ByteString -> ByteString
toBase32 :: ByteString -> ByteString
toBase32 =
    [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (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])
-> (ByteString -> [Word]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word], Bool) -> [Word]
forall a b. (a, b) -> a
fst (([Word], Bool) -> [Word])
-> (ByteString -> ([Word], Bool)) -> ByteString -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Int -> [Word] -> ([Word], Bool)
convertBits Bool
True 8 5 ([Word] -> ([Word], Bool))
-> (ByteString -> [Word]) -> ByteString -> ([Word], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> [Word])
-> (ByteString -> [Word8]) -> ByteString -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

-- | Convert base of 'ByteString' from five to eight bits per byte. Ignore
-- padding to be symmetric with respect to 'toBase32' function.
toBase256 :: ByteString -> ByteString
toBase256 :: ByteString -> ByteString
toBase256 =
    [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (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])
-> (ByteString -> [Word]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word], Bool) -> [Word]
forall a b. (a, b) -> a
fst (([Word], Bool) -> [Word])
-> (ByteString -> ([Word], Bool)) -> ByteString -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Int -> [Word] -> ([Word], Bool)
convertBits Bool
False 5 8 ([Word] -> ([Word], Bool))
-> (ByteString -> [Word]) -> ByteString -> ([Word], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> [Word])
-> (ByteString -> [Word8]) -> ByteString -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

-- | Obtain 'CashVersion' and payload length from 'CashAddr' version byte.
decodeVersionByte :: Word8 -> Maybe (CashVersion, Int)
decodeVersionByte :: Word8 -> Maybe (Word8, Int)
decodeVersionByte vb :: Word8
vb = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
vb Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
    (Word8, Int) -> Maybe (Word8, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ver, Int
len)
  where
    ver :: Word8
ver = Word8
vb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 3
    len :: Int
len = [Int]
ls [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
vb Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x07)
    ls :: [Int]
ls = [20, 24, 28, 32, 40, 48, 56, 64]

-- | Encode 'CashVersion' and length into version byte. Fail if version is
-- larger than five bits, or length incorrect, since that is invalid.
encodeVersionByte :: CashVersion -> Int -> Maybe Word8
encodeVersionByte :: Word8 -> Int -> Maybe Word8
encodeVersionByte ver :: Word8
ver len :: Int
len = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
ver Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
ver Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x0f)
    Word8
l <- case Int
len of
        20 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 0
        24 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 1
        28 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 2
        32 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 3
        40 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 4
        48 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 5
        56 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 6
        64 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 7
        _  -> Maybe Word8
forall a. Maybe a
Nothing
    Word8 -> Maybe Word8
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8
ver Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
l)

-- | Calculate or validate checksum from base32 'ByteString' (excluding prefix).
cash32Polymod :: ByteString -> ByteString
cash32Polymod :: ByteString -> ByteString
cash32Polymod v :: ByteString
v =
    [Word8] -> ByteString
B.pack
        [Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
polymod Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` (5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f | Int
i <- [0 .. 7]]
  where
    polymod :: Word64
polymod = (Word64 -> Word8 -> Word64) -> Word64 -> ByteString -> Word64
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Word64 -> Word8 -> Word64
forall a. Integral a => Word64 -> a -> Word64
outer (1 :: Word64) ByteString
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` 1
    outer :: Word64 -> a -> Word64
outer c :: Word64
c d :: a
d =
        let c0 :: Word8
c0 = (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
c Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 35) :: Word8)
            c' :: Word64
c' = ((Word64
c Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0x07ffffffff) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 5) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d
        in (Word64 -> (Int, Word64) -> Word64)
-> Word64 -> [(Int, Word64)] -> Word64
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word8 -> Word64 -> (Int, Word64) -> Word64
forall a p. (Bits a, Bits p) => a -> p -> (Int, p) -> p
inner Word8
c0) Word64
c' ([Int] -> [Word64] -> [(Int, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 ..] [Word64]
generator)
    generator :: [Word64]
generator =
        [0x98f2bc8e61, 0x79b76d99e2, 0xf33e5fb3c4, 0xae2eabe2a8, 0x1e4f43e470]
    inner :: a -> p -> (Int, p) -> p
inner c0 :: a
c0 c :: p
c (b :: Int
b, g :: p
g)
        | a
c0 a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
b = p
c p -> p -> p
forall a. Bits a => a -> a -> a
`xor` p
g
        | Bool
otherwise = p
c

-- | Validate that polymod 'ByteString' (eight bytes) is equal to zero.
verifyCash32Polymod :: ByteString -> Bool
verifyCash32Polymod :: ByteString -> Bool
verifyCash32Polymod = (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8 -> ByteString
B.replicate 8 0)