diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 39df18b2ffa..e0f8c7ccc08 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -64,6 +64,8 @@ library Cardano.ChainProducer.RustHttpBridge.Client Cardano.ChainProducer.RustHttpBridge.NetworkLayer Cardano.Wallet + Cardano.Wallet.AddressDerivation + Cardano.Wallet.AddressDiscovery Cardano.Wallet.Binary Cardano.Wallet.Binary.Packfile Cardano.Wallet.BlockSyncer @@ -135,14 +137,14 @@ test-suite unit , containers , deepseq , exceptions + , fmt , hspec - , hspec-expectations , memory , mtl + , QuickCheck , text , time-units , transformers - , QuickCheck type: exitcode-stdio-1.0 hs-source-dirs: @@ -150,12 +152,14 @@ test-suite unit main-is: Main.hs other-modules: - Cardano.WalletSpec - Cardano.Wallet.BinarySpec Cardano.ChainProducer.RustHttpBridge.MockNetworkLayer Cardano.ChainProducer.RustHttpBridgeSpec + Cardano.Wallet.AddressDerivationSpec + Cardano.Wallet.AddressDiscoverySpec Cardano.Wallet.Binary.PackfileSpec + Cardano.Wallet.BinarySpec Cardano.Wallet.BlockSyncerSpec Cardano.Wallet.MnemonicSpec Cardano.Wallet.PrimitiveSpec Cardano.Wallet.SlottingSpec + Cardano.WalletSpec diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index 71555af1e91..db1c0df5812 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -34,7 +34,6 @@ module Cardano.Wallet , availableUTxO -- * Helpers - , invariant , txOutsOurs , utxoFromTx ) where @@ -53,6 +52,7 @@ import Cardano.Wallet.Primitive , UTxO (..) , balance , excluding + , invariant , restrictedBy , restrictedTo , txIns @@ -163,21 +163,6 @@ totalUTxO wallet@(Wallet _ pending s) = -- * Helpers --- | Check whether an invariants holds or not. --- --- >>> invariant "not empty" [1,2,3] (not . null) --- [1, 2, 3] --- --- >>> invariant "not empty" [] (not . null) --- *** Exception: not empty -invariant - :: String -- ^ A title / message to throw in case of violation - -> a - -> (a -> Bool) - -> a -invariant msg a predicate = - if predicate a then a else error msg - -- | Return all transaction outputs that are ours. This plays well within a -- 'State' monad. -- diff --git a/src/Cardano/Wallet/AddressDerivation.hs b/src/Cardano/Wallet/AddressDerivation.hs new file mode 100644 index 00000000000..6cad3131698 --- /dev/null +++ b/src/Cardano/Wallet/AddressDerivation.hs @@ -0,0 +1,311 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- Primitives for performing address derivation for some given schemes. This is +-- where most of the crypto happens in the wallet and, it is quite important to +-- ensure that the following implementation matches with other wallet softwares +-- (like Yoroi/Icarus or the cardano-cli) + +module Cardano.Wallet.AddressDerivation + ( + -- * Polymorphic / General Purpose Types + Key + , Depth (..) + , Index + , getIndex + , DerivationType (..) + , Passphrase(..) + , publicKey + , XPub + , XPrv + + -- * Sequential Derivation + , ChangeChain(..) + , generateKeyFromSeed + , unsafeGenerateKeyFromSeed + , deriveAccountPrivateKey + , deriveAddressPrivateKey + , deriveAddressPublicKey + , keyToAddress + ) where + +import Prelude + +import Cardano.Crypto.Wallet + ( DerivationScheme (..) + , XPrv + , XPub + , deriveXPrv + , deriveXPub + , generateNew + , toXPub + ) +import Cardano.Wallet.Binary + ( encodeAddress ) +import Cardano.Wallet.Primitive + ( Address (..) ) +import Control.DeepSeq + ( NFData ) +import Data.ByteArray + ( ScrubbedBytes ) +import Data.ByteString + ( ByteString ) +import Data.Maybe + ( fromMaybe ) +import Data.Word + ( Word32 ) +import GHC.Generics + ( Generic ) +import GHC.TypeLits + ( Symbol ) + +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Write as CBOR + + +{------------------------------------------------------------------------------- + Polymorphic / General Purpose Types +-------------------------------------------------------------------------------} + +-- | A cryptographic key, with phantom-types to disambiguate key types. +-- +-- @ +-- let rootPrivateKey = Key 'RootK XPrv +-- let accountPubKey = Key 'AccountK XPub +-- let addressPubKey = Key 'AddressK XPub +-- @ +newtype Key (level :: Depth) key = Key key + deriving stock (Generic, Show, Eq) + +instance (NFData key) => NFData (Key level key) + + +-- | Key Depth in the derivation path, according to BIP-0039 / BIP-0044 +-- +-- root' / purpose' / cointype' / account' / change / address +-- +-- We do not manipulate purpose, cointype and change paths directly, so they are +-- left out of the sum type. +data Depth = RootK | AccountK | AddressK + +-- | A derivation index, with phantom-types to disambiguate derivation type. +-- +-- @ +-- let accountIx = Index 'Hardened 'AccountK +-- let addressIx = Index 'Soft 'AddressK +-- @ +newtype Index (derivationType :: DerivationType) (level :: Depth) = Index + { getIndex :: Word32 } + deriving stock (Generic, Show, Eq, Ord) + +instance NFData (Index derivationType level) + +instance Bounded (Index 'Hardened level) where + minBound = Index 0x80000000 + maxBound = Index maxBound + +instance Bounded (Index 'Soft level) where + minBound = Index minBound + maxBound = let (Index ix) = minBound @(Index 'Hardened _) in Index (ix - 1) + +instance Enum (Index 'Hardened level) where + fromEnum (Index ix) = fromIntegral ix + toEnum ix + | Index (fromIntegral ix) < minBound @(Index 'Hardened _) = + error "Index@Hardened.toEnum: bad argument" + | otherwise = + Index (fromIntegral ix) + +instance Enum (Index 'Soft level) where + fromEnum (Index ix) = fromIntegral ix + toEnum ix + | Index (fromIntegral ix) > maxBound @(Index 'Soft _) = + error "Index@Soft.toEnum: bad argument" + | otherwise = + Index (fromIntegral ix) + + +-- | Type of derivation that should be used with the given indexes. +data DerivationType = Hardened | Soft + +-- | An encapsulated passphrase. The inner format is free, but the wrapper helps +-- readability in function signatures. +newtype Passphrase (goal :: Symbol) = Passphrase ScrubbedBytes + deriving stock (Show) + deriving newtype (Semigroup, Monoid) + +-- | Extract the public key part of a private key. +publicKey + :: Key level XPrv + -> Key level XPub +publicKey (Key xprv) = + Key (toXPub xprv) + + +{------------------------------------------------------------------------------- + Sequential Derivation +-------------------------------------------------------------------------------} + +-- | Marker for the change chain. In practice, change of a transaction goes onto +-- the addresses generated on the internal chain, whereas the external chain is +-- used for addresses that are part of the 'advertised' targets of a transaction +data ChangeChain + = InternalChain + | ExternalChain + deriving (Generic, Show, Eq) + +instance NFData ChangeChain + +-- Not deriving 'Enum' because this could have a dramatic impact if we were +-- to assign the wrong index to the corresponding constructor (by swapping +-- around the constructor above for instance). +instance Enum ChangeChain where + toEnum = \case + 0 -> ExternalChain + 1 -> InternalChain + _ -> error "ChangeChain.toEnum: bad argument" + fromEnum = \case + ExternalChain -> 0 + InternalChain -> 1 + +-- | Purpose is a constant set to 44' (or 0x8000002C) following the BIP-44 +-- recommendation. It indicates that the subtree of this node is used +-- according to this specification. +-- +-- Hardened derivation is used at this level. +purposeIndex :: Word32 +purposeIndex = 0x8000002C + +-- | One master node (seed) can be used for unlimited number of independent +-- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the +-- same space for various cryptocoins has some disadvantages. +-- +-- This level creates a separate subtree for every cryptocoin, avoiding reusing +-- addresses across cryptocoins and improving privacy issues. +-- +-- Coin type is a constant, set for each cryptocoin. For Cardano this constant +-- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada +-- Lovelace. +-- +-- Hardened derivation is used at this level. +coinTypeIndex :: Word32 +coinTypeIndex = 0x80000717 + +-- | Generate a new key from seed. Note that the @depth@ is left open so that +-- the caller gets to decide what type of key this is. This is mostly for +-- testing, in practice, seeds are used to represent root keys, and one should +-- use 'generateKeyFromSeed'. +unsafeGenerateKeyFromSeed + :: (ByteString, Passphrase "generation") + -- ^ The actual seed and its recovery / generation passphrase + -> Passphrase "encryption" + -> Key depth XPrv +unsafeGenerateKeyFromSeed (seed, Passphrase recPwd) (Passphrase encPwd) = + Key $ generateNew seed recPwd encPwd + +-- | Generate a root key from a corresponding seed +generateKeyFromSeed + :: (ByteString, Passphrase "generation") + -- ^ The actual seed and its recovery / generation passphrase + -> Passphrase "encryption" + -> Key 'RootK XPrv +generateKeyFromSeed = unsafeGenerateKeyFromSeed + +-- | Derives account private key from the given root private key, using +-- derivation scheme 2 (see +-- package for more details). +-- +-- NOTE: The caller is expected to provide the corresponding passphrase (and to +-- have checked that the passphrase is valid). Providing a wrong passphrase will +-- not make the function fail but will instead, yield an incorrect new key that +-- doesn't belong to the wallet. +deriveAccountPrivateKey + :: Passphrase "encryption" + -> Key 'RootK XPrv + -> Index 'Hardened 'AccountK + -> Key 'AccountK XPrv +deriveAccountPrivateKey (Passphrase pwd) (Key rootXPrv) (Index accIx) = + let + purposeXPrv = -- lvl1 derivation; hardened derivation of purpose' + deriveXPrv DerivationScheme2 pwd rootXPrv purposeIndex + coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type' + deriveXPrv DerivationScheme2 pwd purposeXPrv coinTypeIndex + acctXPrv = -- lvl3 derivation; hardened derivation of account' index + deriveXPrv DerivationScheme2 pwd coinTypeXPrv accIx + in + Key acctXPrv + +-- | Derives address private key from the given account private key, using +-- derivation scheme 2 (see +-- package for more details). +-- +-- It is preferred to use 'deriveAddressPublicKey' whenever possible to avoid +-- having to manipulate passphrases and private keys. +-- +-- NOTE: The caller is expected to provide the corresponding passphrase (and to +-- have checked that the passphrase is valid). Providing a wrong passphrase will +-- not make the function fail but will instead, yield an incorrect new key that +-- doesn't belong to the wallet. +deriveAddressPrivateKey + :: Passphrase "encryption" + -> Key 'AccountK XPrv + -> ChangeChain + -> Index 'Soft 'AddressK + -> Key 'AddressK XPrv +deriveAddressPrivateKey (Passphrase pwd) (Key accXPrv) changeChain (Index addrIx) = + let + changeCode = + fromIntegral $ fromEnum changeChain + changeXPrv = -- lvl4 derivation; soft derivation of change chain + deriveXPrv DerivationScheme2 pwd accXPrv changeCode + addrXPrv = -- lvl5 derivation; soft derivation of address index + deriveXPrv DerivationScheme2 pwd changeXPrv addrIx + in + Key addrXPrv + +-- | Derives address public key from the given account public key, using +-- derivation scheme 2 (see +-- package for more details). +-- +-- This is the preferred way of deriving new sequential address public keys. +deriveAddressPublicKey + :: Key 'AccountK XPub + -> ChangeChain + -> Index 'Soft 'AddressK + -> Key 'AddressK XPub +deriveAddressPublicKey (Key accXPub) changeChain (Index addrIx) = + fromMaybe errWrongIndex $ do + let changeCode = fromIntegral $ fromEnum changeChain + changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain + deriveXPub DerivationScheme2 accXPub changeCode + addrXPub <- -- lvl5 derivation in bip44 is derivation of address chain + deriveXPub DerivationScheme2 changeXPub addrIx + return $ Key addrXPub + where + errWrongIndex = error $ + "Cardano.Wallet.AddressDerivation.deriveAddressPublicKey failed: \ + \was given an hardened (or too big) index for soft path derivation \ + \( " ++ show addrIx ++ "). This is either a programmer error, or, \ + \we may have reached the maximum number of addresses for a given \ + \wallet." + +-- | Encode a public key to a (Byron / Legacy) Cardano 'Address'. This is mostly +-- dubious CBOR serializations with no data attributes. +keyToAddress + :: Key 'AddressK XPub + -> Address +keyToAddress (Key xpub) = + Address $ CBOR.toStrictByteString $ encodeAddress xpub encodeAttributes + where + encodeAttributes = CBOR.encodeMapLen 0 diff --git a/src/Cardano/Wallet/AddressDiscovery.hs b/src/Cardano/Wallet/AddressDiscovery.hs new file mode 100644 index 00000000000..a2b541a713b --- /dev/null +++ b/src/Cardano/Wallet/AddressDiscovery.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- This module contains primitives necessary to perform address discovery. So +-- far, we're only interested in address following a sequential derivation +-- scheme as specified in BIP-0044. +-- Later, we may introduce backward-compatibility with random address scheme +-- from the legacy Cardano wallets. + +module Cardano.Wallet.AddressDiscovery + ( -- * Sequential Derivation + + -- ** Address Pool Gap + AddressPoolGap + , MkAddressPoolGapError (..) + , defaultAddressPoolGap + , mkAddressPoolGap + + -- ** Address Pool + , AddressPool + , gap + , addresses + , changeChain + , accountPubKey + , mkAddressPool + , lookupAddress + ) where + +import Prelude + +import Cardano.Crypto.Wallet + ( XPub ) +import Cardano.Wallet.AddressDerivation + ( ChangeChain (..) + , Depth (..) + , DerivationType (..) + , Index + , Key + , deriveAddressPublicKey + , keyToAddress + ) +import Cardano.Wallet.Primitive + ( Address, invariant ) +import Control.DeepSeq + ( NFData ) +import Data.Function + ( (&) ) +import Data.List + ( sortOn ) +import Data.Map.Strict + ( Map ) +import Data.Word + ( Word8 ) +import GHC.Generics + ( Generic ) + +import qualified Data.Map.Strict as Map + + +{------------------------------------------------------------------------------- + Sequential Derivation + + Discovery of addresses in the sequential derivation as specified by BIP-44. + The management of _accounts_ is left-out for this implementation focuses on + a single account. In practice, one wants to manage a set of pools, one per + account. + +-------------------------------------------------------------------------------} + +-- ** Address Pool Gap + +-- | Maximum number of consecutive undiscovered addresses allowed +newtype AddressPoolGap = AddressPoolGap + { getAddressPoolGap :: Word8 } + deriving stock (Generic, Show, Eq, Ord) + +instance NFData AddressPoolGap + +instance Bounded AddressPoolGap where + minBound = AddressPoolGap 10 + maxBound = AddressPoolGap 100 + +instance Enum AddressPoolGap where + fromEnum (AddressPoolGap g) = fromEnum g + toEnum g + | AddressPoolGap (toEnum g) < minBound @AddressPoolGap = + error "AddressPoolGap.toEnum: bad argument" + | AddressPoolGap (toEnum g) > maxBound @AddressPoolGap = + error "AddressPoolGap.toEnum: bad argument" + | otherwise = + AddressPoolGap (toEnum g) + +-- | Smart constructor for 'AddressPoolGap' +mkAddressPoolGap :: Word8 -> Either MkAddressPoolGapError AddressPoolGap +mkAddressPoolGap !g + | g >= getAddressPoolGap minBound && + g <= getAddressPoolGap maxBound = Right $ AddressPoolGap g + | otherwise = Left $ ErrGapOutOfRange g + +-- | Possible errors when casting to an 'AddressPoolGap' +newtype MkAddressPoolGapError = ErrGapOutOfRange Word8 + deriving (Eq, Show) + +-- | A default 'AddressPoolGap', as suggested in BIP-0044 +defaultAddressPoolGap :: AddressPoolGap +defaultAddressPoolGap = + AddressPoolGap 20 + + +-- ** Address Pool + +-- | An 'AddressPool' which keeps track of sequential addresses within a given +-- Account and change chain. See 'mkAddressPool' to create a new or existing +-- pool: +-- +-- >>> mkAddressPool xpub gap changeChain mempty +-- AddressPool { } +data AddressPool = AddressPool + { accountPubKey + :: !(Key 'AccountK XPub) + -- ^ Corresponding key for the pool (a pool is tied to only one account) + , gap + :: !AddressPoolGap + -- ^ The actual gap for the pool. This can't change for a given pool. + , changeChain + :: !ChangeChain + -- ^ Whether this pool tracks addrs on the internal or external chain + , indexedAddresses + :: !(Map Address (Index 'Soft 'AddressK)) + } deriving (Generic, Show, Eq) + +instance NFData AddressPool + +-- | Get all addresses in the pool, sorted from the first address discovered, +-- up until the next one. +-- +-- In practice, we always have: +-- +-- > mkAddressPool key g cc (addresses pool) == pool +addresses :: AddressPool -> [Address] +addresses = map fst . sortOn snd . Map.toList . indexedAddresses + +-- | Create a new Address pool from a list of addresses. Note that, the list is +-- expected to be ordered in sequence (first indexes, first in the list). +-- +-- The pool will grow from the start if less than @g :: AddressPoolGap@ are +-- given, such that, there are always @g@ undiscovered addresses in the pool. +mkAddressPool + :: Key 'AccountK XPub + -> AddressPoolGap + -> ChangeChain + -> [Address] + -> AddressPool +mkAddressPool key g cc addrs = AddressPool + { accountPubKey = key + , gap = g + , changeChain = cc + , indexedAddresses = nextAddresses key g cc minBound <> + Map.fromList (zip addrs [minBound..maxBound]) + } + + +-- | Lookup an address in the pool. When we find an address in a pool, the pool +-- may be amended if the address was discovered near the edge. It is also +-- possible that the pool is not amended at all - this happens in the case that +-- an address is discovered 'far' from the edge. +lookupAddress + :: Address + -> AddressPool + -> (Maybe (Index 'Soft 'AddressK), AddressPool) +lookupAddress !target !pool = + case Map.lookup target (indexedAddresses pool) of + Just ix -> + (Just ix, extendAddressPool ix pool) + Nothing -> + (Nothing, pool) + +-- | If an address is discovered near the edge, we extend the address sequence, +-- otherwise we return the pool untouched. +extendAddressPool + :: Index 'Soft 'AddressK + -> AddressPool + -> AddressPool +extendAddressPool !ix !pool + | isOnEdge = pool { indexedAddresses = indexedAddresses pool <> next } + | otherwise = pool + where + edge = Map.size (indexedAddresses pool) + isOnEdge = edge - fromEnum ix <= fromEnum (gap pool) + next = if ix == maxBound then mempty else nextAddresses + (accountPubKey pool) + (gap pool) + (changeChain pool) + (succ ix) + +-- | Compute the pool extension from a starting index +nextAddresses + :: Key 'AccountK XPub + -> AddressPoolGap + -> ChangeChain + -> Index 'Soft 'AddressK + -> Map Address (Index 'Soft 'AddressK) +nextAddresses !key (AddressPoolGap !g) !cc !fromIx = + [fromIx .. min maxBound toIx] + & map (\ix -> (newAddress ix, ix)) + & Map.fromList + where + toIx = invariant + "nextAddresses: toIx should be greater than fromIx" + (toEnum $ fromEnum fromIx + fromEnum g - 1) + (>= fromIx) + newAddress = keyToAddress . deriveAddressPublicKey key cc diff --git a/src/Cardano/Wallet/Binary.hs b/src/Cardano/Wallet/Binary.hs index afd75b3bd81..cbe1320a0ee 100644 --- a/src/Cardano/Wallet/Binary.hs +++ b/src/Cardano/Wallet/Binary.hs @@ -25,6 +25,7 @@ module Cardano.Wallet.Binary -- * Encoding , encodeTx + , encodeAddress -- * Hashing , txId @@ -37,6 +38,8 @@ module Cardano.Wallet.Binary import Prelude +import Cardano.Crypto.Wallet + ( ChainCode (..), XPub (..) ) import Cardano.Wallet.Primitive ( Address (..) , Block (..) @@ -54,7 +57,7 @@ import Control.Monad import Crypto.Hash ( hash ) import Crypto.Hash.Algorithms - ( Blake2b_256 ) + ( Blake2b_224, Blake2b_256, SHA3_256 ) import Data.ByteString ( ByteString ) import Data.Digest.CRC32 @@ -438,6 +441,56 @@ decodeUpdateProof = do -- * Encoding +-- | Encode a public key to a corresponding Cardano Address. The encoding of the +-- attributes part of an address is left out to the caller; This allows for +-- distinguishing between Sequential and Random addresses (the former doesn't +-- have any attributes to encode). +-- +-- @ +-- -- Old / Random Addresses +-- let encodeAttributes = mempty +-- <> CBOR.encodeMapLen 1 +-- <> CBOR.encodeWord8 1 +-- <> encodeDerivationPath (hdPassphrase rootXPub) accIx addrIx +-- let addr = encodeAddress xpub encodeAttributes +-- +-- -- New / Sequential Addresses +-- let encodeAttributes = mempty <> CBOR.encodeMapLen 0 +-- let addr = encodeAddress xpub encodeAttributes +-- @ +-- +-- Note that we are passing the behavior to encode attributes as a parameter +-- here and do not handle multiple cases in 'encodeAddress' itself for multiple +-- reasons: +-- +-- - Inversion of control gives us a nicer implementation overall +-- +-- - Encoding attributes for Random addresses requires more context than just +-- the public key (like the wallet root id and some extra logic for encoding +-- passphrases). This is just scheme-specific and is better left out of this +-- particular function +encodeAddress :: XPub -> CBOR.Encoding -> CBOR.Encoding +encodeAddress (XPub pub (ChainCode cc)) encodeAttributes = + encodeAddressPayload payload + where + blake2b224 = hash @_ @Blake2b_224 + sha3256 = hash @_ @SHA3_256 + payload = CBOR.toStrictByteString $ mempty + <> CBOR.encodeListLen 3 + <> CBOR.encodeBytes root + <> encodeAttributes + <> CBOR.encodeWord8 0 -- Address Type, 0 = Public Key + root = BA.convert $ blake2b224 $ sha3256 $ CBOR.toStrictByteString $ mempty + <> CBOR.encodeListLen 3 + <> CBOR.encodeWord8 0 -- Address Type, 0 = Public Key + <> encodeSpendingData + <> encodeAttributes + encodeXPub = + CBOR.encodeBytes (pub <> cc) + encodeSpendingData = CBOR.encodeListLen 2 + <> CBOR.encodeWord8 0 + <> encodeXPub + encodeAddressPayload :: ByteString -> CBOR.Encoding encodeAddressPayload payload = mempty <> CBOR.encodeListLen 2 diff --git a/src/Cardano/Wallet/Primitive.hs b/src/Cardano/Wallet/Primitive.hs index 093fc89260d..0450da9e971 100644 --- a/src/Cardano/Wallet/Primitive.hs +++ b/src/Cardano/Wallet/Primitive.hs @@ -51,6 +51,7 @@ module Cardano.Wallet.Primitive -- * Generic , Hash (..) , ShowFmt (..) + , invariant ) where import Prelude @@ -303,3 +304,19 @@ newtype ShowFmt a = ShowFmt a instance Buildable a => Show (ShowFmt a) where show (ShowFmt a) = fmt (build a) + + +-- | Check whether an invariants holds or not. +-- +-- >>> invariant "not empty" [1,2,3] (not . null) +-- [1, 2, 3] +-- +-- >>> invariant "not empty" [] (not . null) +-- *** Exception: not empty +invariant + :: String -- ^ A title / message to throw in case of violation + -> a + -> (a -> Bool) + -> a +invariant msg a predicate = + if predicate a then a else error msg diff --git a/test/unit/Cardano/Wallet/AddressDerivationSpec.hs b/test/unit/Cardano/Wallet/AddressDerivationSpec.hs new file mode 100644 index 00000000000..524f85ae33a --- /dev/null +++ b/test/unit/Cardano/Wallet/AddressDerivationSpec.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.AddressDerivationSpec + ( spec + ) where + +import Prelude + +import Cardano.Wallet.AddressDerivation + ( ChangeChain (..) + , Depth (..) + , DerivationType (..) + , Index + , Passphrase (..) + , deriveAccountPrivateKey + , deriveAddressPrivateKey + , deriveAddressPublicKey + , generateKeyFromSeed + , getIndex + , keyToAddress + , publicKey + , unsafeGenerateKeyFromSeed + ) +import Data.ByteString + ( ByteString ) +import Fmt + ( build, fmt ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , InfiniteList (..) + , Property + , arbitraryBoundedEnum + , choose + , elements + , expectFailure + , property + , (.&&.) + , (===) + , (==>) + ) + +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS + +spec :: Spec +spec = do + describe "Bounded / Enum relationship" $ do + it "The calls Index.succ maxBound should result in a runtime err (hard)" + prop_succMaxBoundHardIx + it "The calls Index.pred minBound should result in a runtime err (hard)" + prop_predMinBoundHardIx + it "The calls Index.succ maxBound should result in a runtime err (soft)" + prop_succMaxBoundSoftIx + it "The calls Index.pred minBound should result in a runtime err (soft)" + prop_predMinBoundSoftIx + it "Calling toEnum for invalid value gives a runtime err (ChangeChain)" + (property prop_toEnumChangeChain) + + describe "Enum Roundtrip" $ do + it "ChangeChain" (property prop_roundtripEnumChangeChain) + it "Index @'Hardened _" (property prop_roundtripEnumIndexHard) + it "Index @'Soft _" (property prop_roundtripEnumIndexSoft) + + describe "BIP-0044 Derivation Properties" $ do + it "deriveAccountPrivateKey works for various indexes" $ + property prop_accountKeyDerivation + it "N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i)" $ + property prop_publicChildKeyDerivation + + describe "Golden Tests - Yoroi's style addresses" $ do + let seed0 = "4\175\242L\184\243\191 \169]\171 \207\r\v\233\NUL~&\ETB" + let recPwd0 = mempty + it "m/0'/0/0 --> Ae2tdPwUPEZGB...EfoeiuW4MtaXZ" $ do + let (accIx, addrIx) = (toEnum 0x80000000, toEnum 0x00000000) + goldenYoroiAddr (seed0, recPwd0) ExternalChain accIx addrIx + "Ae2tdPwUPEZGQVrA6qKreDzdtYxcWMMrpTFYCpFcuJfhJBEfoeiuW4MtaXZ" + it "m/0'/0/14 --> Ae2tdPwUPEZD...bxbkCyQYyxckP" $ do + let (accIx, addrIx) = (toEnum 0x80000000, toEnum 0x0000000E) + goldenYoroiAddr (seed0, recPwd0) ExternalChain accIx addrIx + "Ae2tdPwUPEZDLWQQEBR1UW7HeXJVaqUnuw8DUFu52TDWCJbxbkCyQYyxckP" + it "m/14'/1/42 --> Ae2tdPwUPEZ...EkxDbkPodpMAi" $ do + let (accIx, addrIx) = (toEnum 0x8000000E, toEnum 0x0000002A) + goldenYoroiAddr (seed0, recPwd0) InternalChain accIx addrIx + "Ae2tdPwUPEZFRbyhz3cpfC2CumGzNkFBN2L42rcUc2yjQpEkxDbkPodpMAi" + + let seed1 = "\171\151\240\DC4\147Q\ACK\NULfJxq\176h\172\DEL/\DC4\DC2\227\&6\155\129\134\f\221/\NUL\175a\252\249" + let recPwd1 = Passphrase "Cardano the cardano that cardano!" + it "m/0'/0/0 --> Ae2tdPwUPEZ1D...64dqTSRpWqzLH" $ do + let (accIx, addrIx) = (toEnum 0x80000000, toEnum 0x00000000) + goldenYoroiAddr (seed1, recPwd1) ExternalChain accIx addrIx + "Ae2tdPwUPEZ1DYmhvpJWtVkMUbypPVkCVjQLNJeKRRG4LJ64dqTSRpWqzLH" + it "m/0'/0/14 --> Ae2tdPwUPEZ7...pVwEPhKwseVvf" $ do + let (accIx, addrIx) = (toEnum 0x80000000, toEnum 0x0000000E) + goldenYoroiAddr (seed1, recPwd1) ExternalChain accIx addrIx + "Ae2tdPwUPEZ7ZyqyuDKkCnjrRjTY1vMJ8353gD7XWrUYufpVwEPhKwseVvf" + it "m/14'/1/42 --> Ae2tdPwUPEZ...nRtbfw6EHRv1D" $ do + let (accIx, addrIx) = (toEnum 0x8000000E, toEnum 0x0000002A) + goldenYoroiAddr (seed1, recPwd1) InternalChain accIx addrIx + "Ae2tdPwUPEZLSqQN7XNJRMJ6yHWdfFLaQgPPYgyJKrJnCVnRtbfw6EHRv1D" + + +{------------------------------------------------------------------------------- + Properties +-------------------------------------------------------------------------------} + + +prop_succMaxBoundHardIx :: Property +prop_succMaxBoundHardIx = expectFailure $ + property $ succ (maxBound @(Index 'Hardened _)) `seq` () + +prop_predMinBoundHardIx :: Property +prop_predMinBoundHardIx = expectFailure $ + property $ pred (minBound @(Index 'Hardened _)) `seq` () + +prop_succMaxBoundSoftIx :: Property +prop_succMaxBoundSoftIx = expectFailure $ + property $ succ (maxBound @(Index 'Soft _)) `seq` () + +prop_predMinBoundSoftIx :: Property +prop_predMinBoundSoftIx = expectFailure $ + property $ pred (minBound @(Index 'Soft _)) `seq` () + +prop_toEnumChangeChain :: Int -> Property +prop_toEnumChangeChain n = + n > fromEnum InternalChain ==> expectFailure $ property $ + (toEnum n :: ChangeChain) `seq` () + +prop_roundtripEnumChangeChain :: ChangeChain -> Property +prop_roundtripEnumChangeChain ix = + (toEnum . fromEnum) ix === ix + +prop_roundtripEnumIndexHard :: Index 'Hardened 'AccountK -> Property +prop_roundtripEnumIndexHard ix = + (toEnum . fromEnum) ix === ix .&&. (toEnum . fromEnum . getIndex) ix === ix + +prop_roundtripEnumIndexSoft :: Index 'Soft 'AddressK -> Property +prop_roundtripEnumIndexSoft ix = + (toEnum . fromEnum) ix === ix .&&. (toEnum . fromEnum . getIndex) ix === ix + +-- | Deriving address public key should be equal to deriving address +-- private key and extracting public key from it (works only for non-hardened +-- child keys). +-- +-- To compute the public child key of a parent private key: +-- * N(CKDpriv((kpar, cpar), i)) (works always). +-- * CKDpub(N(kpar, cpar), i) (works only for non-hardened child keys). +-- +-- Thus: +-- +-- N(CKDpriv((kpar, cpar), i)) === CKDpub(N(kpar, cpar), i) +-- +-- if (kpar, cpar) is a non-hardened key. +-- +-- For details see +prop_publicChildKeyDerivation + :: (Seed, Passphrase "generation") + -> Passphrase "encryption" + -> ChangeChain + -> Index 'Soft 'AddressK + -> Property +prop_publicChildKeyDerivation (Seed seed, recPwd) encPwd cc ix = + addrXPub1 === addrXPub2 + where + accXPrv = unsafeGenerateKeyFromSeed (seed, recPwd) (encPwd) + -- N(CKDpriv((kpar, cpar), i)) + addrXPub1 = publicKey $ deriveAddressPrivateKey encPwd accXPrv cc ix + -- CKDpub(N(kpar, cpar), i) + addrXPub2 = deriveAddressPublicKey (publicKey accXPrv) cc ix + +prop_accountKeyDerivation + :: (Seed, Passphrase "generation") + -> Passphrase "encryption" + -> Index 'Hardened 'AccountK + -> Property +prop_accountKeyDerivation (Seed seed, recPwd) encPwd ix = + accXPub `seq` property () -- NOTE Making sure this doesn't throw + where + rootXPrv = generateKeyFromSeed (seed, recPwd) encPwd + accXPub = deriveAccountPrivateKey encPwd rootXPrv ix + +goldenYoroiAddr + :: (ByteString, Passphrase "generation") + -> ChangeChain + -> Index 'Hardened 'AccountK + -> Index 'Soft 'AddressK + -> String + -> Property +goldenYoroiAddr (seed, recPwd) cc accIx addrIx addr = + let + encPwd = mempty + rootXPrv = generateKeyFromSeed (seed, recPwd) encPwd + accXPrv = deriveAccountPrivateKey encPwd rootXPrv accIx + addrXPrv = deriveAddressPrivateKey encPwd accXPrv cc addrIx + in + fmt (build $ keyToAddress $ publicKey addrXPrv) === addr + + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +newtype Seed = Seed ByteString deriving (Show) + +instance Arbitrary Seed where + shrink _ = [] + arbitrary = do + InfiniteList bytes _ <- arbitrary + return $ Seed $ BS.pack $ take 32 bytes + +instance Arbitrary (Index 'Soft 'AddressK) where + shrink _ = [] + arbitrary = arbitraryBoundedEnum + +instance Arbitrary (Index 'Hardened 'AccountK) where + shrink _ = [] + arbitrary = arbitraryBoundedEnum + +instance Arbitrary (Passphrase goal) where + shrink (Passphrase "") = [] + shrink (Passphrase _ ) = [Passphrase ""] + arbitrary = do + n <- choose (0, 32) + InfiniteList bytes _ <- arbitrary + return $ Passphrase $ BA.convert $ BS.pack $ take n bytes + +instance Arbitrary ChangeChain where + shrink _ = [] + arbitrary = elements [InternalChain, ExternalChain] diff --git a/test/unit/Cardano/Wallet/AddressDiscoverySpec.hs b/test/unit/Cardano/Wallet/AddressDiscoverySpec.hs new file mode 100644 index 00000000000..c3e68c96141 --- /dev/null +++ b/test/unit/Cardano/Wallet/AddressDiscoverySpec.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.AddressDiscoverySpec + ( spec + ) where + +import Prelude + +import Cardano.Wallet.AddressDerivation + ( ChangeChain (..) + , Depth (..) + , Key + , XPub + , deriveAddressPublicKey + , keyToAddress + , publicKey + , unsafeGenerateKeyFromSeed + ) +import Cardano.Wallet.AddressDiscovery + ( AddressPool + , AddressPoolGap + , MkAddressPoolGapError (..) + , accountPubKey + , addresses + , changeChain + , defaultAddressPoolGap + , gap + , lookupAddress + , mkAddressPool + , mkAddressPoolGap + ) +import Cardano.Wallet.Primitive + ( Address ) +import Control.Monad + ( forM ) +import Control.Monad.Trans.State.Strict + ( execState, state ) +import Data.List + ( elemIndex, (\\) ) +import Data.Maybe + ( isJust ) +import Data.Word + ( Word8 ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , InfiniteList (..) + , Property + , arbitraryBoundedEnum + , checkCoverage + , choose + , conjoin + , cover + , elements + , expectFailure + , frequency + , property + , withMaxSuccess + , (===) + , (==>) + ) + +import qualified Data.ByteString as BS + + +spec :: Spec +spec = do + describe "AddressPoolGap" $ do + it "'AddressPoolGap.succ maxBound' should result in a runtime err" + (expectFailure prop_succMaxBoundGap) + it "'AddressPoolGap.pred minBound' should result in a runtime err" + (expectFailure prop_predMinBoundGap) + it "FromEnum -> ToEnum roundtrip" + (property prop_roundtripEnumGap) + it "mkAddressPoolGap" + (checkCoverage prop_mkAddressPoolGap) + it "defaultAddressPoolGap is valid" + (property prop_defaultValid) + + describe "AddressPool" $ do + it "'lookupAddressPool' extends the pool by a maximum of 'gap'" + (checkCoverage prop_poolGrowWithinGap) + it "'addresses' preserves the address order" + (checkCoverage prop_roundtripMkAddressPool) + it "An AddressPool always contains at least 'gap pool' addresses" + (property prop_poolAtLeastGapAddresses) + it "Our addresses are eventually discovered" + (property prop_poolEventuallyDiscoverOurs) + + +{------------------------------------------------------------------------------- + Properties for AddressPoolGap +-------------------------------------------------------------------------------} + +prop_mkAddressPoolGap + :: Word8 + -> Property +prop_mkAddressPoolGap g = + cover 25 isWithinBound "hits within bounds" prop + where + prop = case mkAddressPoolGap g of + Left (ErrGapOutOfRange _) -> not isWithinBound + Right _ -> isWithinBound + isWithinBound = + fromEnum g >= fromEnum (minBound @AddressPoolGap) && + fromEnum g <= fromEnum (maxBound @AddressPoolGap) + +prop_defaultValid + :: Property +prop_defaultValid = + pure defaultAddressPoolGap + === + mkAddressPoolGap (toEnum $ fromEnum defaultAddressPoolGap) + +-- Failing property +prop_succMaxBoundGap :: Property +prop_succMaxBoundGap = + property $ succ (maxBound @AddressPoolGap) `seq` () + +-- Failing property +prop_predMinBoundGap :: Property +prop_predMinBoundGap = + property $ pred (minBound @AddressPoolGap) `seq` () + +prop_roundtripEnumGap + :: AddressPoolGap + -> Property +prop_roundtripEnumGap g = + (toEnum . fromEnum) g === g + + +{------------------------------------------------------------------------------- + Properties for AddressPool +-------------------------------------------------------------------------------} + +-- | After a lookup, a property should never grow more than its gap value. +prop_poolGrowWithinGap + :: (AddressPool, Address) + -> Property +prop_poolGrowWithinGap (pool, addr) = + cover 10 (isJust $ fst res) "pool hit" prop + where + res = lookupAddress addr pool + prop = case res of + (Nothing, pool') -> pool === pool' + (Just _, pool') -> + let k = length $ addresses pool' \\ addresses pool + in conjoin + [ gap pool === gap pool' + , property (k >= 0 && k <= fromEnum (gap pool)) + ] + +-- | A pool gives back its addresses in correct order and can be reconstructed +prop_roundtripMkAddressPool + :: AddressPool + -> Property +prop_roundtripMkAddressPool pool = + ( mkAddressPool + (accountPubKey pool) + (gap pool) + (changeChain pool) + (addresses pool) + ) === pool + +-- | A pool always contains a number of addresses at least equal to its gap +prop_poolAtLeastGapAddresses + :: AddressPool + -> Property +prop_poolAtLeastGapAddresses pool = + property prop + where + prop = length (addresses pool) >= fromEnum (gap pool) + +-- | Our addresses are eventually discovered +prop_poolEventuallyDiscoverOurs + :: (AddressPoolGap, ChangeChain, Address) + -> Property +prop_poolEventuallyDiscoverOurs (g, cc, addr) = + addr `elem` ours ==> withMaxSuccess 10 $ property prop + where + ours = take 25 (ourAddresses cc) + pool = flip execState (mkAddressPool ourAccount g cc mempty) $ + forM ours (state . lookupAddress) + prop = (fromEnum <$> fst (lookupAddress addr pool)) === elemIndex addr ours + + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +ourAccount + :: Key 'AccountK XPub +ourAccount = publicKey $ unsafeGenerateKeyFromSeed (bytes, mempty) mempty + where + bytes = BS.replicate 32 0 + +ourAddresses + :: ChangeChain + -> [Address] +ourAddresses cc = + keyToAddress . deriveAddressPublicKey ourAccount cc <$> [minBound..maxBound] + +instance Arbitrary AddressPoolGap where + shrink _ = [] + arbitrary = arbitraryBoundedEnum + +instance Arbitrary ChangeChain where + shrink _ = [] + arbitrary = elements [InternalChain, ExternalChain] + +-- | In this context, Arbitrary addresses are either some known addresses +-- derived from "our account key", or they just are some arbitrary addresses +-- that are unknown to us. +instance Arbitrary Address where + shrink _ = [] + arbitrary = frequency + [ (8, elements $ take 25 (ourAddresses ExternalChain)) + , (8, elements $ take 25 (ourAddresses InternalChain)) + , (1, notOurs) + ] + where + notOurs = do + bytes <- BS.pack . take 32 . getInfiniteList <$> arbitrary + let xprv = unsafeGenerateKeyFromSeed (bytes, mempty) mempty + return $ keyToAddress $ publicKey xprv + +instance Arbitrary AddressPool where + shrink pool = + let + key = accountPubKey pool + g = gap pool + cc = changeChain pool + addrs = addresses pool + in case length addrs of + k | k == fromEnum g && g == minBound -> + [] + k | k == fromEnum g && g > minBound -> + [ mkAddressPool key minBound cc [] ] + k -> + [ mkAddressPool key minBound cc [] + , mkAddressPool key g cc [] + , mkAddressPool key g cc (take (k - (fromEnum g `div` 5)) addrs) + ] + arbitrary = do + g <- arbitrary + n <- choose (0, 2 * fromEnum g) + cc <- arbitrary + let addrs = take n (ourAddresses cc) + return $ mkAddressPool ourAccount g cc addrs diff --git a/test/unit/Cardano/WalletSpec.hs b/test/unit/Cardano/WalletSpec.hs index 9e6ff068ed6..36ea87e2e47 100644 --- a/test/unit/Cardano/WalletSpec.hs +++ b/test/unit/Cardano/WalletSpec.hs @@ -13,7 +13,6 @@ import Cardano.Wallet ( applyBlock , availableBalance , initWallet - , invariant , totalBalance , totalUTxO , txOutsOurs @@ -34,6 +33,7 @@ import Cardano.Wallet.Primitive , UTxO (..) , balance , excluding + , invariant , restrictedTo , txIns )