zcash-haskell/src/ZcashHaskell/Sapling.hs

{-# LANGUAGE OverloadedStrings #-}

module ZcashHaskell.Sapling where

import C.Zcash
  ( rustWrapperIsShielded
  , rustWrapperSaplingCheck
  , rustWrapperSaplingNoteDecode
  , rustWrapperSaplingVkDecode
  , rustWrapperTxParse
  )
import Data.Aeson
import qualified Data.ByteString as BS
import Foreign.Rust.Marshall.Variable (withPureBorshVarBuffer)
import ZcashHaskell.Types
  ( DecodedNote(..)
  , RawTxResponse(..)
  , ShieldedOutput(..)
  , decodeHexText
  )

-- | Check if given bytesting is a valid encoded shielded address
isValidShieldedAddress :: BS.ByteString -> Bool
isValidShieldedAddress = rustWrapperIsShielded

getShieldedOutputs :: BS.ByteString -> [BS.ByteString]
getShieldedOutputs t = withPureBorshVarBuffer $ rustWrapperTxParse t

-- | Check if given bytestring is a valid Sapling viewing key
isValidSaplingViewingKey :: BS.ByteString -> Bool
isValidSaplingViewingKey = rustWrapperSaplingVkDecode

-- | Check if the given bytestring for the Sapling viewing key matches the second bytestring for the address
matchSaplingAddress :: BS.ByteString -> BS.ByteString -> Bool
matchSaplingAddress = rustWrapperSaplingCheck

-- | Attempt to decode the given raw tx with the given Sapling viewing key
decodeSaplingOutput :: BS.ByteString -> BS.ByteString -> Maybe DecodedNote
decodeSaplingOutput key out =
  case a_value decodedAction of
    0 -> Nothing
    _ -> Just decodedAction
  where
    decodedAction =
      withPureBorshVarBuffer $ rustWrapperSaplingNoteDecode key out

instance FromJSON RawTxResponse where
  parseJSON =
    withObject "RawTxResponse" $ \obj -> do
      i <- obj .: "txid"
      o <- obj .: "orchard"
      h <- obj .: "hex"
      a <- o .: "actions"
      pure $
        RawTxResponse
          i
          (decodeHexText h)
          (getShieldedOutputs (decodeHexText h))
          a