100 lines
2.8 KiB
Haskell
100 lines
2.8 KiB
Haskell
-- Copyright 2022-2024 Vergara Technologies LLC
|
|
--
|
|
-- This file is part of Zcash-Haskell.
|
|
--
|
|
-- |
|
|
-- Module : ZcashHaskell.Sapling
|
|
-- Copyright : 2022-2024 Vergara Technologies
|
|
-- License : MIT
|
|
--
|
|
-- Maintainer : pitmutt@vergara.tech
|
|
-- Stability : experimental
|
|
-- Portability : unknown
|
|
--
|
|
-- Functions to interact with the Sapling shielded pool of the Zcash blockchain.
|
|
--
|
|
{-# 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(..)
|
|
, RawData(..)
|
|
, RawTxResponse(..)
|
|
, ShieldedOutput(..)
|
|
, decodeHexText
|
|
)
|
|
import ZcashHaskell.Utils (decodeBech32)
|
|
|
|
-- | 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 k =
|
|
case hrp decodedKey of
|
|
"zxviews" -> rustWrapperSaplingVkDecode $ bytes decodedKey
|
|
_ -> False
|
|
where
|
|
decodedKey = decodeBech32 k
|
|
|
|
-- | 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"
|
|
ht <- obj .: "height"
|
|
c <- obj .: "confirmations"
|
|
b <- obj .: "blocktime"
|
|
case o of
|
|
Nothing ->
|
|
pure $
|
|
RawTxResponse
|
|
i
|
|
(decodeHexText h)
|
|
(getShieldedOutputs (decodeHexText h))
|
|
[]
|
|
ht
|
|
c
|
|
b
|
|
Just o' -> do
|
|
a <- o' .: "actions"
|
|
pure $
|
|
RawTxResponse
|
|
i
|
|
(decodeHexText h)
|
|
(getShieldedOutputs (decodeHexText h))
|
|
a
|
|
ht
|
|
c
|
|
b
|