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_len: usize,
add_id: u32,
scope: bool,
out: *mut u8,
out_len: &mut usize
){
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 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);
}

View file

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

View file

@ -21,7 +21,7 @@ import Foreign.Rust.Marshall.Variable
( withBorshVarBuffer
, 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.
generateWalletSeedPhrase :: IO Phrase
@ -30,7 +30,7 @@ generateWalletSeedPhrase = withBorshVarBuffer rustWrapperGenSeedPhrase
-- | Derive a cryptographic seed from the given seed phrase.
getWalletSeed :: Phrase -> Maybe Seed
getWalletSeed p =
if BS.length result > 0
if BS.length (getBytes result) > 0
then Just result
else Nothing
where

View file

@ -41,25 +41,29 @@ genOrchardSpendingKey ::
genOrchardSpendingKey s coinType accountId =
if BS.length k /= 32
then Nothing
else Just k
else Just $ OrchardSpendingKey k
where
k =
withPureBorshVarBuffer $
rustWrapperGenOrchardSpendKey
s
(getBytes s)
(getValue coinType)
(fromIntegral accountId)
-- | Derives an Orchard receiver for the given spending key and index
genOrchardReceiver :: Int -> OrchardSpendingKey -> Maybe OrchardReceiver
genOrchardReceiver i osk =
genOrchardReceiver ::
Int -> Scope -> OrchardSpendingKey -> Maybe OrchardReceiver
genOrchardReceiver i scope osk =
if BS.length k /= 43
then Nothing
else Just k
else Just $ OrchardReceiver k
where
k =
withPureBorshVarBuffer $
rustWrapperGenOrchardReceiver osk (fromIntegral i)
rustWrapperGenOrchardReceiver
(getBytes osk)
(fromIntegral i)
(scope == External)
-- | Checks if given bytestring is a valid encoded unified address
isValidUnifiedAddress :: BS.ByteString -> Maybe UnifiedAddress
@ -78,10 +82,10 @@ isValidUnifiedAddress str =
UnifiedAddress
whichNet
(if BS.length (raw_o x) == 43
then Just (raw_o x)
then Just $ OrchardReceiver (raw_o x)
else Nothing)
(if BS.length (raw_s x) == 43
then Just (raw_s x)
then Just $ SaplingReceiver (raw_s x)
else Nothing)
(if not (BS.null (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
P2SH -> packReceiver 0x01 $ Just $ toBytes $ ta_bytes t
P2PKH -> packReceiver 0x00 $ Just $ toBytes $ ta_bytes t
sReceiver = packReceiver 0x02 $ s_rec ua
oReceiver = packReceiver 0x03 $ o_rec ua
sReceiver = packReceiver 0x02 $ getBytes <$> s_rec ua
oReceiver = packReceiver 0x03 $ getBytes <$> o_rec ua
padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr
packReceiver :: Word8 -> Maybe BS.ByteString -> BS.ByteString
packReceiver typeCode receiver' =

View file

@ -40,11 +40,11 @@ import ZcashHaskell.Types
, DecodedNote(..)
, RawData(..)
, RawTxResponse(..)
, SaplingInternalReceiver
, SaplingReceiver
, SaplingReceiver(..)
, SaplingSpendingKey(..)
, Seed(..)
, ShieldedOutput(..)
, ToBytes(..)
, decodeHexText
, getValue
)
@ -99,13 +99,13 @@ instance FromJSON RawTxResponse where
genSaplingSpendingKey :: Seed -> CoinType -> Int -> Maybe SaplingSpendingKey
genSaplingSpendingKey seed c i = do
if BS.length res == 169
then Just res
then Just $ SaplingSpendingKey res
else Nothing
where
res =
withPureBorshVarBuffer
(rustWrapperSaplingSpendingkey
seed
(getBytes seed)
(fromIntegral $ getValue c)
(fromIntegral i))
@ -113,13 +113,15 @@ genSaplingSpendingKey seed c i = do
genSaplingPaymentAddress :: Int -> SaplingSpendingKey -> Maybe SaplingReceiver
genSaplingPaymentAddress i extspk =
if BS.length res == 43
then Just res
then Just $ SaplingReceiver res
else Nothing
where
res =
withPureBorshVarBuffer
(rustWrapperSaplingPaymentAddress extspk (fromIntegral (i * 111)))
(rustWrapperSaplingPaymentAddress
(getBytes extspk)
(fromIntegral (i * 111)))
-- | Generate an internal Sapling address
genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingInternalReceiver
genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingReceiver
genSaplingInternalAddress sk = undefined

View file

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

View file

@ -15,6 +15,7 @@
--
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE UndecidableInstances #-}
@ -41,10 +42,32 @@ import Haskoin.Address (Address)
-- * General
--
-- | 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
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
data RawData = RawData
@ -241,13 +264,20 @@ data TransparentAddress = TransparentAddress
-- * 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
type SaplingReceiver = BS.ByteString
newtype SaplingReceiver =
SaplingReceiver BS.ByteString
deriving stock (Eq, Prelude.Show, Read)
-- | A Sapling internal receiver
type SaplingInternalReceiver = BS.ByteString
instance ToBytes SaplingReceiver where
getBytes (SaplingReceiver s) = s
-- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@.
data ShieldedOutput = ShieldedOutput
@ -275,10 +305,20 @@ instance FromJSON ShieldedOutput where
-- * 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
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
data UnifiedAddress = UnifiedAddress
@ -349,6 +389,11 @@ data DecodedNote = DecodedNote
deriving anyclass (Data.Structured.Show)
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
-- | Helper function to turn a hex-encoded string to bytestring
decodeHexText :: String -> BS.ByteString

View file

@ -57,11 +57,15 @@ import ZcashHaskell.Types
, CoinType
, DecodedNote(..)
, OrchardAction(..)
, OrchardSpendingKey(..)
, Phrase(..)
, RawData(..)
, RawTxResponse(..)
, SaplingSpendingKey(..)
, Scope(..)
, Seed(..)
, ShieldedOutput(..)
, ToBytes(..)
, TransparentAddress(..)
, TransparentType(..)
, UnifiedAddress(..)
@ -314,7 +318,7 @@ main = do
describe "Seeds" $ do
it "generate seed phrase" $ do
s <- generateWalletSeedPhrase
BS.length s `shouldNotBe` 0
BS.length (getBytes s) `shouldNotBe` 0
it "get seed from phrase" $ do
s <- generateWalletSeedPhrase
let x = getWalletSeed s
@ -468,11 +472,11 @@ main = do
let msg = maybe "" a_memo decryptedNote2
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"
describe "Wallet seed phrase" $ do
describe "Wallet seed phrase:" $ do
prop "Generated phrases are valid" $ again prop_PhraseLength
prop "Derived seeds are valid" $ again prop_SeedLength
before getSeed $
describe "Optimized spending key tests" $ do
describe "Optimized spending key tests:" $ do
it "Transparent spending keys are valid" $ \s ->
property $ prop_TransparentSpendingKey s
it "Transparent receivers are valid" $ \s ->
@ -489,7 +493,7 @@ main = do
property $ prop_OrchardReceiver s
it "Orchard receivers are distinct" $ \s ->
property $ prop_OrchardRecRepeated s
describe "Address tests" $ do
describe "Address tests:" $ do
it "Encode transparent" $ do
let ua =
"u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
@ -500,9 +504,10 @@ main = do
maybe "No transparent" (encodeTransparent (ua_net u)) $
t_rec u
msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD"
it "Recover UA from YWallet" $
it "Recover UA from YWallet:" $
ioProperty $ do
let p =
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 =
isValidUnifiedAddress
@ -514,14 +519,15 @@ main = do
let oK = genOrchardSpendingKey s' MainNetCoin 0
let sK = genSaplingSpendingKey s' MainNetCoin 0
let tK = genTransparentPrvKey s' 0
let oR = genOrchardReceiver 0 =<< oK
let oR = genOrchardReceiver 0 External =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver 0 =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR
return $ Just newUA `shouldBe` targetUA
it "Recover UA from Zingo" $
it "Recover UA from Zingo:" $
ioProperty $ do
let p =
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 =
isValidUnifiedAddress
@ -533,7 +539,7 @@ main = do
let oK = genOrchardSpendingKey s' MainNetCoin 0
let sK = genSaplingSpendingKey s' MainNetCoin 0
let tK = genTransparentPrvKey s' 0
let oR = genOrchardReceiver 0 =<< oK
let oR = genOrchardReceiver 0 External =<< oK
let sR = genSaplingPaymentAddress 0 =<< sK
tR <- genTransparentReceiver 0 =<< tK
let newUA = UnifiedAddress MainNet oR sR $ Just tR
@ -544,23 +550,27 @@ prop_PhraseLength :: Property
prop_PhraseLength =
ioProperty $ do
p <- generateWalletSeedPhrase
return $ BS.length p >= 95
return $ BS.length (getBytes p) >= 95
prop_SeedLength :: Property
prop_SeedLength =
ioProperty $ do
p <- generateWalletSeedPhrase
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 s c (NonNegative i) =
genOrchardSpendingKey s c i =/= Nothing
prop_OrchardReceiver ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
prop_OrchardReceiver s c (NonNegative i) (NonNegative j) =
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/= Nothing
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Scope -> Property
prop_OrchardReceiver s c (NonNegative i) (NonNegative j) scope =
genOrchardReceiver
j
scope
(fromMaybe (OrchardSpendingKey "") $ genOrchardSpendingKey s c i) =/=
Nothing
prop_SaplingSpendingKey :: Seed -> CoinType -> NonNegative Int -> Property
prop_SaplingSpendingKey s c (NonNegative i) =
@ -569,19 +579,31 @@ prop_SaplingSpendingKey s c (NonNegative i) =
prop_SaplingReceiver ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
prop_SaplingReceiver s c (NonNegative i) (NonNegative j) =
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c j) =/=
genSaplingPaymentAddress
i
(fromMaybe (SaplingSpendingKey "") $ genSaplingSpendingKey s c j) =/=
Nothing
prop_SaplingRecRepeated :: Seed -> CoinType -> NonNegative Int -> Property
prop_SaplingRecRepeated s c (NonNegative i) =
genSaplingPaymentAddress i (fromMaybe "" $ genSaplingSpendingKey s c 1) =/=
genSaplingPaymentAddress (i + 1) (fromMaybe "" $ genSaplingSpendingKey s c 1)
genSaplingPaymentAddress
i
(fromMaybe (SaplingSpendingKey "") $ genSaplingSpendingKey s c 1) =/=
genSaplingPaymentAddress
(i + 1)
(fromMaybe (SaplingSpendingKey "") $ genSaplingSpendingKey s c 1)
prop_OrchardRecRepeated ::
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Property
prop_OrchardRecRepeated s c (NonNegative i) (NonNegative j) =
genOrchardReceiver j (fromMaybe "" $ genOrchardSpendingKey s c i) =/=
genOrchardReceiver (j + 1) (fromMaybe "" $ genOrchardSpendingKey s c i)
Seed -> CoinType -> NonNegative Int -> NonNegative Int -> Scope -> Property
prop_OrchardRecRepeated s c (NonNegative i) (NonNegative j) scope =
genOrchardReceiver
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 s (NonNegative i) =
@ -619,3 +641,6 @@ getSeed = do
-- | Arbitrary instances
instance Arbitrary CoinType where
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
name: zcash-haskell
version: 0.4.4.2
version: 0.5.0.0
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>
category: Blockchain