Compare commits

...

22 commits

Author SHA1 Message Date
f099544162
Account for missing response fields in Zebra response (#43)
This PR adds code to account for the missing `time` field in the Zebra response for blocks and raw transactions.

Reviewed-on: #43
Co-authored-by: pitmutt <rene@vergara.network>
Co-committed-by: pitmutt <rene@vergara.network>
2024-03-22 18:04:04 +00:00
aa10e09595
Implement Sapling spends (#42)
This PR add support for Sapling spends in the communication with Zebra.

Reviewed-on: #42
Co-authored-by: Rene Vergara <rene@vergara.network>
Co-committed-by: Rene Vergara <rene@vergara.network>
2024-03-21 20:15:49 +00:00
d7752e9866
Improve response handling for Zebra RPC (#41)
This PR includes changes to handle differences between the `zebrad` and `zcashd` RPC.

Reviewed-on: #41
Co-authored-by: Rene Vergara <rene@vergara.network>
Co-committed-by: Rene Vergara <rene@vergara.network>
2024-03-21 18:26:13 +00:00
3af235377b
Adapt response handling to Zebra (#40)
This PR allows for the Zebra behavior of not having a `result` field in the RPC response on error conditions.

Reviewed-on: #40
Co-authored-by: Rene Vergara <rene@vergara.network>
Co-committed-by: Rene Vergara <rene@vergara.network>
2024-03-20 19:33:36 +00:00
1af152dc31
Upgrade Zebra call (#39)
Reviewed-on: #39
Co-authored-by: Rene Vergara <rene@vergara.network>
Co-committed-by: Rene Vergara <rene@vergara.network>
2024-03-20 16:15:30 +00:00
f228eff367
Merge pull request 'Improve dependency on Haskoin for downstream' (#38) from rav001 into dev040
Reviewed-on: #38
2024-03-15 17:30:15 +00:00
5a6f31573c
Merge branch 'dev040' into rav001 2024-03-15 17:29:59 +00:00
bc1ee2430a
Improve dependency on Haskoin for downstream 2024-03-15 12:26:28 -05:00
6e86f2caf0
Merge pull request 'Complete Unified Address generation' (#37) from rav001 into dev040
Reviewed-on: #37
2024-03-15 16:31:50 +00:00
d1b0436af2
Add documentation for new functions 2024-03-15 10:26:06 -05:00
d5c50d58c5
Merge branch 'rvv040' into rav001 2024-03-15 10:11:27 -05:00
c7c4d664dc
Remove duplicate import 2024-03-15 08:15:08 -05:00
5b08026102
Merge pull request 'Add Read instance to Phrase' (#36) from rav001 into dev040
Reviewed-on: #36
2024-03-14 18:14:37 +00:00
c93809489b
Add Read instance to Phrase 2024-03-14 13:12:18 -05:00
749472e515
Merge pull request 'Fix #34' (#35) from rav001 into dev040
Reviewed-on: #35
2024-03-14 18:04:47 +00:00
d0ba74c7a1
Fix #34 2024-03-14 13:02:02 -05:00
4963eea68b
Merge pull request 'Type safety improvements' (#33) from rav001 into dev040
Reviewed-on: #33
2024-03-14 17:42:17 +00:00
46a28128fd
Bump version 2024-03-14 12:39:31 -05:00
4cc4c37960
Improve type safety for Orchard 2024-03-14 12:35:13 -05:00
d2619123c0
Improve type safety for Sapling 2024-03-14 11:30:54 -05:00
23472ee1c4
Improve type safety for Seed and Phrase 2024-03-14 11:13:10 -05:00
8a293f4e79
Enable for internal/external Orchard receivers 2024-03-14 11:12:31 -05:00
11 changed files with 484 additions and 411 deletions

View file

@ -5,8 +5,18 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [0.5.1.0]
## [Unreleased] ### Added
- Functionality to capture Sapling Spends
### Changed
- Modified the `makeZebraCall` function to handle errors explicitly
- Modified the RPC response to handle missing `result` field
## [0.5.0.1]
### Added ### Added
@ -20,6 +30,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Types for Spending Keys and Receivers for Sapling and Orchard - Types for Spending Keys and Receivers for Sapling and Orchard
- Function to generate an Orchard receiver - Function to generate an Orchard receiver
- Function to generate a Sapling receiver - Function to generate a Sapling receiver
- Function to generate a Transparent receiver
### Changed ### Changed

View file

@ -684,26 +684,19 @@ pub extern "C" fn rust_wrapper_sapling_chgpaymentaddress(
out: *mut u8, out: *mut u8,
out_len: &mut usize out_len: &mut usize
){ ){
println!("Entering ChangeAddress generation....");
let vexspk: Vec<u8> = marshall_from_haskell_var(extspk, extspk_len, RW); let vexspk: Vec<u8> = marshall_from_haskell_var(extspk, extspk_len, RW);
let vexspkp = &vexspk; let vexspkp = &vexspk;
let extspku8 : &[u8] = &vexspkp; let extspku8 : &[u8] = &vexspkp;
println!("Received ExtendedSpendingKey in Bytes...\n{:?}\n",extspku8);
let extspk = match ExtendedSpendingKey::from_bytes(&extspku8) { let extspk = match ExtendedSpendingKey::from_bytes(&extspku8) {
Ok( k ) => k, Ok( k ) => k,
Err( e ) => { Err( e ) => {
// error recovering ExtendedSpendingKey // error recovering ExtendedSpendingKey
println!("\n>>>> Error generating ExtendedSpendingKey");
marshall_to_haskell_var(&vec![0], out, out_len, RW); marshall_to_haskell_var(&vec![0], out, out_len, RW);
return return
} }
}; };
println!("ExtendedSpendingKey -> {:?}",extspk);
let dfvk = extspk.to_diversifiable_full_viewing_key(); let dfvk = extspk.to_diversifiable_full_viewing_key();
let ( divIx, cPmtAddress ) = dfvk.change_address(); let ( divIx, cPmtAddress ) = dfvk.change_address();
println!("\nDiversifierIndex > {:?}\n\nChange Payment Address -> {:?}\n ",
divIx, cPmtAddress);
println!("Change Payment Address in bytes : \n{:?}",cPmtAddress.to_bytes());
marshall_to_haskell_var(&cPmtAddress.to_bytes().to_vec(), out, out_len, RW); marshall_to_haskell_var(&cPmtAddress.to_bytes().to_vec(), out, out_len, RW);
} }
@ -733,13 +726,17 @@ pub extern "C" fn rust_wrapper_derive_orchard_receiver(
spend_key: *const u8, spend_key: *const u8,
spend_key_len: usize, spend_key_len: usize,
add_id: u32, add_id: u32,
scope: bool,
out: *mut u8, out: *mut u8,
out_len: &mut usize out_len: &mut usize
){ ){
let sk_in: Vec<u8> = marshall_from_haskell_var(spend_key, spend_key_len, RW); let sk_in: Vec<u8> = marshall_from_haskell_var(spend_key, spend_key_len, RW);
let sk = SpendingKey::from_bytes(sk_in[0..32].try_into().unwrap()).unwrap(); let sk = SpendingKey::from_bytes(sk_in[0..32].try_into().unwrap()).unwrap();
let fvk = FullViewingKey::from(&sk); let fvk = FullViewingKey::from(&sk);
let o_rec = fvk.address_at(add_id, Scope::External); let sc = if scope {
Scope::External
} else {Scope::Internal};
let o_rec = fvk.address_at(add_id, sc);
marshall_to_haskell_var(&o_rec.to_raw_address_bytes().to_vec(), out, out_len, RW); marshall_to_haskell_var(&o_rec.to_raw_address_bytes().to_vec(), out, out_len, RW);
} }

View file

@ -170,6 +170,7 @@ import ZcashHaskell.Types
{# fun unsafe rust_wrapper_derive_orchard_receiver as rustWrapperGenOrchardReceiver {# fun unsafe rust_wrapper_derive_orchard_receiver as rustWrapperGenOrchardReceiver
{ toBorshVar* `BS.ByteString'& { toBorshVar* `BS.ByteString'&
, `Word32' , `Word32'
, `Bool'
, getVarBuffer `Buffer (BS.ByteString)'& , getVarBuffer `Buffer (BS.ByteString)'&
} }
-> `()' -> `()'

View file

@ -21,7 +21,7 @@ import Foreign.Rust.Marshall.Variable
( withBorshVarBuffer ( withBorshVarBuffer
, withPureBorshVarBuffer , withPureBorshVarBuffer
) )
import ZcashHaskell.Types (Phrase, Seed) import ZcashHaskell.Types (Phrase, Seed(..), ToBytes(..))
-- | Generate a random seed that can be used to generate private keys for shielded addresses and transparent addresses. -- | Generate a random seed that can be used to generate private keys for shielded addresses and transparent addresses.
generateWalletSeedPhrase :: IO Phrase generateWalletSeedPhrase :: IO Phrase
@ -30,7 +30,7 @@ generateWalletSeedPhrase = withBorshVarBuffer rustWrapperGenSeedPhrase
-- | Derive a cryptographic seed from the given seed phrase. -- | Derive a cryptographic seed from the given seed phrase.
getWalletSeed :: Phrase -> Maybe Seed getWalletSeed :: Phrase -> Maybe Seed
getWalletSeed p = getWalletSeed p =
if BS.length result > 0 if BS.length (getBytes result) > 0
then Just result then Just result
else Nothing else Nothing
where where

View file

@ -37,29 +37,39 @@ import ZcashHaskell.Utils (encodeBech32m, f4Jumble)
-- | Derives an Orchard spending key for the given seed and account ID -- | Derives an Orchard spending key for the given seed and account ID
genOrchardSpendingKey :: genOrchardSpendingKey ::
Seed -> CoinType -> AccountId -> Maybe OrchardSpendingKey Seed -- ^ The cryptographic seed for the wallet
-> CoinType -- ^ The coin type constant
-> AccountId -- ^ The index of the account to be used
-> Maybe OrchardSpendingKey
genOrchardSpendingKey s coinType accountId = genOrchardSpendingKey s coinType accountId =
if BS.length k /= 32 if BS.length k /= 32
then Nothing then Nothing
else Just k else Just $ OrchardSpendingKey k
where where
k = k =
withPureBorshVarBuffer $ withPureBorshVarBuffer $
rustWrapperGenOrchardSpendKey rustWrapperGenOrchardSpendKey
s (getBytes s)
(getValue coinType) (getValue coinType)
(fromIntegral accountId) (fromIntegral accountId)
-- | Derives an Orchard receiver for the given spending key and index -- | Derives an Orchard receiver for the given spending key and index
genOrchardReceiver :: Int -> OrchardSpendingKey -> Maybe OrchardReceiver genOrchardReceiver ::
genOrchardReceiver i osk = Int -- ^ The index of the address to be created
-> Scope -- ^ `External` for wallet addresses, `Internal` for change addresses
-> OrchardSpendingKey -- ^ The spending key
-> Maybe OrchardReceiver
genOrchardReceiver i scope osk =
if BS.length k /= 43 if BS.length k /= 43
then Nothing then Nothing
else Just k else Just $ OrchardReceiver k
where where
k = k =
withPureBorshVarBuffer $ withPureBorshVarBuffer $
rustWrapperGenOrchardReceiver osk (fromIntegral i) rustWrapperGenOrchardReceiver
(getBytes osk)
(fromIntegral i)
(scope == External)
-- | Checks if given bytestring is a valid encoded unified address -- | Checks if given bytestring is a valid encoded unified address
isValidUnifiedAddress :: BS.ByteString -> Maybe UnifiedAddress isValidUnifiedAddress :: BS.ByteString -> Maybe UnifiedAddress
@ -78,10 +88,10 @@ isValidUnifiedAddress str =
UnifiedAddress UnifiedAddress
whichNet whichNet
(if BS.length (raw_o x) == 43 (if BS.length (raw_o x) == 43
then Just (raw_o x) then Just $ OrchardReceiver (raw_o x)
else Nothing) else Nothing)
(if BS.length (raw_s x) == 43 (if BS.length (raw_s x) == 43
then Just (raw_s x) then Just $ SaplingReceiver (raw_s x)
else Nothing) else Nothing)
(if not (BS.null (raw_t x)) (if not (BS.null (raw_t x))
then Just $ TransparentAddress P2PKH (fromRawBytes $ raw_t x) then Just $ TransparentAddress P2PKH (fromRawBytes $ raw_t x)
@ -105,8 +115,8 @@ encodeUnifiedAddress ua = encodeBech32m (E.encodeUtf8 hr) b
case ta_type t of case ta_type t of
P2SH -> packReceiver 0x01 $ Just $ toBytes $ ta_bytes t P2SH -> packReceiver 0x01 $ Just $ toBytes $ ta_bytes t
P2PKH -> packReceiver 0x00 $ Just $ toBytes $ ta_bytes t P2PKH -> packReceiver 0x00 $ Just $ toBytes $ ta_bytes t
sReceiver = packReceiver 0x02 $ s_rec ua sReceiver = packReceiver 0x02 $ getBytes <$> s_rec ua
oReceiver = packReceiver 0x03 $ o_rec ua oReceiver = packReceiver 0x03 $ getBytes <$> o_rec ua
padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr
packReceiver :: Word8 -> Maybe BS.ByteString -> BS.ByteString packReceiver :: Word8 -> Maybe BS.ByteString -> BS.ByteString
packReceiver typeCode receiver' = packReceiver typeCode receiver' =

View file

@ -20,9 +20,9 @@ module ZcashHaskell.Sapling where
import C.Zcash import C.Zcash
( rustWrapperIsShielded ( rustWrapperIsShielded
, rustWrapperSaplingCheck , rustWrapperSaplingCheck
, rustWrapperSaplingChgPaymentAddress
, rustWrapperSaplingNoteDecode , rustWrapperSaplingNoteDecode
, rustWrapperSaplingPaymentAddress , rustWrapperSaplingPaymentAddress
, rustWrapperSaplingChgPaymentAddress
, rustWrapperSaplingSpendingkey , rustWrapperSaplingSpendingkey
, rustWrapperSaplingVkDecode , rustWrapperSaplingVkDecode
, rustWrapperTxParse , rustWrapperTxParse
@ -41,11 +41,11 @@ import ZcashHaskell.Types
, DecodedNote(..) , DecodedNote(..)
, RawData(..) , RawData(..)
, RawTxResponse(..) , RawTxResponse(..)
, SaplingInternalReceiver , SaplingReceiver(..)
, SaplingReceiver
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Seed(..) , Seed(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, ToBytes(..)
, decodeHexText , decodeHexText
, getValue , getValue
) )
@ -90,23 +90,25 @@ instance FromJSON RawTxResponse where
ht <- obj .: "height" ht <- obj .: "height"
c <- obj .: "confirmations" c <- obj .: "confirmations"
b <- obj .: "blocktime" b <- obj .: "blocktime"
sSpend <- obj .: "vShieldedSpend"
case o of case o of
Nothing -> pure $ RawTxResponse i h (getShieldedOutputs h) [] ht c b Nothing ->
pure $ RawTxResponse i h sSpend (getShieldedOutputs h) [] ht c b
Just o' -> do Just o' -> do
a <- o' .: "actions" a <- o' .: "actions"
pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b pure $ RawTxResponse i h sSpend (getShieldedOutputs h) a ht c b
-- | Attempts to obtain a sapling SpendingKey using a HDSeed -- | Attempts to obtain a sapling SpendingKey using a HDSeed
genSaplingSpendingKey :: Seed -> CoinType -> Int -> Maybe SaplingSpendingKey genSaplingSpendingKey :: Seed -> CoinType -> Int -> Maybe SaplingSpendingKey
genSaplingSpendingKey seed c i = do genSaplingSpendingKey seed c i = do
if BS.length res == 169 if BS.length res == 169
then Just res then Just $ SaplingSpendingKey res
else Nothing else Nothing
where where
res = res =
withPureBorshVarBuffer withPureBorshVarBuffer
(rustWrapperSaplingSpendingkey (rustWrapperSaplingSpendingkey
seed (getBytes seed)
(fromIntegral $ getValue c) (fromIntegral $ getValue c)
(fromIntegral i)) (fromIntegral i))
@ -114,20 +116,21 @@ genSaplingSpendingKey seed c i = do
genSaplingPaymentAddress :: Int -> SaplingSpendingKey -> Maybe SaplingReceiver genSaplingPaymentAddress :: Int -> SaplingSpendingKey -> Maybe SaplingReceiver
genSaplingPaymentAddress i extspk = genSaplingPaymentAddress i extspk =
if BS.length res == 43 if BS.length res == 43
then Just res then Just $ SaplingReceiver res
else Nothing else Nothing
where where
res = res =
withPureBorshVarBuffer withPureBorshVarBuffer
(rustWrapperSaplingPaymentAddress extspk (fromIntegral (i * 111))) (rustWrapperSaplingPaymentAddress
(getBytes extspk)
(fromIntegral (i * 111)))
-- | Generate an internal Sapling address -- | Generate an internal Sapling address
genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingInternalReceiver genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingReceiver
genSaplingInternalAddress sk = genSaplingInternalAddress sk =
if (BS.length res) > 0 if BS.length res == 43
then Just res then Just $ SaplingReceiver res
else Nothing else Nothing
where where
res = res =
withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress sk) withPureBorshVarBuffer (rustWrapperSaplingChgPaymentAddress $ getBytes sk)

View file

@ -17,30 +17,36 @@ module ZcashHaskell.Transparent where
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Crypto.Hash import Crypto.Hash
import Crypto.Secp256k1
import qualified Data.ByteArray as BA import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58) import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58)
import Data.HexString
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Word
import Haskoin.Address (Address(..))
import qualified Haskoin.Crypto.Hash as H
import Haskoin.Crypto.Keys.Extended
import ZcashHaskell.Types import ZcashHaskell.Types
( AccountId ( AccountId
, Seed , CoinType(..)
, Scope(..)
, Seed(..)
, ToBytes(..)
, TransparentAddress(..) , TransparentAddress(..)
, TransparentSpendingKey(..)
, TransparentType(..) , TransparentType(..)
, ZcashNet(..) , ZcashNet(..)
, CoinType(..)
, getTransparentPrefix , getTransparentPrefix
, getValue , getValue
) )
import Crypto.Secp256k1 -- | Encodes a `TransparentAddress` into the human-readable format per the Zcash Protocol section 5.6.1.1
import Haskoin.Crypto.Keys.Extended encodeTransparent ::
import Data.HexString ZcashNet -- ^ The network, `MainNet` or `TestNet`
import Data.Word -> TransparentAddress -- ^ The address to encode
import Haskoin.Address (Address(..)) -> T.Text
import qualified Haskoin.Crypto.Hash as H
encodeTransparent :: ZcashNet -> TransparentAddress -> T.Text
encodeTransparent zNet t = encodeTransparent zNet t =
encodeTransparent' (getTransparentPrefix zNet (ta_type t)) $ encodeTransparent' (getTransparentPrefix zNet (ta_type t)) $
toBytes $ ta_bytes t toBytes $ ta_bytes t
@ -54,31 +60,34 @@ encodeTransparent zNet t =
digest = BS.pack [a, b] <> h digest = BS.pack [a, b] <> h
checksum = sha256 $ sha256 digest checksum = sha256 $ sha256 digest
-- | Attempts to generate an Extended Private Key from a known HDSeed. -- | Generate an Extended Private Key from a known HDSeed.
genTransparentPrvKey :: Seed -> CoinType -> AccountId -> IO XPrvKey genTransparentPrvKey ::
genTransparentPrvKey hdseed ctype accid = do Seed -- ^ The cryptographic seed of the wallet
-> CoinType -- ^ The coin type constant to be used
-> AccountId -- ^ The index of the account to be used
-> IO TransparentSpendingKey
genTransparentPrvKey hdseed ctype accid = do
let coin = getValue ctype let coin = getValue ctype
ioCtx <- createContext ioCtx <- createContext
let path = Deriv :| 44 :| coin :| AccounId :/ 0 :/ 0 :: DerivPath let path = Deriv :| 44 :| coin :| fromIntegral accid :: DerivPath
let prvKey = makeXPrvKey hdseed let prvKey = makeXPrvKey $ getBytes hdseed
return $ derivePath ioCtx path prvKey return $ derivePath ioCtx path prvKey
genTransparentPubKey :: XPrvKey -> IO XPubKey
genTransparentPubKey xPrvKey = do
ioCtx <- createContext
return $ deriveXPubKey ioCtx xPrvKey
genTransparentPubAddress :: XPubKey -> IO Address
genTransparentPubAddress xPubKey = do
ioCtx <- createContext
return $ xPubAddr ioCtx xPubKey
-- | Generate a transparent receiver -- | Generate a transparent receiver
genTransparentReceiver :: Int -> XPrvKey -> IO TransparentAddress genTransparentReceiver ::
genTransparentReceiver i xprvk = do Int -- ^ The index of the address to be created
-> Scope -- ^ `External` for wallet addresses or `Internal` for change addresses
-> XPrvKey -- ^ The transparent private key
-> IO TransparentAddress
genTransparentReceiver i scope xprvk = do
ioCtx <- createContext ioCtx <- createContext
let rootPubKey = deriveXPubKey ioCtx xprvk let s =
let childPubKey = pubSubKey ioCtx rootPubKey (fromIntegral i) case scope of
External -> 0
Internal -> 1
let path = Deriv :/ s :/ fromIntegral i :: DerivPath
let childPrvKey = derivePath ioCtx path xprvk
let childPubKey = deriveXPubKey ioCtx childPrvKey
let x = xPubAddr ioCtx childPubKey let x = xPubAddr ioCtx childPubKey
case x of case x of
PubKeyAddress k -> return $ TransparentAddress P2PKH $ fromBinary k PubKeyAddress k -> return $ TransparentAddress P2PKH $ fromBinary k

View file

@ -7,7 +7,7 @@
-- Copyright : 2022-2024 Vergara Technologies -- Copyright : 2022-2024 Vergara Technologies
-- License : MIT -- License : MIT
-- --
-- Maintainer : pitmut@vergara.tech -- Maintainer : pitmutt@vergara.tech
-- Stability : experimental -- Stability : experimental
-- Portability : unknown -- Portability : unknown
-- --
@ -15,6 +15,7 @@
-- --
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
@ -30,6 +31,7 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Char8 as C
import Data.HexString import Data.HexString
import Data.Int import Data.Int
import Data.Maybe (fromMaybe)
import Data.Structured import Data.Structured
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -37,14 +39,37 @@ import Data.Word
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP import qualified Generics.SOP as SOP
import Haskoin.Address (Address) import Haskoin.Address (Address)
import Haskoin.Crypto.Keys.Extended (XPrvKey)
-- * General -- * General
-- --
-- | A seed for generating private keys -- | A seed for generating private keys
type Seed = C.ByteString newtype Seed =
Seed BS.ByteString
deriving stock (Eq, Prelude.Show, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct Seed
instance ToBytes Seed where
getBytes (Seed x) = x
-- | A mnemonic phrase used to derive seeds -- | A mnemonic phrase used to derive seeds
type Phrase = BS.ByteString newtype Phrase =
Phrase C.ByteString
deriving stock (Eq, Prelude.Show, GHC.Generic, Read)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct Phrase
instance ToBytes Phrase where
getBytes (Phrase x) = x
-- | Scope for addresses/receivers
data Scope
= External -- ^ Addresses used publically to receive payments
| Internal -- ^ Addresses used internally by wallets for change and shielding
deriving (Eq, Prelude.Show, Read)
-- | Type to represent data after Bech32 decoding -- | Type to represent data after Bech32 decoding
data RawData = RawData data RawData = RawData
@ -144,7 +169,7 @@ instance (FromJSON r) => FromJSON (RpcResponse r) where
withObject "RpcResponse" $ \obj -> do withObject "RpcResponse" $ \obj -> do
e <- obj .:? "error" e <- obj .:? "error"
i <- obj .: "id" i <- obj .: "id"
r <- obj .: "result" r <- obj .:? "result"
pure $ MakeRpcResponse e i r pure $ MakeRpcResponse e i r
-- | A type to model the errors from the Zcash RPC -- | A type to model the errors from the Zcash RPC
@ -167,7 +192,7 @@ data BlockResponse = BlockResponse
{ bl_confirmations :: !Integer -- ^ Block confirmations { bl_confirmations :: !Integer -- ^ Block confirmations
, bl_height :: !Integer -- ^ Block height , bl_height :: !Integer -- ^ Block height
, bl_time :: !Integer -- ^ Block time , bl_time :: !Integer -- ^ Block time
, bl_txs :: ![T.Text] -- ^ List of transaction IDs in the block , bl_txs :: ![HexString] -- ^ List of transaction IDs in the block
} deriving (Prelude.Show, Eq) } deriving (Prelude.Show, Eq)
instance FromJSON BlockResponse where instance FromJSON BlockResponse where
@ -175,14 +200,15 @@ instance FromJSON BlockResponse where
withObject "BlockResponse" $ \obj -> do withObject "BlockResponse" $ \obj -> do
c <- obj .: "confirmations" c <- obj .: "confirmations"
h <- obj .: "height" h <- obj .: "height"
t <- obj .: "time" t <- obj .:? "time"
txs <- obj .: "tx" txs <- obj .: "tx"
pure $ BlockResponse c h t txs pure $ BlockResponse c h (fromMaybe 0 t) txs
-- | Type to represent response from the `zcashd` RPC `getrawtransaction` -- | Type to represent response from the `zcashd` RPC `getrawtransaction`
data RawTxResponse = RawTxResponse data RawTxResponse = RawTxResponse
{ rt_id :: !HexString { rt_id :: !HexString
, rt_hex :: !HexString , rt_hex :: !HexString
, rt_shieldedSpends :: ![ShieldedSpend]
, rt_shieldedOutputs :: ![BS.ByteString] , rt_shieldedOutputs :: ![BS.ByteString]
, rt_orchardActions :: ![OrchardAction] , rt_orchardActions :: ![OrchardAction]
, rt_blockheight :: !Integer , rt_blockheight :: !Integer
@ -233,6 +259,9 @@ data TransparentType
| P2PKH | P2PKH
deriving (Eq, Prelude.Show, Read) deriving (Eq, Prelude.Show, Read)
-- | Type for transparent spending key
type TransparentSpendingKey = XPrvKey
-- | Type to represent a transparent Zcash addresses -- | Type to represent a transparent Zcash addresses
data TransparentAddress = TransparentAddress data TransparentAddress = TransparentAddress
{ ta_type :: !TransparentType { ta_type :: !TransparentType
@ -241,13 +270,44 @@ data TransparentAddress = TransparentAddress
-- * Sapling -- * Sapling
-- | A spending key for Sapling -- | A spending key for Sapling
type SaplingSpendingKey = BS.ByteString newtype SaplingSpendingKey =
SaplingSpendingKey BS.ByteString
deriving stock (Eq, Prelude.Show, Read)
instance ToBytes SaplingSpendingKey where
getBytes (SaplingSpendingKey s) = s
-- | A Sapling receiver -- | A Sapling receiver
type SaplingReceiver = BS.ByteString newtype SaplingReceiver =
SaplingReceiver BS.ByteString
deriving stock (Eq, Prelude.Show, Read)
-- | A Sapling internal receiver instance ToBytes SaplingReceiver where
type SaplingInternalReceiver = BS.ByteString getBytes (SaplingReceiver s) = s
-- | Type to represent a Sapling Shielded Spend as provided by the @getrawtransaction@ RPC method
data ShieldedSpend = ShieldedSpend
{ sp_cv :: !HexString
, sp_anchor :: !HexString
, sp_nullifier :: !HexString
, sp_rk :: !HexString
, sp_proof :: !HexString
, sp_auth :: !HexString
} deriving stock (Eq, Prelude.Show, GHC.Generic, Read)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedSpend
instance FromJSON ShieldedSpend where
parseJSON =
withObject "ShieldedSpend" $ \obj -> do
cv <- obj .: "cv"
anchor <- obj .: "anchor"
nullifier <- obj .: "nullifier"
rk <- obj .: "rk"
p <- obj .: "proof"
sig <- obj .: "spendAuthSig"
pure $ ShieldedSpend cv anchor nullifier rk p sig
-- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@. -- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@.
data ShieldedOutput = ShieldedOutput data ShieldedOutput = ShieldedOutput
@ -275,10 +335,20 @@ instance FromJSON ShieldedOutput where
-- * Orchard -- * Orchard
-- | A spending key for Orchard -- | A spending key for Orchard
type OrchardSpendingKey = BS.ByteString newtype OrchardSpendingKey =
OrchardSpendingKey BS.ByteString
deriving stock (Eq, Prelude.Show, Read)
instance ToBytes OrchardSpendingKey where
getBytes (OrchardSpendingKey o) = o
-- | An Orchard receiver -- | An Orchard receiver
type OrchardReceiver = BS.ByteString newtype OrchardReceiver =
OrchardReceiver BS.ByteString
deriving stock (Eq, Prelude.Show, Read)
instance ToBytes OrchardReceiver where
getBytes (OrchardReceiver o) = o
-- | Type to represent a Unified Address -- | Type to represent a Unified Address
data UnifiedAddress = UnifiedAddress data UnifiedAddress = UnifiedAddress
@ -349,6 +419,11 @@ data DecodedNote = DecodedNote
deriving anyclass (Data.Structured.Show) deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct DecodedNote deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct DecodedNote
-- * Classes
-- | Class to represent types with a bytestring representation
class ToBytes a where
getBytes :: a -> BS.ByteString
-- * Helpers -- * Helpers
-- | Helper function to turn a hex-encoded string to bytestring -- | Helper function to turn a hex-encoded string to bytestring
decodeHexText :: String -> BS.ByteString decodeHexText :: String -> BS.ByteString

View file

@ -23,12 +23,14 @@ import C.Zcash
, rustWrapperF4Jumble , rustWrapperF4Jumble
, rustWrapperF4UnJumble , rustWrapperF4UnJumble
) )
import Control.Exception (SomeException(..), try)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Foreign.Rust.Marshall.Variable import Foreign.Rust.Marshall.Variable
import Network.HTTP.Client (HttpException(..))
import Network.HTTP.Simple import Network.HTTP.Simple
import ZcashHaskell.Types import ZcashHaskell.Types
@ -74,12 +76,12 @@ makeZcashCall username password m p = do
-- | Make a Zebra RPC call -- | Make a Zebra RPC call
makeZebraCall :: makeZebraCall ::
(MonadIO m, FromJSON a) FromJSON a
=> T.Text -- ^ Hostname for `zebrad` => T.Text -- ^ Hostname for `zebrad`
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> T.Text -- ^ RPC method to call -> T.Text -- ^ RPC method to call
-> [Data.Aeson.Value] -- ^ List of parameters -> [Data.Aeson.Value] -- ^ List of parameters
-> m (Response a) -> IO (Either String a)
makeZebraCall host port m params = do makeZebraCall host port m params = do
let payload = RpcCall "2.0" "zh" m params let payload = RpcCall "2.0" "zh" m params
let myRequest = let myRequest =
@ -87,4 +89,16 @@ makeZebraCall host port m params = do
setRequestPort port $ setRequestPort port $
setRequestHost (E.encodeUtf8 host) $ setRequestHost (E.encodeUtf8 host) $
setRequestMethod "POST" defaultRequest setRequestMethod "POST" defaultRequest
httpJSON myRequest r <-
try $ httpJSON myRequest :: FromJSON a1 =>
IO (Either SomeException (Response (RpcResponse a1)))
case r of
Left ex -> return $ Left $ show ex
Right res -> do
let zebraResp = getResponseBody res
case err zebraResp of
Just zErr -> return $ Left $ T.unpack $ emessage zErr
Nothing ->
case result zebraResp of
Nothing -> return $ Left "Empty response from Zebra"
Just zR -> return $ Right zR

View file

@ -33,7 +33,6 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Text.Lazy.Encoding as LE import qualified Data.Text.Lazy.Encoding as LE
import qualified Data.Text.Lazy.IO as LTIO import qualified Data.Text.Lazy.IO as LTIO
import GHC.Float.RealFracMethods (properFractionDoubleInteger) import GHC.Float.RealFracMethods (properFractionDoubleInteger)
import Test.Hspec import Test.Hspec
import Test.Hspec.QuickCheck import Test.Hspec.QuickCheck
@ -42,8 +41,8 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard import ZcashHaskell.Orchard
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( decodeSaplingOutput ( decodeSaplingOutput
, genSaplingPaymentAddress
, genSaplingInternalAddress , genSaplingInternalAddress
, genSaplingPaymentAddress
, genSaplingSpendingKey , genSaplingSpendingKey
, getShieldedOutputs , getShieldedOutputs
, isValidSaplingViewingKey , isValidSaplingViewingKey
@ -55,14 +54,18 @@ import ZcashHaskell.Types
( AccountId ( AccountId
, BlockResponse(..) , BlockResponse(..)
, CoinType(..) , CoinType(..)
, CoinType
, DecodedNote(..) , DecodedNote(..)
, OrchardAction(..) , OrchardAction(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, RawData(..) , RawData(..)
, RawTxResponse(..) , RawTxResponse(..)
, SaplingReceiver(..)
, SaplingSpendingKey(..)
, Scope(..)
, Seed(..) , Seed(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, ToBytes(..)
, TransparentAddress(..) , TransparentAddress(..)
, TransparentType(..) , TransparentType(..)
, UnifiedAddress(..) , UnifiedAddress(..)
@ -315,7 +318,7 @@ main = do
describe "Seeds" $ do describe "Seeds" $ do
it "generate seed phrase" $ do it "generate seed phrase" $ do
s <- generateWalletSeedPhrase s <- generateWalletSeedPhrase
BS.length s `shouldNotBe` 0 BS.length (getBytes s) `shouldNotBe` 0
it "get seed from phrase" $ do it "get seed from phrase" $ do
s <- generateWalletSeedPhrase s <- generateWalletSeedPhrase
let x = getWalletSeed s let x = getWalletSeed s
@ -469,11 +472,11 @@ main = do
let msg = maybe "" a_memo decryptedNote2 let msg = maybe "" a_memo decryptedNote2
msg `shouldBe` msg `shouldBe`
"Hello World!\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL" "Hello World!\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
describe "Wallet seed phrase" $ do describe "Wallet seed phrase:" $ do
prop "Generated phrases are valid" $ again prop_PhraseLength prop "Generated phrases are valid" $ again prop_PhraseLength
prop "Derived seeds are valid" $ again prop_SeedLength prop "Derived seeds are valid" $ again prop_SeedLength
before getSeed $ before getSeed $
describe "Optimized spending key tests" $ do describe "Optimized spending key tests:" $ do
it "Transparent spending keys are valid" $ \s -> it "Transparent spending keys are valid" $ \s ->
property $ prop_TransparentSpendingKey s property $ prop_TransparentSpendingKey s
it "Transparent receivers are valid" $ \s -> it "Transparent receivers are valid" $ \s ->
@ -490,7 +493,7 @@ main = do
property $ prop_OrchardReceiver s property $ prop_OrchardReceiver s
it "Orchard receivers are distinct" $ \s -> it "Orchard receivers are distinct" $ \s ->
property $ prop_OrchardRecRepeated s property $ prop_OrchardRecRepeated s
describe "Address tests" $ do describe "Address tests:" $ do
it "Encode transparent" $ do it "Encode transparent" $ do
let ua = let ua =
"u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x" "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
@ -501,303 +504,11 @@ main = do
maybe "No transparent" (encodeTransparent (ua_net u)) $ maybe "No transparent" (encodeTransparent (ua_net u)) $
t_rec u t_rec u
msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD" msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD"
describe "Transparent Private and Public Key Generation" $ do
it "Obtain a transparent extended private key from HDSeed" $ do
let hdseed =
[ 206
, 61
, 120
, 38
, 206
, 40
, 201
, 62
, 83
, 175
, 151
, 131
, 218
, 141
, 206
, 254
, 28
, 244
, 172
, 213
, 128
, 248
, 156
, 45
, 204
, 44
, 169
, 3
, 162
, 188
, 16
, 173
, 192
, 164
, 96
, 148
, 91
, 52
, 244
, 83
, 149
, 169
, 82
, 196
, 199
, 53
, 177
, 170
, 1
, 6
, 0
, 120
, 170
, 2
, 238
, 219
, 241
, 243
, 172
, 178
, 104
, 81
, 159
, 144
] :: [Word8]
xtpvk <- genTransparentPrvKey (BS.pack hdseed) MainNetCoin 0
let testpvk =
XPrvKey
0
"0000000000"
0
"fb5b9b89d3e9dfdebeaabd15de8fbc7e9a140b7f2de2b4034c2573425d39aceb"
"46aa0cd24a6e05709591426a4e682dd5406de4e75a39c0f410ee790403880943"
xtpvk `shouldBe` testpvk
it "Obtain a transparent extended public key from private key" $ do
let testpvk =
XPrvKey
0
"0000000000"
0
"fb5b9b89d3e9dfdebeaabd15de8fbc7e9a140b7f2de2b4034c2573425d39aceb"
"46aa0cd24a6e05709591426a4e682dd5406de4e75a39c0f410ee790403880943"
let testpbk =
XPubKey
0
"00000000"
0
"fb5b9b89d3e9dfdebeaabd15de8fbc7e9a140b7f2de2b4034c2573425d39aceb"
"279bda9c704f6da479cedb12c7cf773b3a348569dc1cfa6002526bad67674fd737b84a2bdb1199ecab1c9fed1b9a38aba5ba19259c1510d733a2376118515cd8"
let xtpubkIO = genTransparentPubKey testpvk
xtpubk <- xtpubkIO
---print $ show xtpubk
xtpubk `shouldBe` testpbk
-- describe "Sapling SpendingKey test" $ do
-- it "Generate Sapling spending key" $ do
-- p <- generateWalletSeedPhrase
-- let s = getWalletSeed p
-- genSaplingSpendingKey <$> s `shouldNotBe` Nothing
describe "Sapling Payment Address generation test" $ do
it "Call genSaplingPaymentAddress" $ do
p <- generateWalletSeedPhrase
let s = getWalletSeed p
genSaplingPaymentAddress 0 (fromMaybe "" s) `shouldNotBe` Nothing
-- prop "Sapling receivers are valid" $
-- forAll genSapArgs $ \s -> prop_SaplingReceiver s
describe "Sapling Change Payment Address generation test" $ do
it "Call genSaplingInternalAddress" $ do
let sk = [ 3
, 183
, 26
, 151
, 89
, 0
, 0
, 0
, 128
, 199
, 189
, 33
, 169
, 114
, 194
, 50
, 0
, 139
, 140
, 162
, 100
, 100
, 35
, 58
, 226
, 6
, 47
, 232
, 34
, 214
, 11
, 173
, 142
, 40
, 45
, 163
, 190
, 207
, 49
, 130
, 158
, 113
, 232
, 251
, 79
, 98
, 77
, 195
, 196
, 40
, 42
, 113
, 133
, 35
, 211
, 68
, 146
, 104
, 5
, 56
, 244
, 162
, 55
, 239
, 55
, 112
, 37
, 38
, 189
, 183
, 121
, 201
, 1
, 60
, 158
, 151
, 141
, 123
, 250
, 95
, 169
, 123
, 208
, 56
, 103
, 74
, 85
, 49
, 152
, 207
, 245
, 216
, 58
, 37
, 0
, 127
, 186
, 245
, 234
, 47
, 68
, 11
, 78
, 76
, 12
, 171
, 37
, 63
, 172
, 90
, 111
, 94
, 88
, 152
, 211
, 53
, 243
, 142
, 16
, 195
, 142
, 50
, 14
, 13
, 32
, 91
, 5
, 82
, 182
, 121
, 136
, 109
, 125
, 165
, 125
, 123
, 226
, 54
, 60
, 34
, 62
, 111
, 167
, 88
, 254
, 113
, 204
, 47
, 181
, 97
, 18
, 220
, 46
, 51
, 160
, 62
, 16
, 199
, 143
, 184
, 200
, 209
, 124
, 154
, 175
, 29
, 216
, 48
, 201] :: [Word8]
let cAdr = [31, 232, 31, 17, 196,
178, 208, 227, 206,
199, 105, 55, 147,
23, 151, 206, 117,
59, 249, 162, 218,
140, 189, 17, 60,
116, 106, 56, 64,
203, 152, 52, 155,
133, 179, 118, 47,
161, 70, 155, 21,
22, 41] :: [Word8]
let bscAdr = BS.pack cAdr
let ca = genSaplingInternalAddress (BS.pack sk)
(fromMaybe "" ca) `shouldBe` bscAdr
it "Recover UA from YWallet" $ it "Recover UA from YWallet" $
ioProperty $ do ioProperty $ do
let p = let p =
"security expect junk hour people bind law hub between topic wink cliff spirit scissors auction idle figure option wide useful swift prison cushion round" Phrase
"security expect junk hour people bind law hub between topic wink cliff spirit scissors auction idle figure option wide useful swift prison cushion round"
let targetUA = let targetUA =
isValidUnifiedAddress isValidUnifiedAddress
"u1qsylqauvnhw8tsfe3cldcsj3mjrfqzgaf3mt8yzlkjuvsf5wzj223yvrt8q66qukfqcc80x3z0mk6ym6pm2f0hukzkp6t4wj78h85t6kfr2u9mqsfhdd73g3sc7ezy2ut3rtq5jmejatwv4xqqd6l8tt9fycer8kdw0gz6e607nkssqsc7kd7nk2yfz2hpvpqhdg39wxalpjzhe34j7" "u1qsylqauvnhw8tsfe3cldcsj3mjrfqzgaf3mt8yzlkjuvsf5wzj223yvrt8q66qukfqcc80x3z0mk6ym6pm2f0hukzkp6t4wj78h85t6kfr2u9mqsfhdd73g3sc7ezy2ut3rtq5jmejatwv4xqqd6l8tt9fycer8kdw0gz6e607nkssqsc7kd7nk2yfz2hpvpqhdg39wxalpjzhe34j7"
@ -808,15 +519,16 @@ main = do
let oK = genOrchardSpendingKey s' MainNetCoin 0 let oK = genOrchardSpendingKey s' MainNetCoin 0
let sK = genSaplingSpendingKey s' MainNetCoin 0 let sK = genSaplingSpendingKey s' MainNetCoin 0
let tK = genTransparentPrvKey s' MainNetCoin 0 let tK = genTransparentPrvKey s' MainNetCoin 0
let oR = genOrchardReceiver 0 =<< oK let oR = genOrchardReceiver 0 External =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver 0 =<< tK tR <- genTransparentReceiver 0 External =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR let newUA = UnifiedAddress MainNet oR sR $ Just tR
return $ Just newUA `shouldBe` targetUA return $ Just newUA `shouldBe` targetUA
it "Recover UA from Zingo" $ it "Recover UA from Zingo:" $
ioProperty $ do ioProperty $ do
let p = let p =
"cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest" Phrase
"cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest"
let targetUA = let targetUA =
isValidUnifiedAddress isValidUnifiedAddress
"u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m" "u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
@ -827,34 +539,259 @@ main = do
let oK = genOrchardSpendingKey s' MainNetCoin 0 let oK = genOrchardSpendingKey s' MainNetCoin 0
let sK = genSaplingSpendingKey s' MainNetCoin 0 let sK = genSaplingSpendingKey s' MainNetCoin 0
let tK = genTransparentPrvKey s' MainNetCoin 0 let tK = genTransparentPrvKey s' MainNetCoin 0
let oR = genOrchardReceiver 0 =<< oK let oR = genOrchardReceiver 0 External =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver 0 =<< tK tR <- genTransparentReceiver 0 External =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR let newUA = UnifiedAddress MainNet oR sR $ Just tR
return $ Just newUA `shouldBe` targetUA return $ Just newUA `shouldBe` targetUA
describe "Sapling Change Payment Address generation test" $ do
it "Call genSaplingInternalAddress" $ do
let sk =
[ 3
, 183
, 26
, 151
, 89
, 0
, 0
, 0
, 128
, 199
, 189
, 33
, 169
, 114
, 194
, 50
, 0
, 139
, 140
, 162
, 100
, 100
, 35
, 58
, 226
, 6
, 47
, 232
, 34
, 214
, 11
, 173
, 142
, 40
, 45
, 163
, 190
, 207
, 49
, 130
, 158
, 113
, 232
, 251
, 79
, 98
, 77
, 195
, 196
, 40
, 42
, 113
, 133
, 35
, 211
, 68
, 146
, 104
, 5
, 56
, 244
, 162
, 55
, 239
, 55
, 112
, 37
, 38
, 189
, 183
, 121
, 201
, 1
, 60
, 158
, 151
, 141
, 123
, 250
, 95
, 169
, 123
, 208
, 56
, 103
, 74
, 85
, 49
, 152
, 207
, 245
, 216
, 58
, 37
, 0
, 127
, 186
, 245
, 234
, 47
, 68
, 11
, 78
, 76
, 12
, 171
, 37
, 63
, 172
, 90
, 111
, 94
, 88
, 152
, 211
, 53
, 243
, 142
, 16
, 195
, 142
, 50
, 14
, 13
, 32
, 91
, 5
, 82
, 182
, 121
, 136
, 109
, 125
, 165
, 125
, 123
, 226
, 54
, 60
, 34
, 62
, 111
, 167
, 88
, 254
, 113
, 204
, 47
, 181
, 97
, 18
, 220
, 46
, 51
, 160
, 62
, 16
, 199
, 143
, 184
, 200
, 209
, 124
, 154
, 175
, 29
, 216
, 48
, 201
] :: [Word8]
let cAdr =
[ 31
, 232
, 31
, 17
, 196
, 178
, 208
, 227
, 206
, 199
, 105
, 55
, 147
, 23
, 151
, 206
, 117
, 59
, 249
, 162
, 218
, 140
, 189
, 17
, 60
, 116
, 106
, 56
, 64
, 203
, 152
, 52
, 155
, 133
, 179
, 118
, 47
, 161
, 70
, 155
, 21
, 22
, 41
] :: [Word8]
let bscAdr = SaplingReceiver $ BS.pack cAdr
let ca = genSaplingInternalAddress (SaplingSpendingKey $ BS.pack sk)
fromMaybe (SaplingReceiver "") ca `shouldBe` bscAdr
-- | Properties -- | Properties
prop_PhraseLength :: Property prop_PhraseLength :: Property
prop_PhraseLength = prop_PhraseLength =
ioProperty $ do ioProperty $ do
p <- generateWalletSeedPhrase p <- generateWalletSeedPhrase
return $ BS.length p >= 95 return $ BS.length (getBytes p) >= 95
prop_SeedLength :: Property prop_SeedLength :: Property
prop_SeedLength = prop_SeedLength =
ioProperty $ do ioProperty $ do
p <- generateWalletSeedPhrase p <- generateWalletSeedPhrase
let s = getWalletSeed p let s = getWalletSeed p
return $ maybe 0 BS.length s === 64 return $ maybe 0 (BS.length . getBytes) s === 64
prop_OrchardSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property prop_OrchardSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
prop_OrchardSpendingKey s c (NonNegative i) = prop_OrchardSpendingKey s c (NonNegative i) =
genOrchardSpendingKey s c i =/= Nothing genOrchardSpendingKey s c i =/= Nothing
prop_OrchardReceiver :: prop_OrchardReceiver ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Scope -> Property
prop_OrchardReceiver s c (NonNegative i) (NonNegative j) = prop_OrchardReceiver s c (NonNegative i) (NonNegative j) scope =
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= Nothing genOrchardReceiver
j
scope
(fromMaybe (OrchardSpendingKey "") $ genOrchardSpendingKey s c i) =/=
Nothing
prop_SaplingSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property prop_SaplingSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
prop_SaplingSpendingKey s c (NonNegative i) = prop_SaplingSpendingKey s c (NonNegative i) =
@ -863,32 +800,44 @@ prop_SaplingSpendingKey s c (NonNegative i) =
prop_SaplingReceiver :: prop_SaplingReceiver ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
prop_SaplingReceiver s c (NonNegative i) (NonNegative j) = prop_SaplingReceiver s c (NonNegative i) (NonNegative j) =
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c j) =/= genSaplingPaymentAddress
i
(fromMaybe (SaplingSpendingKey "") $ genSaplingSpendingKey s c j) =/=
Nothing Nothing
prop_SaplingRecRepeated :: Seed -> CoinType -> NonNegative Int -> Property prop_SaplingRecRepeated :: Seed -> CoinType -> NonNegative Int -> Property
prop_SaplingRecRepeated s c (NonNegative i) = prop_SaplingRecRepeated s c (NonNegative i) =
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c 1) =/= genSaplingPaymentAddress
genSaplingPaymentAddress (i + 1) (fromMaybe "" $ genSaplingSpendingKey s c 1) i
(fromMaybe (SaplingSpendingKey "") $ genSaplingSpendingKey s c 1) =/=
genSaplingPaymentAddress
(i + 1)
(fromMaybe (SaplingSpendingKey "") $ genSaplingSpendingKey s c 1)
prop_OrchardRecRepeated :: prop_OrchardRecRepeated ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Scope -> Property
prop_OrchardRecRepeated s c (NonNegative i) (NonNegative j) = prop_OrchardRecRepeated s c (NonNegative i) (NonNegative j) scope =
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= genOrchardReceiver
genOrchardReceiver (j + 1) (fromMaybe "" $ genOrchardSpendingKey s c i) j
scope
(fromMaybe (OrchardSpendingKey "") $ genOrchardSpendingKey s c i) =/=
genOrchardReceiver
(j + 1)
scope
(fromMaybe (OrchardSpendingKey "") $ genOrchardSpendingKey s c i)
prop_TransparentSpendingKey :: Seed -> NonNegative Int -> Property prop_TransparentSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
prop_TransparentSpendingKey s (NonNegative i) = prop_TransparentSpendingKey s coinType (NonNegative i) =
ioProperty $ do ioProperty $ do
k <- genTransparentPrvKey s MainNetCoin 0 k <- genTransparentPrvKey s coinType i
return $ xPrvChild k == fromIntegral i return $ xPrvChild k == fromIntegral i
prop_TransparentReceiver :: prop_TransparentReceiver ::
Seed -> NonNegative Int -> NonNegative Int -> Property Seed -> CoinType -> Scope -> NonNegative Int -> NonNegative Int -> Property
prop_TransparentReceiver s (NonNegative i) (NonNegative j) = prop_TransparentReceiver s coinType scope (NonNegative i) (NonNegative j) =
ioProperty $ do ioProperty $ do
k <- genTransparentPrvKey s MainCoinNet i k <- genTransparentPrvKey s coinType i
r <- genTransparentReceiver j k r <- genTransparentReceiver j scope k
return $ ta_type r == P2PKH return $ ta_type r == P2PKH
-- | Generators -- | Generators
@ -913,3 +862,6 @@ getSeed = do
-- | Arbitrary instances -- | Arbitrary instances
instance Arbitrary CoinType where instance Arbitrary CoinType where
arbitrary = elements [MainNetCoin, TestNetCoin, RegTestNetCoin] arbitrary = elements [MainNetCoin, TestNetCoin, RegTestNetCoin]
instance Arbitrary Scope where
arbitrary = elements [External, Internal]

View file

@ -5,7 +5,7 @@ cabal-version: 3.0
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: zcash-haskell name: zcash-haskell
version: 0.4.4.2 version: 0.5.1.0
synopsis: Utilities to interact with the Zcash blockchain synopsis: Utilities to interact with the Zcash blockchain
description: Please see the README on the repo at <https://git.vergara.tech/Vergara_Tech/zcash-haskell#readme> description: Please see the README on the repo at <https://git.vergara.tech/Vergara_Tech/zcash-haskell#readme>
category: Blockchain category: Blockchain
@ -53,6 +53,7 @@ library
, generics-sop , generics-sop
, hexstring >=0.12.1 , hexstring >=0.12.1
, http-conduit , http-conduit
, http-client
, memory , memory
, text , text
, haskoin-core , haskoin-core