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 qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import ZcashHaskell.Types
  ( AccountId
  , Seed(..)
  , ToBytes(..)
  , TransparentAddress(..)
  , TransparentType(..)
  , ZcashNet(..)
  , getTransparentPrefix
  )

import Crypto.Secp256k1
import Data.HexString
import Data.Word
import Haskoin.Address (Address(..))
import qualified Haskoin.Crypto.Hash as H
import Haskoin.Crypto.Keys.Extended

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

-- | Attempts to generate an Extended Private Key from a known HDSeed.
genTransparentPrvKey :: Seed -> AccountId -> IO XPrvKey
genTransparentPrvKey hdseed i = do
  let prvKey = makeXPrvKey $ getBytes hdseed
  ioCtx <- createContext
  return $ hardSubKey ioCtx prvKey (fromIntegral i)

-- | Generate a transparent receiver
genTransparentReceiver :: Int -> XPrvKey -> IO TransparentAddress
genTransparentReceiver i xprvk = do
  ioCtx <- createContext
  let rootPubKey = deriveXPubKey ioCtx xprvk
  let childPubKey = pubSubKey ioCtx rootPubKey (fromIntegral i)
  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"