CashAddr.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- 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 (guard)
import Data.Bits
  ( Bits
      ( shiftL,
        shiftR,
        testBit,
        xor,
        (.&.),
        (.|.)
      ),
  )
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as C
import Data.Char (ord, toLower, toUpper)
import Data.List (elemIndex, foldl')
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Word (Word64, Word8)
import Haskoin.Network.Data (Network (cashAddrPrefix))
import Haskoin.Util.Helpers (convertBits)

-- | '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 <- net.cashAddrPrefix
  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 <- net.cashAddrPrefix
  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 (decodeUtf8 pfx, out)
  where
    bs' = 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) (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 <> ":" <> 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)