Implement address comparison and validation #87
2 changed files with 43 additions and 11 deletions
|
@ -37,6 +37,11 @@ import qualified Data.Text as T
|
|||
import qualified Data.Text.Encoding as E
|
||||
import Data.Word
|
||||
import Foreign.Rust.Marshall.Variable
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (encodeBech32, encodeBech32m, f4Jumble)
|
||||
|
||||
|
@ -221,8 +226,33 @@ getOrchardNotePosition :: OrchardWitness -> Integer
|
|||
getOrchardNotePosition =
|
||||
fromIntegral . rustWrapperReadOrchardPosition . hexBytes . orchWit
|
||||
|
||||
-- | Update the witness of an Orchard note
|
||||
updateOrchardWitness :: OrchardWitness -> [HexString] -> OrchardWitness
|
||||
updateOrchardWitness wit cmus =
|
||||
OrchardWitness $
|
||||
withPureBorshVarBuffer $
|
||||
rustWrapperUpdateOrchardWitness (toBytes $ orchWit wit) (map toBytes cmus)
|
||||
|
||||
-- | Parse a potential Zcash address
|
||||
parseAddress :: BS.ByteString -> Maybe ValidAddress
|
||||
parseAddress t =
|
||||
case isValidUnifiedAddress t of
|
||||
Nothing ->
|
||||
case decodeSaplingAddress t of
|
||||
Nothing ->
|
||||
case decodeTransparentAddress t of
|
||||
Nothing ->
|
||||
case decodeExchangeAddress t of
|
||||
Nothing -> Nothing
|
||||
Just x -> Just $ Exchange x
|
||||
Just t -> Just $ Transparent t
|
||||
Just s -> Just $ Sapling s
|
||||
Just u -> Just $ Unified u
|
||||
|
||||
compareAddress :: ValidAddress -> UnifiedAddress -> Bool
|
||||
compareAddress a u =
|
||||
case a of
|
||||
Unified i -> i == u
|
||||
Sapling s -> s_rec u == Just (sa_receiver s) && ua_net u == net_type s
|
||||
Transparent t -> t_rec u == Just (ta_receiver t) && ua_net u == ta_network t
|
||||
Exchange x -> False
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- Copyright 2022-2024 Vergara Technologies LLC
|
||||
--
|
||||
-- This file is part of Zcash-Haskell.
|
||||
|
@ -172,27 +174,27 @@ decodeTransparentAddress taddress = do
|
|||
-- | Encode an Exchange Addresss into HRF from TransparentReceiver
|
||||
encodeExchangeAddress :: ZcashNet -> TransparentReceiver -> Maybe T.Text
|
||||
encodeExchangeAddress net tr = do
|
||||
case (tr_type tr) of
|
||||
case tr_type tr of
|
||||
P2PKH -> do
|
||||
case net of
|
||||
MainNet -> do
|
||||
let vhash = encodeBech32m (BC.pack "tex") (toBytes (tr_bytes tr))
|
||||
let vhash = encodeBech32m "tex" (toBytes (tr_bytes tr))
|
||||
Just vhash
|
||||
TestNet -> do
|
||||
let vhash = encodeBech32m (BC.pack "textest") (toBytes (tr_bytes tr))
|
||||
let vhash = encodeBech32m "textest" (toBytes (tr_bytes tr))
|
||||
Just vhash
|
||||
_ -> Nothing
|
||||
_any -> Nothing
|
||||
|
||||
-- | Decode an Exchange Address into a ExchangeAddress
|
||||
decodeExchangeAddress :: T.Text -> Maybe ExchangeAddress
|
||||
decodeExchangeAddress :: BS.ByteString -> Maybe ExchangeAddress
|
||||
decodeExchangeAddress ex = do
|
||||
if (T.length ex) > 1
|
||||
if BS.length ex > 1
|
||||
then do
|
||||
let rawd = decodeBech32 (E.encodeUtf8 ex)
|
||||
let tMain = BS.unpack (BC.pack "tex")
|
||||
let tTest = BS.unpack (BC.pack "textest")
|
||||
let tFail = BS.unpack (BC.pack "fail")
|
||||
let hr = BS.unpack (hrp rawd)
|
||||
let rawd = decodeBech32 ex
|
||||
let tMain = "tex"
|
||||
let tTest = "textest"
|
||||
let tFail = "fail"
|
||||
let hr = hrp rawd
|
||||
if hr /= tFail
|
||||
then do
|
||||
let transparentReceiver = bytes rawd
|
||||
|
|
Loading…
Reference in a new issue