zcash-haskell/src/ZcashHaskell/Orchard.hs

125 lines
3.9 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
-- Copyright 2022-2024 Vergara Technologies LLC
--
-- This file is part of Zcash-Haskell.
--
-- |
-- Module : ZcashHaskell.Orchard
-- Copyright : 2022-2024 Vergara Technologies
-- License : MIT
--
-- Maintainer : rene@vergara.network
-- Stability : experimental
-- Portability : unknown
--
-- Functions to interact with the Orchard shielded pool of the Zcash blockchain.
--
module ZcashHaskell.Orchard where
import C.Zcash
( rustWrapperGenOrchardSpendKey
, rustWrapperOrchardCheck
, rustWrapperOrchardNoteDecode
, rustWrapperUADecode
, rustWrapperUfvkDecode
)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Word
import Foreign.Rust.Marshall.Variable
import ZcashHaskell.Types
import ZcashHaskell.Utils (encodeBech32m, f4Jumble)
-- | Derives an Orchard spending key for the given seed and account ID
genOrchardSpendingKey :: Seed -> CoinType -> AccountId -> Maybe BS.ByteString
genOrchardSpendingKey s coinType accountId =
if BS.length k /= 32
then Nothing
else Just k
where
k =
withPureBorshVarBuffer $
rustWrapperGenOrchardSpendKey
s
(getValue coinType)
(fromIntegral accountId)
-- | Checks if given bytestring is a valid encoded unified address
isValidUnifiedAddress :: BS.ByteString -> Maybe UnifiedAddress
isValidUnifiedAddress str =
case raw_net decodedAddress of
0 -> Nothing
_ -> Just $ makeUA decodedAddress
where
decodedAddress = (withPureBorshVarBuffer . rustWrapperUADecode) str
whichNet =
case raw_net decodedAddress of
1 -> MainNet
2 -> TestNet
3 -> RegTestNet
makeUA x =
UnifiedAddress
whichNet
(raw_o x)
(raw_s x)
(if not (BS.null (raw_t x))
then Just $ TransparentAddress P2PKH whichNet (raw_t x)
else if not (BS.null (raw_to x))
then Just $ TransparentAddress P2SH whichNet (raw_to x)
else Nothing)
-- | Encode a 'UnifiedAddress' per [ZIP-316](https://zips.z.cash/zip-0316)
encodeUnifiedAddress :: UnifiedAddress -> T.Text
encodeUnifiedAddress ua = encodeBech32m (E.encodeUtf8 hr) b
where
hr =
case ua_net ua of
MainNet -> "u"
TestNet -> "utest"
b = f4Jumble $ tReceiver <> sReceiver <> oReceiver <> padding
tReceiver =
case t_rec ua of
Nothing -> BS.empty
Just t ->
case ta_type t of
P2SH -> packReceiver 0x01 $ ta_bytes t
P2PKH -> packReceiver 0x00 $ ta_bytes t
sReceiver = packReceiver 0x02 $ s_rec ua
oReceiver = packReceiver 0x03 $ o_rec ua
padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr
packReceiver :: Word8 -> BS.ByteString -> BS.ByteString
packReceiver typeCode receiver =
if BS.length receiver > 1
then BS.singleton typeCode `BS.append`
(BS.singleton . toEnum . BS.length) receiver `BS.append`
receiver
else BS.empty
-- | Attempts to decode the given bytestring into a Unified Full Viewing Key
decodeUfvk :: BS.ByteString -> Maybe UnifiedFullViewingKey
decodeUfvk str =
case net decodedKey of
0 -> Nothing
_ -> Just decodedKey
where
decodedKey = (withPureBorshVarBuffer . rustWrapperUfvkDecode) str
-- | Check if the given UVK matches the UA given
matchOrchardAddress :: BS.ByteString -> BS.ByteString -> Bool
matchOrchardAddress = rustWrapperOrchardCheck
-- | Attempts to decode the given @OrchardAction@ using the given @UnifiedFullViewingKey@.
decryptOrchardAction ::
UnifiedFullViewingKey -> OrchardAction -> Maybe DecodedNote
decryptOrchardAction key encAction =
case a_value decodedAction of
0 -> Nothing
_ -> Just decodedAction
where
decodedAction =
withPureBorshVarBuffer $
rustWrapperOrchardNoteDecode (o_key key) encAction