{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Network.Haskoin.Address.CashAddr
Copyright   : No rights reserved
License     : UNLICENSE
Maintainer  : xenog@protonmail.com
Stability   : experimental
Portability : POSIX

Support for Bitcoin Cash (BCH) CashAddr format.
-}
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

-- | '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 = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"

-- | Get the 32-bit number associated with this 'Cash32' character.
base32char :: Char -> Maybe Word8
base32char = fmap fromIntegral . (`elemIndex` 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 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)

-- | 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 net cv bs = do
    pfx <- getCashAddrPrefix net
    cash32encodeType pfx cv 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 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'

-- | 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 pfx cv bs = do
    let len = B.length bs
    vb <- encodeVersionByte cv len
    let pl = vb `B.cons` bs
    return (cash32encode pfx 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 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

-- | Low-Level: encode 'Cash32' string for 'CashPrefix' provided. Can encode
-- arbitrary data. No prefix or length validation is performed.
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

-- | Convert base of 'ByteString' from eight bits per byte to five bits per
-- byte, adding padding as necessary.
toBase32 :: ByteString -> ByteString
toBase32 =
    B.pack .
    map fromIntegral . fst . convertBits True 8 5 . map fromIntegral . 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 =
    B.pack .
    map fromIntegral . fst . convertBits False 5 8 . map fromIntegral . B.unpack

-- | Obtain 'CashVersion' and payload length from 'CashAddr' version byte.
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]

-- | 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 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)

-- | Calculate or validate checksum from base32 'ByteString' (excluding prefix).
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

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