Type safety improvements #33

Merged
pitmutt merged 5 commits from rav001 into dev040 2024-03-14 17:42:18 +00:00
9 changed files with 135 additions and 53 deletions

View file

@ -702,13 +702,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

@ -163,6 +163,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

@ -41,25 +41,29 @@ genOrchardSpendingKey ::
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 -> Scope -> OrchardSpendingKey -> 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 +82,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 +109,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

@ -40,11 +40,11 @@ import ZcashHaskell.Types
, DecodedNote(..) , DecodedNote(..)
, RawData(..) , RawData(..)
, RawTxResponse(..) , RawTxResponse(..)
, SaplingInternalReceiver , SaplingReceiver(..)
, SaplingReceiver
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Seed(..) , Seed(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, ToBytes(..)
, decodeHexText , decodeHexText
, getValue , getValue
) )
@ -99,13 +99,13 @@ instance FromJSON RawTxResponse where
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))
@ -113,13 +113,15 @@ 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 = undefined genSaplingInternalAddress sk = undefined

View file

@ -24,7 +24,8 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import ZcashHaskell.Types import ZcashHaskell.Types
( AccountId ( AccountId
, Seed , Seed(..)
, ToBytes(..)
, TransparentAddress(..) , TransparentAddress(..)
, TransparentType(..) , TransparentType(..)
, ZcashNet(..) , ZcashNet(..)
@ -55,7 +56,7 @@ encodeTransparent zNet t =
-- | Attempts to generate an Extended Private Key from a known HDSeed. -- | Attempts to generate an Extended Private Key from a known HDSeed.
genTransparentPrvKey :: Seed -> AccountId -> IO XPrvKey genTransparentPrvKey :: Seed -> AccountId -> IO XPrvKey
genTransparentPrvKey hdseed i = do genTransparentPrvKey hdseed i = do
let prvKey = makeXPrvKey hdseed let prvKey = makeXPrvKey $ getBytes hdseed
ioCtx <- createContext ioCtx <- createContext
return $ hardSubKey ioCtx prvKey (fromIntegral i) return $ hardSubKey ioCtx prvKey (fromIntegral i)

View file

@ -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 #-}
@ -41,10 +42,32 @@ import Haskoin.Address (Address)
-- * General -- * General
-- --
-- | A seed for generating private keys -- | A seed for generating private keys
type Seed = C.ByteString newtype Seed =
Seed C.ByteString
deriving stock (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 BS.ByteString
deriving stock (Prelude.Show, GHC.Generic)
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
| Internal
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
@ -241,13 +264,20 @@ 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 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 +305,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 +389,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

@ -57,11 +57,15 @@ import ZcashHaskell.Types
, CoinType , CoinType
, DecodedNote(..) , DecodedNote(..)
, OrchardAction(..) , OrchardAction(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, RawData(..) , RawData(..)
, RawTxResponse(..) , RawTxResponse(..)
, SaplingSpendingKey(..)
, Scope(..)
, Seed(..) , Seed(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, ToBytes(..)
, TransparentAddress(..) , TransparentAddress(..)
, TransparentType(..) , TransparentType(..)
, UnifiedAddress(..) , UnifiedAddress(..)
@ -314,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
@ -468,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 ->
@ -489,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"
@ -500,10 +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"
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"
@ -514,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' 0 let tK = genTransparentPrvKey s' 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 =<< 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"
@ -533,7 +539,7 @@ 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' 0 let tK = genTransparentPrvKey s' 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 =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR let newUA = UnifiedAddress MainNet oR sR $ Just tR
@ -544,23 +550,27 @@ 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) =
@ -569,19 +579,31 @@ 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 -> NonNegative Int -> Property
prop_TransparentSpendingKey s (NonNegative i) = prop_TransparentSpendingKey s (NonNegative i) =
@ -619,3 +641,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.0.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