zcash-haskell/src/ZcashHaskell/Transparent.hs

-- Copyright 2022-2024 Vergara Technologies LLC
-- 
-- This file is part of Zcash-Haskell.
--
-- |
-- Module      :  ZcashHaskell.Transparent
-- Copyright   :  2022-2024 Vergara Technologies
-- License     :  MIT
--
-- Maintainer  :  pitmutt@vergara.tech
-- Stability   :  experimental
-- Portability :  unknown
--
-- Functions to interact with the transparent addresses in the Zcash blockchain
--
module ZcashHaskell.Transparent where

import Control.Exception (throwIO)
import Crypto.Hash
import Crypto.Secp256k1
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58)
import Data.HexString
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Word
import Haskoin.Address (Address(..))
import qualified Haskoin.Crypto.Hash as H
import Haskoin.Crypto.Keys.Extended
import ZcashHaskell.Types
  ( AccountId
  , CoinType(..)
  , Scope(..)
  , Seed(..)
  , ToBytes(..)
  , TransparentAddress(..)
  , TransparentType(..)
  , ZcashNet(..)
  , getTransparentPrefix
  , getValue
  )

encodeTransparent :: ZcashNet -> TransparentAddress -> T.Text
encodeTransparent zNet t =
  encodeTransparent' (getTransparentPrefix zNet (ta_type t)) $
  toBytes $ ta_bytes t
  where
    encodeTransparent' :: (Word8, Word8) -> BS.ByteString -> T.Text
    encodeTransparent' (a, b) h =
      E.decodeUtf8 $ encodeBase58 bitcoinAlphabet $ digest <> BS.take 4 checksum
      where
        sha256 :: BS.ByteString -> BS.ByteString
        sha256 bs = BA.convert (hash bs :: Digest SHA256)
        digest = BS.pack [a, b] <> h
        checksum = sha256 $ sha256 digest

-- | Generate an Extended Private Key from a known HDSeed.
genTransparentPrvKey :: Seed -> CoinType -> AccountId -> IO XPrvKey
genTransparentPrvKey hdseed ctype accid = do
  let coin = getValue ctype
  ioCtx <- createContext
  let path = Deriv :| 44 :| coin :| fromIntegral accid :: DerivPath
  let prvKey = makeXPrvKey $ getBytes hdseed
  return $ derivePath ioCtx path prvKey

genTransparentPubKey :: XPrvKey -> IO XPubKey
genTransparentPubKey xPrvKey = do
  ioCtx <- createContext
  return $ deriveXPubKey ioCtx xPrvKey

genTransparentPubAddress :: XPubKey -> IO Address
genTransparentPubAddress xPubKey = do
  ioCtx <- createContext
  return $ xPubAddr ioCtx xPubKey

-- | Generate a transparent receiver
genTransparentReceiver :: Int -> Scope -> XPrvKey -> IO TransparentAddress
genTransparentReceiver i scope xprvk = do
  ioCtx <- createContext
  let s =
        case scope of
          External -> 0
          Internal -> 1
  let path = Deriv :/ s :/ fromIntegral i :: DerivPath
  let childPrvKey = derivePath ioCtx path xprvk
  let childPubKey = deriveXPubKey ioCtx childPrvKey
  let x = xPubAddr ioCtx childPubKey
  case x of
    PubKeyAddress k -> return $ TransparentAddress P2PKH $ fromBinary k
    ScriptAddress j -> return $ TransparentAddress P2SH $ fromBinary j
    _anyOtherKind -> throwIO $ userError "Unsupported transparent address type"