comply with reviewer remarks

hlint suggestions correct db bench compiling
cardano-foundation · Dec 1, 2020 · 6c69055 · 6c69055
1 parent de1b1d5
commit 6c69055
Show file tree

Hide file tree

Showing 4 changed files with 32 additions and 17 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
@@ -335,7 +335,7 @@ mkVerificationKeyPool accXPub num@(AddressPoolGap g) vkPoolMap = VerificationKey
     projectIndex :: Index 'Soft 'AddressK -> Index 'Soft 'ScriptK
     projectIndex ix = Index $ getIndex ix
     indices =
-        [firstIndexToAdd .. (firstIndexToAdd + (fromInteger $ toInteger g) - 1)]
+        [firstIndexToAdd .. (firstIndexToAdd + fromInteger (toInteger g) - 1)]
     vkPoolMap' =
         Map.fromList $
         map (\ix -> (deriveVerKeyH (toIndex ix), (projectIndex $ toIndex ix, Unused)) )

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Scripts.hs b/lib/core/src/Cardano/Wallet/Primitive/Scripts.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -49,6 +50,10 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     )
 import Cardano.Wallet.Primitive.Types.Address
     ( AddressState (..) )
+import Control.Monad
+    ( foldM )
+import Data.Functor.Identity
+    ( Identity (..) )
 
 import qualified Data.List as L
 import qualified Data.Map.Strict as Map
@@ -61,7 +66,7 @@ isShared
     => Script
     -> SeqState n k
     -> ([k 'ScriptK XPub], SeqState n k)
-isShared script s@(SeqState !s1 !s2 !ixs !rpk !prefix !scripts !s3) =
+isShared script (SeqState !s1 !s2 !ixs !rpk !prefix !scripts !s3) =
     let verKeysInScript = retrieveAllVerKeyHashes script
         (VerificationKeyPool accXPub currentGap verKeyMap) = s3
         projectKey (ShelleyKey k) = ShelleyKey k
@@ -83,26 +88,31 @@ isShared script s@(SeqState !s1 !s2 !ixs !rpk !prefix !scripts !s3) =
             (Map.toList verKeyMap)
         -- if all verification keys are used (after discovering) we are extending multisigPool
         extendingPool =
-            all (==Used) $
-            map (\(_,(_,isUsed)) -> isUsed) $
-            Map.toList markedVerKeyMap
+            all ((== Used) . (\ (_, (_, isUsed)) -> isUsed))
+            (Map.toList markedVerKeyMap)
         s3' = if extendingPool then
                   mkVerificationKeyPool
                   accXPub
                   (mkUnboundedAddressPoolGap (getAddressPoolGap currentGap + getAddressPoolGap defaultAddressPoolGap))
                   markedVerKeyMap
               else
                   VerificationKeyPool accXPub currentGap markedVerKeyMap
-    in if null ourVerKeysInScript then
-        ([], s)
-       else
-        ( scriptXPubs
-        , SeqState s1 s2 ixs rpk prefix (Map.insert (toScriptHash script) scriptXPubs scripts) s3')
+        insertIf predicate k v = if predicate v then Map.insert k v else id
+    in ( scriptXPubs
+       , SeqState s1 s2 ixs rpk prefix
+           (insertIf (not . null) (toScriptHash script) scriptXPubs scripts)
+           s3'
+       )
 
 retrieveAllVerKeyHashes :: Script -> [KeyHash]
-retrieveAllVerKeyHashes = extractVerKey []
+retrieveAllVerKeyHashes = foldScript (:) []
+
+foldScript :: (KeyHash -> b -> b) -> b -> Script -> b
+foldScript fn zero = \case
+    RequireSignatureOf k -> fn k zero
+    RequireAllOf xs      -> foldMScripts xs
+    RequireAnyOf xs      -> foldMScripts xs
+    RequireSomeOf _ xs   -> foldMScripts xs
   where
-      extractVerKey acc (RequireSignatureOf verKey) = verKey : acc
-      extractVerKey acc (RequireAllOf xs) = foldr (flip extractVerKey) acc xs
-      extractVerKey acc (RequireAnyOf xs) = foldr (flip extractVerKey) acc xs
-      extractVerKey acc (RequireSomeOf _ xs) = foldr (flip extractVerKey) acc xs
+    foldMScripts =
+        runIdentity . foldM (\acc -> Identity . foldScript fn acc) zero
diff --git a/lib/core/test/bench/db/Main.hs b/lib/core/test/bench/db/Main.hs
@@ -86,11 +86,14 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( AddressPool
     , DerivationPrefix (..)
     , SeqState (..)
+    , accountPubKey
     , coinTypeAda
     , defaultAddressPoolGap
     , emptyPendingIxs
+    , gap
     , mkAddressPool
     , mkSeqStateFromRootXPrv
+    , mkVerificationKeyPool
     , purposeCIP1852
     )
 import Cardano.Wallet.Primitive.Model
@@ -318,16 +321,18 @@ bgroupWriteSeqState db = bgroup "SeqState"
         fixture db_ = do
             walletFixture db_
             pure cps
+        extPool = mkPool a i
         cps :: [WalletBench]
         cps =
             [ snd $ initWallet (withMovingSlot i block0) dummyGenesisParameters $
                 SeqState
                     (mkPool a i)
-                    (mkPool a i)
+                    extPool
                     emptyPendingIxs
                     rewardAccount
                     defaultPrefix
                     Map.empty
+                    (mkVerificationKeyPool (accountPubKey extPool) (gap extPool) Map.empty)
             | i <- [1..n]
             ]
 

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/ScriptsSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/ScriptsSpec.hs
@@ -143,7 +143,7 @@ prop_scriptUpdatesStateProperly (AccountXPubWithScripts accXPub' scripts') = do
     let scriptKeyHashesInMap =
             Set.fromList . map (toVerKeyHash . projectKey) <$>
             Map.lookup (toScriptHash script) (knownScripts seqState')
-    scriptKeyHashesInMap === (Just $ Set.fromList (L.nub sciptKeyHashes))
+    scriptKeyHashesInMap === Just (Set.fromList (L.nub sciptKeyHashes))
 
 prop_scriptDiscoveredTwice
     :: AccountXPubWithScripts