re-adjust core unit tests

cardano-foundation · Dec 2, 2020 · 2fa279e · 2fa279e
1 parent aa0c712
commit 2fa279e
Show file tree

Hide file tree

Showing 4 changed files with 47 additions and 45 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Primitive/Scripts.hs b/lib/core/src/Cardano/Wallet/Primitive/Scripts.hs
@@ -36,7 +36,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , Index (..)
     , Role (..)
     , SoftDerivation (..)
-    , hex
     )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey (..) )
@@ -45,11 +44,9 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
 
 import qualified Data.List as L
 import qualified Data.Map.Strict as Map
-import qualified Data.Text.Encoding as T
 
 instance Ord ScriptHash where
-    compare (ScriptHash sh1) (ScriptHash sh2) =
-        compare (T.decodeUtf8 $ hex sh1) (T.decodeUtf8 $ hex sh2)
+    compare (ScriptHash sh1) (ScriptHash sh2) = compare sh1 sh2
 
 isShared
     :: (k ~ ShelleyKey, SoftDerivation k)

diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
@@ -64,8 +64,11 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( AddressPool
     , DerivationPrefix (..)
     , SeqState (..)
+    , accountPubKey
     , coinTypeAda
+    , gap
     , mkAddressPool
+    , mkVerificationKeyPool
     , purposeCIP1852
     )
 import Cardano.Wallet.Primitive.Model
@@ -455,15 +458,18 @@ instance Arbitrary (Index 'WholeDomain depth) where
 -------------------------------------------------------------------------------}
 
 instance Arbitrary (SeqState 'Mainnet ShelleyKey) where
-    shrink (SeqState intPool extPool ixs rwd prefix scripts) =
-        (\(i, e, x) -> SeqState i e x rwd prefix scripts) <$> shrink (intPool, extPool, ixs)
-    arbitrary = SeqState
-        <$> arbitrary
-        <*> arbitrary
-        <*> arbitrary
-        <*> pure arbitraryRewardAccount
-        <*> pure defaultSeqStatePrefix
-        <*> pure Map.empty
+    shrink (SeqState intPool extPool ixs rwd prefix scripts multiPool) =
+        (\(i, e, x) -> SeqState i e x rwd prefix scripts multiPool) <$> shrink (intPool, extPool, ixs)
+    arbitrary = do
+        extPool <- arbitrary
+        SeqState
+            <$> arbitrary
+            <*> pure extPool
+            <*> arbitrary
+            <*> pure arbitraryRewardAccount
+            <*> pure defaultSeqStatePrefix
+            <*> pure Map.empty
+            <*> pure (mkVerificationKeyPool (accountPubKey extPool) (gap extPool) Map.empty)
 
 defaultSeqStatePrefix :: DerivationPrefix
 defaultSeqStatePrefix = DerivationPrefix

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs
@@ -66,6 +66,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
     , mkUnboundedAddressPoolGap
+    , mkVerificationKeyPool
     , purposeCIP1852
     , purposeCIP1852
     , role
@@ -479,7 +480,8 @@ prop_changeIsOnlyKnownAfterGeneration
 prop_changeIsOnlyKnownAfterGeneration (intPool, extPool) =
     let
         s0 :: SeqState 'Mainnet ShelleyKey
-        s0 = SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix Map.empty
+        s0 = SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix Map.empty multiPool
+        multiPool = mkVerificationKeyPool (accountPubKey extPool) (gap extPool) Map.empty
         addrs0 = fst <$> knownAddresses s0
         (change, s1) = genChange (\k _ -> paymentAddress @'Mainnet k) s0
         addrs1 = fst <$> knownAddresses s1
@@ -703,12 +705,13 @@ instance
         return $ mkAddressPool @'Mainnet ourAccount g (zip addrs statuses)
 
 instance Arbitrary (SeqState 'Mainnet ShelleyKey) where
-    shrink (SeqState intPool extPool ixs rwd prefix scripts) =
-        (\(i, e) -> SeqState i e ixs rwd prefix scripts) <$> shrink (intPool, extPool)
+    shrink (SeqState intPool extPool ixs rwd prefix scripts multiPool) =
+        (\(i, e) -> SeqState i e ixs rwd prefix scripts multiPool) <$> shrink (intPool, extPool)
     arbitrary = do
         intPool <- arbitrary
         extPool <- arbitrary
-        return $ SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix Map.empty
+        let multiPool = mkVerificationKeyPool (accountPubKey extPool) (gap extPool) Map.empty
+        return $ SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix Map.empty multiPool
 
 -- | Wrapper to encapsulate accounting style proxies that are so-to-speak,
 -- different types in order to easily map over them and avoid duplicating

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/ScriptsSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/ScriptsSpec.hs
@@ -25,13 +25,13 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , DerivationType (..)
     , HardDerivation (..)
     , Index (..)
+    , NetworkDiscriminant (..)
     , Passphrase (..)
     , PassphraseMaxLength (..)
     , PassphraseMinLength (..)
     , Role (..)
     , SoftDerivation (..)
     , WalletKey (..)
-    , hex
     , preparePassphrase
     )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
@@ -43,11 +43,13 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , defaultAddressPoolGap
     , emptyPendingIxs
     , mkAddressPool
+    , mkVerificationKeyPool
     , purposeCIP1852
     , purposeCIP1852
+    , toVerKeyHash
     )
 import Cardano.Wallet.Primitive.Scripts
-    ( isShared, retrieveAllVerKeyHashes, toKeyHash )
+    ( isShared, retrieveAllVerKeyHashes )
 import Cardano.Wallet.Primitive.Types
     ( PassphraseScheme (..) )
 import Cardano.Wallet.Unsafe
@@ -101,23 +103,17 @@ prop_scriptFromOurVerKeys
 prop_scriptFromOurVerKeys (AccountXPubWithScripts accXPub' scripts') = do
     let (script:_) = scripts'
     let sciptKeyHashes = retrieveAllVerKeyHashes script
-    let intPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let extPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let seqState =
-            SeqState intPool extPool emptyPendingIxs dummyRewardAccount defaultPrefix Map.empty
+    let seqState = initializeState accXPub'
     let (ourSharedKeys, _) = isShared script seqState
-    L.sort (L.nub $ map toKeyHash ourSharedKeys) === L.sort (L.nub sciptKeyHashes)
+    L.sort (L.nub $ map (toVerKeyHash . projectKey) ourSharedKeys) === L.sort (L.nub sciptKeyHashes)
 
 prop_scriptFromNotOurVerKeys
     :: ShelleyKey 'AccountK XPub
     -> AccountXPubWithScripts
     -> Property
 prop_scriptFromNotOurVerKeys accXPub' (AccountXPubWithScripts _accXPub scripts') = do
     let (script:_) = scripts'
