From 6c6905584b4c992e188db41e14f6849b0512a450 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Mon, 23 Nov 2020 12:16:22 +0100 Subject: [PATCH] comply with reviewer remarks hlint suggestions correct db bench compiling --- .../Primitive/AddressDiscovery/Sequential.hs | 2 +- .../src/Cardano/Wallet/Primitive/Scripts.hs | 38 ++++++++++++------- lib/core/test/bench/db/Main.hs | 7 +++- .../Cardano/Wallet/Primitive/ScriptsSpec.hs | 2 +- 4 files changed, 32 insertions(+), 17 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index f820d965b6d..7fd48b207ac 100644 --- 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 index 2fdbc258503..f5df1ead4b6 100644 --- 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,9 +88,8 @@ 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 @@ -93,16 +97,22 @@ isShared script s@(SeqState !s1 !s2 !ixs !rpk !prefix !scripts !s3) = 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 index 080ed91587d..eec3cb7890c 100644 --- 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 index 3fafe2d3045..c1a57731cd6 100644 --- 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