122 lines
3.6 KiB
Haskell
122 lines
3.6 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
|
|
, rustWrapperSaplingPaymentAddress
|
|
, rustWrapperSaplingSpendingkey
|
|
, rustWrapperSaplingVkDecode
|
|
, rustWrapperTxParse
|
|
)
|
|
import Data.Aeson
|
|
import qualified Data.ByteString as BS
|
|
import Data.HexString (HexString(..), toBytes)
|
|
import Data.Word
|
|
import Foreign.Rust.Marshall.Variable
|
|
( withPureBorshVarBuffer
|
|
, withPureBorshVarBuffer
|
|
)
|
|
import ZcashHaskell.Types
|
|
( AccountId
|
|
, CoinType
|
|
, DecodedNote(..)
|
|
, RawData(..)
|
|
, RawTxResponse(..)
|
|
, SaplingInternalReceiver
|
|
, SaplingReceiver
|
|
, SaplingSpendingKey(..)
|
|
, Seed(..)
|
|
, ShieldedOutput(..)
|
|
, decodeHexText
|
|
)
|
|
import ZcashHaskell.Utils (decodeBech32)
|
|
|
|
-- | Check if given bytesting is a valid encoded shielded address
|
|
isValidShieldedAddress :: BS.ByteString -> Bool
|
|
isValidShieldedAddress = rustWrapperIsShielded
|
|
|
|
getShieldedOutputs :: HexString -> [BS.ByteString]
|
|
getShieldedOutputs t = withPureBorshVarBuffer $ rustWrapperTxParse $ toBytes 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 h (getShieldedOutputs h) [] ht c b
|
|
Just o' -> do
|
|
a <- o' .: "actions"
|
|
pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b
|
|
|
|
-- | Attempts to obtain a sapling SpendingKey using a HDSeed
|
|
genSaplingSpendingKey :: Seed -> Int -> Maybe SaplingSpendingKey
|
|
genSaplingSpendingKey seed i = do
|
|
if BS.length res == 169
|
|
then Just res
|
|
else Nothing
|
|
where
|
|
res =
|
|
withPureBorshVarBuffer
|
|
(rustWrapperSaplingSpendingkey seed (fromIntegral i))
|
|
|
|
-- | Attempts to generate a sapling Payment Address using an ExtendedSpendingKey and a Diversifier Index
|
|
genSaplingPaymentAddress :: Int -> SaplingSpendingKey -> Maybe SaplingReceiver
|
|
genSaplingPaymentAddress i extspk =
|
|
if BS.length res == 43
|
|
then Just res
|
|
else Nothing
|
|
where
|
|
res =
|
|
withPureBorshVarBuffer
|
|
(rustWrapperSaplingPaymentAddress extspk (fromIntegral (i * 111)))
|
|
|
|
-- | Generate an internal Sapling address
|
|
genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingInternalReceiver
|
|
genSaplingInternalAddress sk = undefined
|