-    let intPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let extPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let seqState =
-            SeqState intPool extPool emptyPendingIxs dummyRewardAccount defaultPrefix Map.empty
+    let seqState = initializeState accXPub'
     let (ourSharedKeys, _) = isShared script seqState
     ourSharedKeys === []
 
@@ -127,24 +123,19 @@ prop_scriptUpdatesStateProperly
 prop_scriptUpdatesStateProperly (AccountXPubWithScripts accXPub' scripts') = do
     let (script:_) = scripts'
     let sciptKeyHashes = retrieveAllVerKeyHashes script
-    let intPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let extPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let seqState =
-            SeqState intPool extPool emptyPendingIxs dummyRewardAccount defaultPrefix Map.empty
+    let seqState = initializeState accXPub'
     let (_, seqState') = isShared script seqState
     let scriptKeyHashesInMap =
-            Set.fromList . map toKeyHash <$> Map.lookup (toScriptHash script) (knownScripts seqState')
+            Set.fromList . map (toVerKeyHash . projectKey) <$>
+            Map.lookup (toScriptHash script) (knownScripts seqState')
     scriptKeyHashesInMap === (Just $ Set.fromList (L.nub sciptKeyHashes))
 
 prop_scriptDiscoveredTwice
     :: AccountXPubWithScripts
     -> Property
 prop_scriptDiscoveredTwice (AccountXPubWithScripts accXPub' scripts') = do
     let (script:_) = scripts'
-    let intPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let extPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let seqState =
-            SeqState intPool extPool emptyPendingIxs dummyRewardAccount defaultPrefix Map.empty
+    let seqState = initializeState accXPub'
     let (_, seqState') = isShared script seqState
     let (_, seqState'') = isShared script seqState'
     knownScripts seqState' === knownScripts seqState''
@@ -153,10 +144,7 @@ prop_scriptsDiscovered
     :: AccountXPubWithScripts
     -> Property
 prop_scriptsDiscovered (AccountXPubWithScripts accXPub' scripts') = do
-    let intPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let extPool = mkAddressPool accXPub' defaultAddressPoolGap []
-    let seqState0 =
-            SeqState intPool extPool emptyPendingIxs dummyRewardAccount defaultPrefix Map.empty
+    let seqState0 = initializeState accXPub'
     let seqState = foldr (\script s -> snd $ isShared script s) seqState0 scripts'
     let scriptHashes = Set.fromList $ Map.keys $ knownScripts seqState
     scriptHashes === Set.fromList (map toScriptHash scripts')
@@ -176,9 +164,17 @@ defaultPrefix = DerivationPrefix
 dummyRewardAccount :: ShelleyKey 'AddressK XPub
 dummyRewardAccount = ShelleyKey $ unsafeXPub $ B8.replicate 64 '0'
 
-instance Ord KeyHash where
-    compare (KeyHash kh1) (KeyHash kh2) =
-        compare (T.decodeUtf8 $ hex kh1) (T.decodeUtf8 $ hex kh2)
+projectKey :: ShelleyKey 'ScriptK XPub -> ShelleyKey 'AddressK XPub
+projectKey (ShelleyKey k) = ShelleyKey k
+
+initializeState
+    :: ShelleyKey 'AccountK XPub
+    -> SeqState 'Mainnet ShelleyKey
+initializeState accXPub' =
+    let intPool = mkAddressPool accXPub' defaultAddressPoolGap []
+        extPool = mkAddressPool accXPub' defaultAddressPoolGap []
+        multiPool = mkVerificationKeyPool accXPub' defaultAddressPoolGap Map.empty
+    in SeqState intPool extPool emptyPendingIxs dummyRewardAccount defaultPrefix Map.empty multiPool
 
 {-------------------------------------------------------------------------------
                                 Arbitrary Instances
@@ -218,7 +214,7 @@ instance Arbitrary AccountXPubWithScripts where
         let verKeys =
                 map (\ix -> toVerKey (toEnum (fromInteger $ toInteger $ minIndex + ix)))
                 [0 .. keyNum]
-        let verKeyHashes = map toKeyHash verKeys
+        let verKeyHashes = map toVerKeyHash verKeys
         scriptsNum <- choose (1,10)
         AccountXPubWithScripts accXPub' <$> vectorOf scriptsNum (genScript verKeyHashes)