From e66c16ed4aae0a06fc47ab19354adcc8e66fb7cd Mon Sep 17 00:00:00 2001 From: paolino Date: Mon, 29 May 2023 09:48:35 +0000 Subject: [PATCH] Add StoreSpec for the PrivateKey store. --- lib/wallet/cardano-wallet.cabal | 1 + .../Wallet/DB/Store/PrivateKey/Store.hs | 9 ++ .../test/unit/Cardano/Wallet/DB/Arbitrary.hs | 6 +- .../Wallet/DB/Store/PrivateKey/StoreSpec.hs | 95 +++++++++++++++++++ 4 files changed, 108 insertions(+), 3 deletions(-) create mode 100644 lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 0391615d59d..4d501c7262b 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -921,6 +921,7 @@ test-suite unit Cardano.Wallet.DB.Store.Info.StoreSpec Cardano.Wallet.DB.Store.Meta.ModelSpec Cardano.Wallet.DB.Store.Meta.StoreSpec + Cardano.Wallet.DB.Store.PrivateKey.StoreSpec Cardano.Wallet.DB.Store.Submissions.StoreSpec Cardano.Wallet.DB.Store.Transactions.StoreSpec Cardano.Wallet.DB.Store.UTxOHistory.ModelSpec diff --git a/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs b/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs index 09ce216305f..5441639fdbf 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs @@ -3,12 +3,18 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + -- | -- Copyright: © 2023 IOHK -- License: Apache-2.0 module Cardano.Wallet.DB.Store.PrivateKey.Store ( mkStorePrivateKey + , PrivateKey (..) + , DeltaPrivateKey + , StorePrivateKey ) where import Prelude @@ -45,6 +51,9 @@ import qualified Cardano.Wallet.DB.Sqlite.Schema as Schema -- | A 'PrivateKey' for a given 'KeyFlavor'. data PrivateKey k = PrivateKey (k 'RootK XPrv) PassphraseHash +deriving instance Eq (k 'RootK XPrv) => Eq (PrivateKey k) +deriving instance Show (k 'RootK XPrv) => Show (PrivateKey k) + -- | A 'Delta' for 'PrivateKey'. type DeltaPrivateKey k = Replace (PrivateKey k) diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Arbitrary.hs index 8f519def508..7bfe95c9721 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/Arbitrary.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Arbitrary.hs @@ -13,12 +13,12 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE TupleSections #-} module Cardano.Wallet.DB.Arbitrary ( GenTxHistory (..) @@ -65,6 +65,8 @@ import Cardano.Wallet.Address.Discovery.Sequential ) import Cardano.Wallet.Address.Discovery.Shared ( SharedAddressPools (..), SharedState (..) ) +import Cardano.Wallet.Address.Keys.WalletKey + ( getRawKey, liftRawKey, publicKey ) import Cardano.Wallet.DB.Pure.Implementation ( TxHistory, filterTxHistory ) import Cardano.Wallet.DummyTarget.Primitive.Types as DummyTarget @@ -228,8 +230,6 @@ import qualified Cardano.Wallet.Address.Derivation.Shared as Shared import qualified Cardano.Wallet.Address.Derivation.Shelley as Shelley import qualified Cardano.Wallet.Address.Discovery.Sequential as Seq import qualified Cardano.Wallet.Address.Discovery.Shared as Shared -import Cardano.Wallet.Address.Keys.WalletKey - ( getRawKey, liftRawKey, publicKey ) import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs new file mode 100644 index 00000000000..95b6710eed3 --- /dev/null +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE RankNTypes #-} + +-- | +-- Copyright: © 2022–2023 IOHK +-- License: Apache-2.0 +-- +-- Test properties of the privatekey 'Store'. +module Cardano.Wallet.DB.Store.PrivateKey.StoreSpec + ( spec + ) +where + +import Prelude + +import Cardano.Address.Derivation + ( XPrv ) +import Cardano.DB.Sqlite + ( ForeignKeysSetting (ForeignKeysDisabled) ) +import Cardano.Wallet.Address.Derivation + ( Depth (RootK) ) +import Cardano.Wallet.DB.Arbitrary + () +import Cardano.Wallet.DB.Fixtures + ( RunQuery + , WalletProperty + , logScale + , withDBInMemory + , withInitializedWalletProp + ) +import Cardano.Wallet.DB.Store.PrivateKey.Store + ( DeltaPrivateKey, PrivateKey (..), mkStorePrivateKey ) +import Cardano.Wallet.Flavor + ( KeyFlavorS (..) ) +import Cardano.Wallet.Primitive.Types + ( WalletId ) +import Data.Delta + ( Replace (..) ) +import Fmt + ( Buildable (..) ) +import Test.Hspec + ( Spec, around, describe, it ) +import Test.QuickCheck + ( Arbitrary, Gen, arbitrary, property ) +import Test.QuickCheck.Monadic + ( PropertyM ) +import Test.Store + ( prop_StoreUpdates ) + +spec :: Spec +spec = + around (withDBInMemory ForeignKeysDisabled) $ do + describe "private-key store" $ do + it "respects store laws for ShelleyKeyS" + $ property . prop_SingleWalletStoreLaws ShelleyKeyS + it "respects store laws for ByronKeyS" + $ property . prop_SingleWalletStoreLaws ByronKeyS + +prop_SingleWalletStoreLaws + :: (Eq (k 'RootK XPrv), Show (k 'RootK XPrv), Arbitrary (k 'RootK XPrv)) + => KeyFlavorS k + -> WalletProperty +prop_SingleWalletStoreLaws kF = do + withInitializedWalletProp $ \wid runQ -> do + propStore runQ wid kF + +propStore + :: (Eq (k 'RootK XPrv), Show (k 'RootK XPrv), Arbitrary (k 'RootK XPrv)) + => RunQuery + -> WalletId + -> KeyFlavorS k + -> PropertyM IO () +propStore runQ wid kF = + prop_StoreUpdates + runQ + (mkStorePrivateKey kF wid) + genPrivateKey + (logScale . genDelta) + +genPrivateKey :: Arbitrary (k 'RootK XPrv) => Gen (PrivateKey k) +genPrivateKey = PrivateKey <$> arbitrary <*> arbitrary + +instance Buildable (DeltaPrivateKey k) where + build _ = "DeltaPrivateKey" + +genDelta + :: Arbitrary (k 'RootK XPrv) + => PrivateKey k + -> Gen (DeltaPrivateKey k) +genDelta _ = Replace <$> genPrivateKey