zcash-haskell/src/ZcashHaskell/Orchard.hs

117 lines
3.8 KiB
Haskell
Raw Normal View History

2024-03-04 17:59:07 +00:00
{-# LANGUAGE OverloadedStrings #-}
2024-01-18 18:55:23 +00:00
-- Copyright 2022-2024 Vergara Technologies LLC
--
-- This file is part of Zcash-Haskell.
--
2023-08-17 15:02:32 +00:00
-- |
-- Module : ZcashHaskell.Orchard
2023-12-20 20:03:42 +00:00
-- Copyright : 2022-2024 Vergara Technologies
2024-01-18 18:55:23 +00:00
-- License : MIT
2023-08-17 15:02:32 +00:00
--
-- Maintainer : rene@vergara.network
-- Stability : experimental
-- Portability : unknown
--
-- Functions to interact with the Orchard shielded pool of the Zcash blockchain.
--
2023-06-14 15:53:29 +00:00
module ZcashHaskell.Orchard where
import C.Zcash
( rustWrapperGenOrchardSpendKey
, rustWrapperOrchardCheck
, rustWrapperOrchardNoteDecode
2024-01-12 15:46:26 +00:00
, rustWrapperUADecode
, rustWrapperUfvkDecode
)
import qualified Data.ByteString as BS
2024-03-04 17:59:07 +00:00
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
2023-06-14 15:53:29 +00:00
import ZcashHaskell.Types
2024-03-04 17:59:07 +00:00
import ZcashHaskell.Utils (encodeBech32m, f4Jumble)
-- | Derives an Orchard spending key for the given seed and account ID
genOrchardSpendingKey :: Seed -> CoinType -> AccountId -> BS.ByteString
genOrchardSpendingKey s coinType accountId =
withPureBorshVarBuffer $
rustWrapperGenOrchardSpendKey s (getValue coinType) (fromIntegral accountId)
2023-08-17 15:02:32 +00:00
-- | Checks if given bytestring is a valid encoded unified address
2024-01-12 15:46:26 +00:00
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)
2024-03-04 17:59:07 +00:00
-- | 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
2023-08-17 15:02:32 +00:00
-- | 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
2023-08-17 15:02:32 +00:00
-- | Attempts to decode the given @OrchardAction@ using the given @UnifiedFullViewingKey@.
decryptOrchardAction ::
2023-09-26 20:24:18 +00:00
UnifiedFullViewingKey -> OrchardAction -> Maybe DecodedNote
decryptOrchardAction key encAction =
case a_value decodedAction of
0 -> Nothing
_ -> Just decodedAction
where
decodedAction =
withPureBorshVarBuffer $
rustWrapperOrchardNoteDecode (o_key key) encAction