145 lines
4.5 KiB
Haskell
145 lines
4.5 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
|
|
( rustWrapperGenOrchardReceiver
|
|
, 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 OrchardSpendingKey
|
|
genOrchardSpendingKey s coinType accountId =
|
|
if BS.length k /= 32
|
|
then Nothing
|
|
else Just k
|
|
where
|
|
k =
|
|
withPureBorshVarBuffer $
|
|
rustWrapperGenOrchardSpendKey
|
|
s
|
|
(getValue coinType)
|
|
(fromIntegral accountId)
|
|
|
|
-- | Derives an Orchard receiver for the given spending key and index
|
|
genOrchardReceiver :: Int -> OrchardSpendingKey -> Maybe OrchardReceiver
|
|
genOrchardReceiver i osk =
|
|
if BS.length k /= 43
|
|
then Nothing
|
|
else Just k
|
|
where
|
|
k =
|
|
withPureBorshVarBuffer $
|
|
rustWrapperGenOrchardReceiver osk (fromIntegral i)
|
|
|
|
-- | 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
|
|
(if BS.length (raw_o x) == 43
|
|
then Just (raw_o x)
|
|
else Nothing)
|
|
(if BS.length (raw_s x) == 43
|
|
then Just (raw_s x)
|
|
else Nothing)
|
|
(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 -> uniPaymentAddressHrp
|
|
TestNet -> uniTestPaymentAddressHrp
|
|
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 $ Just $ ta_bytes t
|
|
P2PKH -> packReceiver 0x00 $ Just $ 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 -> Maybe BS.ByteString -> BS.ByteString
|
|
packReceiver typeCode receiver' =
|
|
case receiver' of
|
|
Just receiver ->
|
|
if BS.length receiver > 1
|
|
then BS.singleton typeCode `BS.append`
|
|
(BS.singleton . toEnum . BS.length) receiver `BS.append`
|
|
receiver
|
|
else BS.empty
|
|
Nothing -> 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
|