From 923737cad6a6c68a90d3985d0a962ce389a295e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Thu, 19 May 2022 13:10:37 +0200 Subject: [PATCH 01/13] Avoid processing protocol updates during startup if the state is already present. Concretely this removes the processing of protocol updates for intermediate protocol updates during startup, as well as caching of the state during startup for all but the last protocol version. Additionally we no longer store genesis blocks in-memory. This is significant since the genesis blocks for protocol updates contain the serialized state. This significantly decreases memory consumption of the running node. --- concordium-base | 2 +- .../GlobalState/Persistent/TreeState.hs | 4 ++++ .../src/Concordium/GlobalState/TreeState.hs | 20 +++++++++++++++++++ .../src/Concordium/MultiVersion.hs | 5 ++++- .../ProtocolUpdate/P1/ProtocolP2.hs | 1 + .../Concordium/ProtocolUpdate/P1/Reboot.hs | 1 + .../ProtocolUpdate/P2/ProtocolP3.hs | 1 + .../ProtocolUpdate/P3/ProtocolP4.hs | 1 + .../Concordium/Skov/MonadImplementations.hs | 8 ++++++++ .../test-runners/deterministic/Main.hs | 1 + 10 files changed, 42 insertions(+), 2 deletions(-) diff --git a/concordium-base b/concordium-base index 3806e0b968..39719621b7 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit 3806e0b9682a88363a4694f42913e1b1d292c4a2 +Subproject commit 39719621b7bc41e4b8011be55b36e374c788c7c3 diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs index a3f22cbbb2..57e543e756 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs @@ -300,14 +300,17 @@ loadSkovPersistentData rp _treeStateDirectory pbsc atiContext = do -- But this behaviour of LMDB is poorly documented, so we might experience issues. _db <- either (logExceptionAndThrowTS . DatabaseOpeningError) return =<< liftIO (try $ databaseHandlers _treeStateDirectory) + logEvent GlobalState LLDebug "Checking database version." -- Check that the database version matches what we expect. liftIO (checkDatabaseVersion _db) >>= either (logExceptionAndThrowTS . IncorrectDatabaseVersion) return + logEvent GlobalState LLDebug "Checked database version." -- Get the genesis block and check that its data matches the supplied genesis data. genStoredBlock <- maybe (logExceptionAndThrowTS GenesisBlockNotInDataBaseError) return =<< liftIO (getFirstBlock _db) + logEvent GlobalState LLDebug "Got first block." _genesisBlockPointer <- liftIO $ makeBlockPointer genStoredBlock _genesisData <- case _bpBlock _genesisBlockPointer of GenesisBlock gd' -> return gd' @@ -318,6 +321,7 @@ loadSkovPersistentData rp _treeStateDirectory pbsc atiContext = do Left s -> logExceptionAndThrowTS $ DatabaseInvariantViolation s Right hm -> return $! HM.map BlockFinalized hm + logEvent GlobalState LLDebug "Getting last finalized block." -- Get the last finalized block. (_lastFinalizationRecord, lfStoredBlock) <- liftIO (getLastBlock _db) >>= \case Left s -> logExceptionAndThrowTS $ DatabaseInvariantViolation s diff --git a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs index 05ad44dbab..2cd3ac9df8 100644 --- a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs @@ -85,6 +85,26 @@ data AddTransactionResult = NotAdded !TVer.VerificationResult deriving(Eq, Show) +-- |Information about the genesis block of the chain. This is not the full +-- genesis block. It does not include the genesis state. Instead, it is the +-- minimal information needed by a running consensus. +data GenesisConfiguration = GenesisConfiguration { + -- |Genesis parameters. + _gcCore :: !CoreGenesisParameters, + -- |Hash of the current genesis block. Each protocol update introduces a new + -- genesis block. + _gcCurrentHash :: !BlockHash, + -- |Hash of the genesis block of the chain. + _gcFirstGenesis :: !BlockHash + } deriving (Eq, Show) + +instance BasicGenesisData GenesisConfiguration where + gdGenesisTime = gdGenesisTime . _gcCore + gdSlotDuration = gdSlotDuration . _gcCore + gdMaxBlockEnergy = gdMaxBlockEnergy . _gcCore + gdFinalizationParameters = gdFinalizationParameters . _gcCore + gdEpochLength = gdEpochLength . _gcCore + -- |Monad that provides operations for working with the low-level tree state. -- These operations are abstracted where possible to allow for a range of implementation -- choices. diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs index 9dd002b366..41be54949a 100644 --- a/concordium-consensus/src/Concordium/MultiVersion.hs +++ b/concordium-consensus/src/Concordium/MultiVersion.hs @@ -474,7 +474,8 @@ checkForProtocolUpdate = liftSkov body TreeStateMonad (VersionedSkovM gc fc pv) ) => VersionedSkovM gc fc pv () - body = + body = do + logEvent Kontrol LLDebug "Checking for protocol update." Skov.getProtocolUpdateStatus >>= \case ProtocolUpdated pu -> case checkUpdate @pv pu of Left err -> do @@ -485,7 +486,9 @@ checkForProtocolUpdate = liftSkov body callbacks <- asks mvCallbacks liftIO (notifyRegenesis callbacks Nothing) Right upd -> do + logEvent Kontrol LLDebug "Got protocol update status." regenesis <- updateRegenesis upd + logEvent Kontrol LLDebug "Got regenesis." lfbHeight <- bpHeight <$> lastFinalizedBlock latestEraGenesisHeight <- lift $ MVR $ \mvr -> do diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs index 1dcd3c58bb..55a7714009 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs @@ -65,6 +65,7 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol +import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The hash that identifies a update from P1 to P2 protocol. -- This is the hash of the published specification document. diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs index b9d5ec6d60..fd05fcb2e5 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs @@ -70,6 +70,7 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol +import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The data required to perform a P1.Reboot update. data UpdateData = UpdateData diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs index 3d56e4e6e1..6a9a096baf 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs @@ -65,6 +65,7 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol +import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The hash that identifies a update from P2 to P3 protocol. -- This is the hash of the published specification document. diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs index bfc4d12a79..616e348b6c 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs @@ -70,6 +70,7 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol +import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The hash that identifies a update from P3 to P4 protocol. -- This is the hash of the published specification document. diff --git a/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs b/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs index 6f85d359fe..580742e164 100644 --- a/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs +++ b/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs @@ -353,6 +353,14 @@ data SkovHandlers pv t c m = SkovHandlers { shPendingLive :: m () } +emptySkovHandlers :: forall m pv t c . Monad m => SkovHandlers pv t c m +emptySkovHandlers = SkovHandlers { + shBroadcastFinalizationMessage = \_ -> return (), + shOnTimeout = \_ _ -> return undefined, + shCancelTimer = \ _ -> return (), + shPendingLive = return () + } + instance SkovFinalizationHandlers (SkovHandlers pv t c m) m where handleBroadcastFinalizationMessage SkovHandlers{..} = shBroadcastFinalizationMessage diff --git a/concordium-consensus/test-runners/deterministic/Main.hs b/concordium-consensus/test-runners/deterministic/Main.hs index 9ad2ffffdf..cb50decbc6 100644 --- a/concordium-consensus/test-runners/deterministic/Main.hs +++ b/concordium-consensus/test-runners/deterministic/Main.hs @@ -286,6 +286,7 @@ initialState = do hconfig = NoHandler config = SkovConfig gsconfig finconfig hconfig (_bsContext, _bsState) <- runLoggerT (initialiseSkov genData config) (logFor (fromIntegral bakerId)) + return BakerState{..} _ssEvents = makeEvents $ (PEvent 0 (TransactionEvent (transactions (mkStdGen 1)))) : [PEvent 0 (BakerEvent i (EBake 0)) | i <- allBakers] _ssNextTimer = 0 From 6ad7d9d4ef32344642d8910d3128e6fbfebbced3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Sat, 21 May 2022 13:35:21 +0200 Subject: [PATCH 02/13] Remove genesis data from genesis block pointer. This removes the last place where genesis data was retained by the node. All those places now use GenesisConfiguration which has a very small footprint. The only complication was in loading blocks from LMDB due to backwards compatibility. However the way genesis data is serialized we can load GenesisConfiguration assuming we know the genesis hash, which we do. The implementation as is is compatible with existing databases which store the entire genesis block, as well as with the new way the genesis block is stored. --- .../GlobalState/Persistent/TreeState.hs | 4 ---- .../src/Concordium/GlobalState/TreeState.hs | 20 ------------------- .../ProtocolUpdate/P1/ProtocolP2.hs | 1 - .../Concordium/ProtocolUpdate/P1/Reboot.hs | 1 - .../ProtocolUpdate/P2/ProtocolP3.hs | 1 - .../ProtocolUpdate/P3/ProtocolP4.hs | 1 - .../consensus/ConcordiumTests/CatchUp.hs | 18 ++++++++--------- 7 files changed, 9 insertions(+), 37 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs index 57e543e756..a3f22cbbb2 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs @@ -300,17 +300,14 @@ loadSkovPersistentData rp _treeStateDirectory pbsc atiContext = do -- But this behaviour of LMDB is poorly documented, so we might experience issues. _db <- either (logExceptionAndThrowTS . DatabaseOpeningError) return =<< liftIO (try $ databaseHandlers _treeStateDirectory) - logEvent GlobalState LLDebug "Checking database version." -- Check that the database version matches what we expect. liftIO (checkDatabaseVersion _db) >>= either (logExceptionAndThrowTS . IncorrectDatabaseVersion) return - logEvent GlobalState LLDebug "Checked database version." -- Get the genesis block and check that its data matches the supplied genesis data. genStoredBlock <- maybe (logExceptionAndThrowTS GenesisBlockNotInDataBaseError) return =<< liftIO (getFirstBlock _db) - logEvent GlobalState LLDebug "Got first block." _genesisBlockPointer <- liftIO $ makeBlockPointer genStoredBlock _genesisData <- case _bpBlock _genesisBlockPointer of GenesisBlock gd' -> return gd' @@ -321,7 +318,6 @@ loadSkovPersistentData rp _treeStateDirectory pbsc atiContext = do Left s -> logExceptionAndThrowTS $ DatabaseInvariantViolation s Right hm -> return $! HM.map BlockFinalized hm - logEvent GlobalState LLDebug "Getting last finalized block." -- Get the last finalized block. (_lastFinalizationRecord, lfStoredBlock) <- liftIO (getLastBlock _db) >>= \case Left s -> logExceptionAndThrowTS $ DatabaseInvariantViolation s diff --git a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs index 2cd3ac9df8..05ad44dbab 100644 --- a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs @@ -85,26 +85,6 @@ data AddTransactionResult = NotAdded !TVer.VerificationResult deriving(Eq, Show) --- |Information about the genesis block of the chain. This is not the full --- genesis block. It does not include the genesis state. Instead, it is the --- minimal information needed by a running consensus. -data GenesisConfiguration = GenesisConfiguration { - -- |Genesis parameters. - _gcCore :: !CoreGenesisParameters, - -- |Hash of the current genesis block. Each protocol update introduces a new - -- genesis block. - _gcCurrentHash :: !BlockHash, - -- |Hash of the genesis block of the chain. - _gcFirstGenesis :: !BlockHash - } deriving (Eq, Show) - -instance BasicGenesisData GenesisConfiguration where - gdGenesisTime = gdGenesisTime . _gcCore - gdSlotDuration = gdSlotDuration . _gcCore - gdMaxBlockEnergy = gdMaxBlockEnergy . _gcCore - gdFinalizationParameters = gdFinalizationParameters . _gcCore - gdEpochLength = gdEpochLength . _gcCore - -- |Monad that provides operations for working with the low-level tree state. -- These operations are abstracted where possible to allow for a range of implementation -- choices. diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs index 55a7714009..1dcd3c58bb 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/ProtocolP2.hs @@ -65,7 +65,6 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol -import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The hash that identifies a update from P1 to P2 protocol. -- This is the hash of the published specification document. diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs index fd05fcb2e5..b9d5ec6d60 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P1/Reboot.hs @@ -70,7 +70,6 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol -import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The data required to perform a P1.Reboot update. data UpdateData = UpdateData diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs index 6a9a096baf..3d56e4e6e1 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P2/ProtocolP3.hs @@ -65,7 +65,6 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol -import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The hash that identifies a update from P2 to P3 protocol. -- This is the hash of the published specification document. diff --git a/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs b/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs index 616e348b6c..bfc4d12a79 100644 --- a/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs +++ b/concordium-consensus/src/Concordium/ProtocolUpdate/P3/ProtocolP4.hs @@ -70,7 +70,6 @@ import Concordium.GlobalState.BlockMonads import Concordium.GlobalState.BlockPointer import Concordium.GlobalState.BlockState import Concordium.Kontrol -import Concordium.GlobalState.TreeState (GenesisConfiguration(..)) -- |The hash that identifies a update from P3 to P4 protocol. -- This is the hash of the published specification document. diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs b/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs index 138432f5ec..e5a166d109 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs @@ -38,7 +38,7 @@ import Concordium.Skov.Monad import Concordium.Skov.MonadImplementations import Concordium.Afgjort.Finalize import Concordium.Birk.Bake -import Concordium.Types (Energy(..), AccountAddress, protocolVersion) +import Concordium.Types (BlockHash, Energy(..), AccountAddress, protocolVersion) import Concordium.Startup (defaultFinalizationParameters, makeBakersByStake) import ConcordiumTests.Konsensus hiding (tests) @@ -90,7 +90,7 @@ runKonsensus steps g states es continue fs' es' -- |Create initial states where the first baker is a dictator with respect to finalization. -initialiseStatesDictator :: Int -> PropertyM IO States +initialiseStatesDictator :: Int -> PropertyM IO (States, BlockHash) initialiseStatesDictator n = do let bakerAmt = 1000000 stakes = (2*bakerAmt) : replicate (n-1) bakerAmt @@ -125,9 +125,9 @@ initialiseStatesDictator n = do ) bis return $ (Vec.fromList res) -simpleCatchUpCheck :: States -> Property -simpleCatchUpCheck ss = - conjoin [monadicIO $ catchUpCheck s1 s2 | s1 <- toList ss, s2 <- toList ss ] +simpleCatchUpCheck :: BlockHash -> States -> Property +simpleCatchUpCheck genHash ss = + conjoin [monadicIO $ catchUpCheck genHash s1 s2 | s1 <- toList ss, s2 <- toList ss ] type TrivialHandlers = SkovHandlers PV DummyTimer (Config DummyTimer) LogIO @@ -145,8 +145,8 @@ trivialEvalSkovT a ctx st = liftIO $ flip runLoggerT doLog $ evalSkovT a trivial doLog src LLError msg = error $ show src ++ ": " ++ msg doLog _ _ _ = return () -catchUpCheck :: (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> PropertyM IO Bool -catchUpCheck (_, _, _, c1, s1) (_, _, _, c2, s2) = do +catchUpCheck :: BlockHash -> (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> PropertyM IO Bool +catchUpCheck genHash (_, _, _, c1, s1) (_, _, _, c2, s2) = do request <- myLoggedEvalSkovT (getCatchUpStatus True) c1 s1 (response, result) <- trivialEvalSkovT (handleCatchUpStatus request 2000) c2 s2 let @@ -219,10 +219,10 @@ catchUpCheck (_, _, _, c1, s1) (_, _, _, c2, s2) = do doCatchUpCheck :: Int -> Int -> Property doCatchUpCheck n steps = monadicIO $ do - s0 <- initialiseStatesDictator n + (s0, genHash) <- initialiseStatesDictator n gen <- pick $ mkStdGen <$> arbitrary s1 <- liftIO $ runKonsensus steps gen s0 (makeExecState $ initialEvents s0) - return $ simpleCatchUpCheck s1 + return $ simpleCatchUpCheck genHash s1 tests :: Word -> Spec tests lvl = parallel $ describe "Concordium.CatchUp" $ do From cb4cd532b10953c5a325d8bc1081d3b68eb919e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Sat, 21 May 2022 18:42:09 +0200 Subject: [PATCH 03/13] Avoid decoding the initial genesis if the state already exists. --- concordium-consensus/src/Concordium/MultiVersion.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs index 41be54949a..e315aa7363 100644 --- a/concordium-consensus/src/Concordium/MultiVersion.hs +++ b/concordium-consensus/src/Concordium/MultiVersion.hs @@ -475,7 +475,6 @@ checkForProtocolUpdate = liftSkov body ) => VersionedSkovM gc fc pv () body = do - logEvent Kontrol LLDebug "Checking for protocol update." Skov.getProtocolUpdateStatus >>= \case ProtocolUpdated pu -> case checkUpdate @pv pu of Left err -> do @@ -486,9 +485,7 @@ checkForProtocolUpdate = liftSkov body callbacks <- asks mvCallbacks liftIO (notifyRegenesis callbacks Nothing) Right upd -> do - logEvent Kontrol LLDebug "Got protocol update status." regenesis <- updateRegenesis upd - logEvent Kontrol LLDebug "Got regenesis." lfbHeight <- bpHeight <$> lastFinalizedBlock latestEraGenesisHeight <- lift $ MVR $ \mvr -> do From 461d59f466526744773bdd4a1e2c4d8e802cd163 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Thu, 26 May 2022 19:27:11 +0200 Subject: [PATCH 04/13] Use CredentialRegistrationIDRaw instead of CredentialRegistrationID. The effect of this is slightly less memory use (48 bytes for credId vs. 3 * 48) as well as significantly faster loading of credentials since deserialization is very cheap, compared to the previous one which was hundres of microseconds. --- .../src/Concordium/GlobalState/Account.hs | 15 +++++----- .../GlobalState/Basic/BlockState/Account.hs | 10 +++---- .../GlobalState/Basic/BlockState/Accounts.hs | 8 +++--- .../src/Concordium/GlobalState/BlockState.hs | 4 +-- .../GlobalState/Persistent/Account.hs | 7 ++--- .../GlobalState/Persistent/Accounts.hs | 15 +++++----- .../GlobalState/Persistent/BlockState.hs | 2 +- .../Concordium/GlobalState/Persistent/Trie.hs | 2 +- .../src/Concordium/GlobalState/TreeState.hs | 3 +- .../src/Concordium/Scheduler.hs | 28 ++++++++++--------- .../Concordium/Scheduler/InvokeContract.hs | 2 +- 11 files changed, 50 insertions(+), 46 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs index 370b9c9319..e3f677db47 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs @@ -32,11 +32,11 @@ import Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule -- |A list of credential IDs that have been removed from an account. data RemovedCredentials = EmptyRemovedCredentials - | RemovedCredential !CredentialRegistrationID !RemovedCredentials + | RemovedCredential !CredentialRegistrationIDRaw !RemovedCredentials deriving (Eq) -- |Convert a 'RemovedCredentials' to a list of 'CredentialRegistrationID's. -removedCredentialsToList :: RemovedCredentials -> [CredentialRegistrationID] +removedCredentialsToList :: RemovedCredentials -> [CredentialRegistrationIDRaw] removedCredentialsToList EmptyRemovedCredentials = [] removedCredentialsToList (RemovedCredential cred rest) = cred : removedCredentialsToList rest @@ -59,7 +59,7 @@ emptyRemovedCredentialsHash = Hash.hash "E" {-# NOINLINE emptyRemovedCredentialsHash #-} -- |Function for determining the hash of a 'RemovedCredential'. -removedCredentialHash :: CredentialRegistrationID -> Hash.Hash -> Hash.Hash +removedCredentialHash :: CredentialRegistrationIDRaw -> Hash.Hash -> Hash.Hash removedCredentialHash cred hrest = Hash.hash $ "R" <> encode cred <> Hash.hashToByteString hrest instance HashableTo Hash.Hash RemovedCredentials where @@ -67,7 +67,7 @@ instance HashableTo Hash.Hash RemovedCredentials where getHash (RemovedCredential cred rest) = removedCredentialHash cred (getHash rest) -- |Update hashed remove credentials with a new removed credentials. -addRemovedCredential :: CredentialRegistrationID -> Hashed RemovedCredentials -> Hashed RemovedCredentials +addRemovedCredential :: CredentialRegistrationIDRaw -> Hashed RemovedCredentials -> Hashed RemovedCredentials addRemovedCredential cred hrc = Hashed (RemovedCredential cred (hrc ^. unhashed)) (removedCredentialHash cred (getHash hrc)) -- |Hashed 'EmptyRemovedCredentials'. @@ -87,7 +87,7 @@ data PersistingAccountData = PersistingAccountData { ,_accountVerificationKeys :: !AccountInformation -- |Current credentials. This map is always non-empty and (presently) -- will have a credential at index 'initialCredentialIndex' (0) that cannot be changed. - ,_accountCredentials :: !(Map.Map CredentialIndex AccountCredential) + ,_accountCredentials :: !(Map.Map CredentialIndex AccountCredentialRaw) -- |Credential IDs of removed credentials. ,_accountRemovedCredentials :: !(Hashed RemovedCredentials) } @@ -274,15 +274,16 @@ updateAccountInformation threshold addCreds remove (AccountInformation oldCredKe -- * Any new threshold is at most the number of accounts remaining (and at least 1). updateCredentials :: (HasPersistingAccountData d) => [CredentialIndex] -> Map.Map CredentialIndex AccountCredential -> AccountThreshold -> d -> d updateCredentials cuRemove cuAdd cuAccountThreshold d = - d & (accountCredentials %~ Map.union cuAdd . removeKeys) + d & (accountCredentials %~ Map.union (Map.map toRawAccountCredential cuAdd) . removeKeys) & (accountVerificationKeys %~ updateAccountInformation cuAccountThreshold cuAdd cuRemove) & (accountRemovedCredentials %~ flip (foldl' (flip (addRemovedCredential . removedCredentialId))) cuRemove) where removeKeys = flip (foldl' (flip Map.delete)) cuRemove + removedCredentialId :: CredentialIndex -> CredentialRegistrationIDRaw removedCredentialId cix = credId $ Map.findWithDefault (error "Removed credential key not found") cix (d ^. accountCredentials) -- |Update the keys of the given account credential. -updateCredKeyInAccountCredential :: AccountCredential -> CredentialPublicKeys -> AccountCredential +updateCredKeyInAccountCredential :: AccountCredential' credTy -> CredentialPublicKeys -> AccountCredential' credTy updateCredKeyInAccountCredential (InitialAC icdv) keys = InitialAC (icdv{icdvAccount=keys}) updateCredKeyInAccountCredential (NormalAC cdv comms) keys = NormalAC (cdv{cdvPublicKeys=keys}) comms diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs index 6308c4865b..1657a6e690 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs @@ -125,8 +125,8 @@ serializeAccount cryptoParams acct@Account{..} = do initialCredentialIndex _accountCredentials ) - asfExplicitAddress = _accountAddress /= addressFromRegId initialCredId - asfExplicitEncryptionKey = _accountEncryptionKey /= makeEncryptionKey cryptoParams initialCredId + asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId + asfExplicitEncryptionKey = False -- _accountEncryptionKey /= makeEncryptionKey cryptoParams initialCredId (asfMultipleCredentials, putCredentials) = case Map.toList _accountCredentials of [(i, cred)] | i == initialCredentialIndex -> (False, S.put cred) _ -> (True, putSafeMapOf S.put S.put _accountCredentials) @@ -160,8 +160,8 @@ deserializeAccount migration cryptoParams = do (_accountCredentials, initialCredId) <- getCredentials _accountRemovedCredentials <- if asfHasRemovedCredentials then makeHashed <$> S.get else return emptyHashedRemovedCredentials let _accountVerificationKeys = getAccountInformation threshold _accountCredentials - let _accountAddress = fromMaybe (addressFromRegId initialCredId) preAddress - _accountEncryptionKey = fromMaybe (makeEncryptionKey cryptoParams initialCredId) preEncryptionKey + let _accountAddress = fromMaybe (addressFromRegIdRaw initialCredId) preAddress + _accountEncryptionKey = fromMaybe (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId)) preEncryptionKey _accountNonce <- S.get _accountAmount <- S.get _accountEncryptedAmount <- if asfExplicitEncryptedAmount then S.get else return initialAccountEncryptedAmount @@ -197,7 +197,7 @@ newAccountMultiCredential :: forall av. (IsAccountVersion av) newAccountMultiCredential cryptoParams threshold _accountAddress cs = Account { _accountPersisting = makeAccountPersisting PersistingAccountData { _accountEncryptionKey = makeEncryptionKey cryptoParams (credId (cs Map.! initialCredentialIndex)), - _accountCredentials = cs, + _accountCredentials = toRawAccountCredential <$> cs, _accountVerificationKeys = getAccountInformation threshold cs, _accountRemovedCredentials = emptyHashedRemovedCredentials, .. diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs index 59c379933d..61a1a9c1bc 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs @@ -46,7 +46,7 @@ data Accounts (pv :: ProtocolVersion) = Accounts { -- |Hashed Merkle-tree of the accounts. accountTable :: !(AT.AccountTable (AccountVersionFor pv)), -- |A mapping of 'ID.CredentialRegistrationID's to accounts on which they are used. - accountRegIds :: !(Map.Map ID.CredentialRegistrationID AccountIndex) + accountRegIds :: !(Map.Map ID.CredentialRegistrationIDRaw AccountIndex) } instance IsProtocolVersion pv => Show (Accounts pv) where @@ -166,16 +166,16 @@ addressWouldClash addr Accounts{..} = AccountMap.addressWouldClashPure addr acco -- is the account index of the account is or was associated with, and @Nothing@ -- otherwise. regIdExists :: ID.CredentialRegistrationID -> Accounts pv -> Maybe AccountIndex -regIdExists rid Accounts{..} = rid `Map.lookup` accountRegIds +regIdExists rid Accounts{..} = ID.toRawCredId rid `Map.lookup` accountRegIds -- |Record an account registration ID as used on the account. -recordRegId :: ID.CredentialRegistrationID -> AccountIndex -> Accounts pv -> Accounts pv +recordRegId :: ID.CredentialRegistrationIDRaw -> AccountIndex -> Accounts pv -> Accounts pv recordRegId rid idx accs = accs { accountRegIds = Map.insert rid idx (accountRegIds accs) } -- |Record multiple registration ids as used. This implementation is marginally -- more efficient than repeatedly calling `recordRegId`. recordRegIds :: [(ID.CredentialRegistrationID, AccountIndex)] -> Accounts pv -> Accounts pv -recordRegIds rids accs = accs { accountRegIds = Map.union (accountRegIds accs) (Map.fromAscList rids) } +recordRegIds rids accs = accs { accountRegIds = Map.union (accountRegIds accs) (Map.fromAscList . map (\(x, y) -> (ID.toRawCredId x, y)) $ rids) } -- since credentials can only be used on one account the union is well-defined, the maps should be disjoint. instance HashableTo H.Hash (Accounts pv) where diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 7b26635a4e..28af5aa714 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -164,7 +164,7 @@ class (BlockStateTypes m, Monad m) => AccountOperations m where -- |Get the list of credentials deployed on the account, ordered from most -- recently deployed. The list should be non-empty. - getAccountCredentials :: Account m -> m (Map.Map ID.CredentialIndex AccountCredential) + getAccountCredentials :: Account m -> m (Map.Map ID.CredentialIndex ID.AccountCredentialRaw) -- |Get the key used to verify transaction signatures, it records the signature scheme used as well getAccountVerificationKeys :: Account m -> m ID.AccountInformation @@ -371,7 +371,7 @@ class (ContractStateOperations m, AccountOperations m) => BlockStateQuery m wher getActiveBakersAndDelegators :: (AccountVersionFor (MPV m) ~ 'AccountV1) => BlockState m -> m ([ActiveBakerInfo m], [ActiveDelegatorInfo]) -- |Query an account by the id of the credential that belonged to it. - getAccountByCredId :: BlockState m -> CredentialRegistrationID -> m (Maybe (AccountIndex, Account m)) + getAccountByCredId :: BlockState m -> ID.CredentialRegistrationIDRaw -> m (Maybe (AccountIndex, Account m)) -- |Query an account by the account index that belonged to it. getAccountByIndex :: BlockState m -> AccountIndex -> m (Maybe (AccountIndex, Account m)) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs index 31eadf9166..f60bf7ae9e 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs @@ -420,7 +420,6 @@ data PersistentAccount (av :: AccountVersion) = PersistentAccount { -- |A pointer to account data that changes rarely ,_persistingData :: !AccountPersisting -- |The baker info - --,_accountBaker :: !(Nullable (BufferedRef PersistentAccountBaker)) ,_accountStake :: !(PersistentAccountStake av) -- |A hash of all account data. We store the hash explicitly here because we cannot compute the hash once -- the persisting account data is stored behind a pointer @@ -520,7 +519,7 @@ newAccount cryptoParams _accountAddress credential = do let creds = Map.singleton initialCredentialIndex credential let newPData = PersistingAccountData { _accountEncryptionKey = makeEncryptionKey cryptoParams (credId credential), - _accountCredentials = creds, + _accountCredentials = toRawAccountCredential <$> creds, _accountVerificationKeys = getAccountInformation 1 creds, _accountRemovedCredentials = emptyHashedRemovedCredentials, .. @@ -759,8 +758,8 @@ serializeAccount cryptoParams PersistentAccount{..} = do initialCredentialIndex _accountCredentials ) - asfExplicitAddress = _accountAddress /= addressFromRegId initialCredId - asfExplicitEncryptionKey = _accountEncryptionKey /= makeEncryptionKey cryptoParams initialCredId + asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId + asfExplicitEncryptionKey = _accountEncryptionKey /= makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId) (asfMultipleCredentials, putCredentials) = case Map.toList _accountCredentials of [(i, cred)] | i == initialCredentialIndex -> (False, put cred) _ -> (True, putSafeMapOf put put _accountCredentials) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs index bffab07549..df8ac0af0e 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs @@ -61,9 +61,9 @@ data Accounts (pv :: ProtocolVersion) = Accounts { -- |Hashed Merkle-tree of the accounts accountTable :: !(LFMBTree AccountIndex HashedBufferedRef (PersistentAccount (AccountVersionFor pv))), -- |Optional cached set of used 'ID.CredentialRegistrationID's - accountRegIds :: !(Nullable (Map.Map ID.CredentialRegistrationID AccountIndex)), + accountRegIds :: !(Nullable (Map.Map ID.CredentialRegistrationIDRaw AccountIndex)), -- |Persisted representation of the map from registration ids to account indices. - accountRegIdHistory :: !(Trie.TrieN (BufferedBlobbed BlobRef) ID.CredentialRegistrationID AccountIndex) + accountRegIdHistory :: !(Trie.TrieN (BufferedBlobbed BlobRef) ID.CredentialRegistrationIDRaw AccountIndex) } -- |Convert a (non-persistent) 'Transient.Accounts' to a (persistent) 'Accounts'. @@ -95,7 +95,7 @@ instance MonadBlobStore m => BlobStorable m RegIdHistory -- |Load the registration ids. If 'accountRegIds' is @Null@, then 'accountRegIdHistory' -- is used (reading from disk as necessary) to determine it, in which case 'accountRegIds' -- is updated with the determined value. -loadRegIds :: forall m pv. MonadBlobStore m => Accounts pv -> m (Map.Map ID.CredentialRegistrationID AccountIndex, Accounts pv) +loadRegIds :: forall m pv. MonadBlobStore m => Accounts pv -> m (Map.Map ID.CredentialRegistrationIDRaw AccountIndex, Accounts pv) loadRegIds a@Accounts{accountRegIds = Some regids} = return (regids, a) loadRegIds a@Accounts{accountRegIds = Null, ..} = do regids <- Trie.toMap accountRegIdHistory @@ -167,7 +167,7 @@ getAccount addr Accounts{..} = AccountMap.lookup addr accountMap >>= \case -- |Retrieve an account associated with the given credential registration ID. -- Returns @Nothing@ if no such account exists. -getAccountByCredId :: (MonadBlobStore m, IsProtocolVersion pv) => ID.CredentialRegistrationID -> Accounts pv -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) +getAccountByCredId :: (MonadBlobStore m, IsProtocolVersion pv) => ID.CredentialRegistrationIDRaw -> Accounts pv -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) getAccountByCredId cid accs@Accounts{accountRegIds = Null,..} = Trie.lookup cid accountRegIdHistory >>= \case Nothing -> return Nothing Just ai -> fmap (ai, ) <$> indexedAccount ai accs @@ -210,14 +210,15 @@ addressWouldClash addr Accounts{..} = AccountMap.addressWouldClash addr accountM regIdExists :: MonadBlobStore m => ID.CredentialRegistrationID -> Accounts pv -> m (Maybe AccountIndex, Accounts pv) regIdExists rid accts0 = do (regids, accts) <- loadRegIds accts0 - return (rid `Map.lookup` regids, accts) + return (ID.toRawCredId rid `Map.lookup` regids, accts) -- |Record an account registration ID as used. recordRegId :: MonadBlobStore m => ID.CredentialRegistrationID -> AccountIndex -> Accounts pv -> m (Accounts pv) recordRegId rid idx accts0 = do - accountRegIdHistory' <- Trie.insert rid idx (accountRegIdHistory accts0) + let rrid = ID.toRawCredId rid + accountRegIdHistory' <- Trie.insert rrid idx (accountRegIdHistory accts0) return $! accts0 { - accountRegIds = Map.insert rid idx <$> accountRegIds accts0, + accountRegIds = Map.insert rrid idx <$> accountRegIds accts0, accountRegIdHistory = accountRegIdHistory' } diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 6e2e979adc..03bcb05135 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -1664,7 +1664,7 @@ doGetActiveBakers pbs = do ab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers Trie.keysAsc (ab ^. activeBakers) -doGetAccountByCredId :: (IsProtocolVersion pv, MonadBlobStore m) => PersistentBlockState pv -> ID.CredentialRegistrationID -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) +doGetAccountByCredId :: (IsProtocolVersion pv, MonadBlobStore m) => PersistentBlockState pv -> ID.CredentialRegistrationIDRaw -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) doGetAccountByCredId pbs cid = do bsp <- loadPBS pbs Accounts.getAccountByCredId cid (bspAccounts bsp) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs index dfdce217c7..9f3f615594 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs @@ -62,7 +62,7 @@ instance FixedTrieKey AccountAddress deriving via Word64 instance FixedTrieKey BakerId deriving via Word64 instance FixedTrieKey DelegatorId instance FixedTrieKey Bls.PublicKey -- FIXME: This is a bad instance. Serialization of these is expensive. -instance FixedTrieKey IDTypes.CredentialRegistrationID -- FIXME: this is not the best instance, serialization is expensive. +instance FixedTrieKey IDTypes.CredentialRegistrationIDRaw -- |Class for Trie keys that respect the 'Ord' instance. -- That is, @a `compare` b == unpackKey a `compare` unpackKey b@. diff --git a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs index 05ad44dbab..277da58427 100644 --- a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs @@ -47,6 +47,7 @@ import Concordium.Common.Version (Version) import qualified Concordium.GlobalState.Block as B import Data.Bits import qualified Concordium.TransactionVerification as TVer +import Concordium.ID.Types (toRawCredId) data BlockStatus bp pb = BlockAlive !bp @@ -577,7 +578,7 @@ instance (Monad m, {-# INLINE registrationIdExists #-} registrationIdExists regId = do ctx <- ask - lift $ isJust <$> getAccountByCredId (ctx ^. ctxBs) regId + lift $ isJust <$> getAccountByCredId (ctx ^. ctxBs) (toRawCredId regId) {-# INLINE getAccount #-} getAccount aaddr = do ctx <- ask diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs index e900b47876..95c6cdcdfa 100644 --- a/concordium-consensus/src/Concordium/Scheduler.hs +++ b/concordium-consensus/src/Concordium/Scheduler.hs @@ -92,6 +92,7 @@ import Concordium.Types.Accounts hiding (getAccountStake) import Concordium.Scheduler.WasmIntegration.V1 (ReceiveResultData(rrdCurrentState)) import Concordium.Wasm (IsWasmVersion) import qualified Concordium.GlobalState.ContractStateV1 as StateV1 +import Concordium.ID.Types (toRawCredId) -- |The function asserts the following @@ -934,7 +935,7 @@ checkAndGetBalanceAccountV1 :: (TransactionMonad m, AccountOperations m) => AccountAddress -- ^Used address -> IndexedAccount m -> Amount - -> m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) + -> m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) checkAndGetBalanceAccountV1 usedAddress senderAccount transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Right (usedAddress, senderAccount)) senderamount <- getCurrentAccountAvailableAmount senderAccount @@ -951,7 +952,7 @@ checkAndGetBalanceAccountV0 :: (TransactionMonad m, AccountOperations m) => AccountAddress -- ^Used address -> IndexedAccount m -> Amount - -> m (Address, [ID.AccountCredential], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) + -> m (Address, [ID.AccountCredentialRaw], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) checkAndGetBalanceAccountV0 usedAddress senderAccount transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Right (usedAddress, senderAccount)) senderamount <- getCurrentAccountAvailableAmount senderAccount @@ -967,7 +968,7 @@ checkAndGetBalanceInstanceV1 :: forall m vOrigin . (TransactionMonad m, AccountO => IndexedAccount m -> UInstanceInfoV m vOrigin -> Amount - -> m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredential], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) + -> m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredentialRaw], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) checkAndGetBalanceInstanceV1 ownerAccount istance transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Left (ownerAccount, instanceAddress istance)) senderamount <- getCurrentContractAmount (Wasm.getWasmVersion @vOrigin) istance @@ -983,7 +984,7 @@ checkAndGetBalanceInstanceV0 :: forall m vOrigin . (TransactionMonad m, AccountO => IndexedAccount m -> UInstanceInfoV m vOrigin -> Amount - -> m (Address, [ID.AccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress) + -> m (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress) checkAndGetBalanceInstanceV0 ownerAccount istance transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Left (ownerAccount, instanceAddress istance)) senderamount <- getCurrentContractAmount (Wasm.getWasmVersion @vOrigin) istance @@ -1001,7 +1002,7 @@ handleContractUpdateV1 :: forall r m. (StaticInformation m, AccountOperations m, ContractStateOperations m, MonadProtocolVersion m) => AccountAddress -- ^The address that was used to send the top-level transaction. -> UInstanceInfoV m GSWasm.V1 -- ^The current state of the target contract of the transaction, which must exist. - -> (Amount -> LocalT r m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) + -> (Amount -> LocalT r m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) -- ^Check that the sender has sufficient amount to cover the given amount and return a triple of -- - used address -- - credentials of the address, either account or owner of the contract @@ -1176,7 +1177,7 @@ handleContractUpdateV1 originAddr istance checkAndGetSender transferAmount recei Just targetAccount -> -- Add the transfer to the current changeset and return the corresponding event. lift (withContractToAccountAmountV1 (instanceAddress senderInstance) targetAccount tAmount $ - return [Transferred addr transferAmount (AddressAccount accAddr)]) + return [Transferred addr tAmount (AddressAccount accAddr)]) -- | Invoke a V0 contract and process any generated messages. @@ -1187,7 +1188,7 @@ handleContractUpdateV0 :: forall r m. (StaticInformation m, AccountOperations m, ContractStateOperations m, MonadProtocolVersion m) => AccountAddress -- ^The address that was used to send the top-level transaction. -> UInstanceInfoV m GSWasm.V0 -- ^The current state of the target contract of the transaction, which must exist. - -> (Amount -> LocalT r m (Address, [ID.AccountCredential], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) + -> (Amount -> LocalT r m (Address, [ID.AccountCredentialRaw], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) -- ^The sender of the message (contract instance or account). In case this is -- a contract the first parameter is the owner account of the instance. In case this is an account -- (i.e., this is called from a top-level transaction) the value is a pair of the address that was used @@ -1321,7 +1322,7 @@ foldEvents originAddr istance initEvent = fmap (initEvent:) . go -- will be a contract address, and the credentials will be of the owner account. mkSenderAddrCredentials :: AccountOperations m => Either (IndexedAccount m, ContractAddress) (AccountAddress, IndexedAccount m) - -> m (Address, [ID.AccountCredential]) + -> m (Address, [ID.AccountCredentialRaw]) mkSenderAddrCredentials sender = case sender of Left (ownerAccount, iaddr) -> do @@ -2027,8 +2028,8 @@ handleUpdateCredentialKeys wtc cid keys sigs = c = do existingCredentials <- getAccountCredentials (snd senderAccount) tickEnergy $ Cost.updateCredentialKeysCost (OrdMap.size existingCredentials) $ length $ ID.credKeys keys - - let credIndex = fst <$> find (\(_, v) -> ID.credId v == cid) (OrdMap.toList existingCredentials) + let rcid = toRawCredId cid + let credIndex = fst <$> find (\(_, v) -> ID.credId v == rcid) (OrdMap.toList existingCredentials) -- check that the new threshold is no more than the number of credentials let thresholdCheck = toInteger (OrdMap.size (ID.credKeys keys)) >= toInteger (ID.credThreshold keys) @@ -2186,9 +2187,10 @@ handleUpdateCredentials wtc cdis removeRegIds threshold = -- map to the unique key index. Thus the following map is well-defined. let existingCredIds = OrdMap.fromList . map (\(ki, v) -> (ID.credId v, ki)) . OrdMap.toList $ existingCredentials in foldl' (\(nonExisting, existing, remList) rid -> - case rid `OrdMap.lookup` existingCredIds of - Nothing -> (rid:nonExisting, existing, remList) - Just ki -> (nonExisting, Set.insert ki existing, if Set.member ki existing then remList else ki : remList) + let rrid = toRawCredId rid + in case rrid `OrdMap.lookup` existingCredIds of + Nothing -> (rid:nonExisting, existing, remList) + Just ki -> (nonExisting, Set.insert ki existing, if Set.member ki existing then remList else ki : remList) ) ([], Set.empty, []) removeRegIds -- check that the indices after removal are disjoint from the indices that we are about to add diff --git a/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs b/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs index d607857cec..bf32dbbdce 100644 --- a/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs +++ b/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs @@ -107,7 +107,7 @@ invokeContract ContractContext{..} cm bs = do (Either (Maybe RejectReason) -- Invocation failed because the relevant contract/account does not exist. ( -- Check that the requested account or contract has enough balance. - Amount -> LocalT r (InvokeContractMonad m) (Address, [ID.AccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress), + Amount -> LocalT r (InvokeContractMonad m) (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress), AccountAddress, -- Address of the invoker account, or of its owner if the invoker is a contract. AccountIndex -- And its index. )) From 49bf116a045fca8375710f273a7d9a8705805a4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Fri, 27 May 2022 10:50:42 +0200 Subject: [PATCH 05/13] Use raw account encryption key in the state. --- concordium-consensus/src/Concordium/GlobalState/Account.hs | 2 +- .../src/Concordium/GlobalState/Basic/BlockState.hs | 4 ++-- .../src/Concordium/GlobalState/Basic/BlockState/Account.hs | 6 +++--- .../src/Concordium/GlobalState/BlockState.hs | 2 +- .../src/Concordium/GlobalState/Persistent/Account.hs | 4 ++-- .../src/Concordium/GlobalState/Persistent/BlockState.hs | 3 ++- 6 files changed, 11 insertions(+), 10 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs index e3f677db47..a480a7305e 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs @@ -80,7 +80,7 @@ data PersistingAccountData = PersistingAccountData { -- |Address of the account _accountAddress :: !AccountAddress -- |Account encryption key (for encrypted amounts) - ,_accountEncryptionKey :: !AccountEncryptionKey + ,_accountEncryptionKey :: !AccountEncryptionKeyRaw -- |Account signature verification keys. Except for the threshold, -- these are derived from the account credentials, and are provided -- for convenience. diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState.hs index aa92b24b0b..301aa4aff7 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState.hs @@ -67,7 +67,7 @@ import Concordium.GlobalState.Basic.BlockState.Updates import qualified Concordium.Types.Transactions as Transactions import Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule import Concordium.Types.SeedState -import Concordium.ID.Types (credId, ArIdentity, IdentityProviderIdentity) +import Concordium.ID.Types (credId, ArIdentity, IdentityProviderIdentity, unsafeEncryptionKeyFromRaw) import qualified Concordium.Crypto.SHA256 as H import Concordium.Types.HashableTo import Concordium.Kontrol.Bakers @@ -858,7 +858,7 @@ instance (Monad m, IsProtocolVersion pv) => BS.AccountOperations (PureBlockState getAccountEncryptedAmount acc = return $ acc ^. accountEncryptedAmount - getAccountEncryptionKey acc = return $ acc ^. accountEncryptionKey + getAccountEncryptionKey acc = return $ unsafeEncryptionKeyFromRaw (acc ^. accountEncryptionKey) getAccountReleaseSchedule acc = return $ acc ^. accountReleaseSchedule diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs index 1657a6e690..f62973258b 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs @@ -126,7 +126,7 @@ serializeAccount cryptoParams acct@Account{..} = do _accountCredentials ) asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId - asfExplicitEncryptionKey = False -- _accountEncryptionKey /= makeEncryptionKey cryptoParams initialCredId + asfExplicitEncryptionKey = unsafeEncryptionKeyFromRaw _accountEncryptionKey /= makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId) -- TODO: No need to deserialize (asfMultipleCredentials, putCredentials) = case Map.toList _accountCredentials of [(i, cred)] | i == initialCredentialIndex -> (False, S.put cred) _ -> (True, putSafeMapOf S.put S.put _accountCredentials) @@ -161,7 +161,7 @@ deserializeAccount migration cryptoParams = do _accountRemovedCredentials <- if asfHasRemovedCredentials then makeHashed <$> S.get else return emptyHashedRemovedCredentials let _accountVerificationKeys = getAccountInformation threshold _accountCredentials let _accountAddress = fromMaybe (addressFromRegIdRaw initialCredId) preAddress - _accountEncryptionKey = fromMaybe (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId)) preEncryptionKey + _accountEncryptionKey = fromMaybe (toRawEncryptionKey (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId))) preEncryptionKey -- TODO: No need to deserialize _accountNonce <- S.get _accountAmount <- S.get _accountEncryptedAmount <- if asfExplicitEncryptedAmount then S.get else return initialAccountEncryptedAmount @@ -196,7 +196,7 @@ newAccountMultiCredential :: forall av. (IsAccountVersion av) -> Account av newAccountMultiCredential cryptoParams threshold _accountAddress cs = Account { _accountPersisting = makeAccountPersisting PersistingAccountData { - _accountEncryptionKey = makeEncryptionKey cryptoParams (credId (cs Map.! initialCredentialIndex)), + _accountEncryptionKey = toRawEncryptionKey (makeEncryptionKey cryptoParams (credId (cs Map.! initialCredentialIndex))), _accountCredentials = toRawAccountCredential <$> cs, _accountVerificationKeys = getAccountInformation threshold cs, _accountRemovedCredentials = emptyHashedRemovedCredentials, diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 28af5aa714..7adbc16201 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -84,7 +84,7 @@ import Concordium.Types.Transactions hiding (BareBlockItem(..)) import qualified Concordium.ID.Types as ID import Concordium.ID.Parameters(GlobalContext) -import Concordium.ID.Types (AccountCredential, CredentialRegistrationID) +import Concordium.ID.Types (AccountCredential) import Concordium.Crypto.EncryptedTransfers import Concordium.GlobalState.ContractStateFFIHelpers (LoadCallback) import qualified Concordium.GlobalState.ContractStateV1 as StateV1 diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs index f60bf7ae9e..6cf4c6f867 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs @@ -518,7 +518,7 @@ newAccount :: forall m av. (MonadBlobStore m, IsAccountVersion av) newAccount cryptoParams _accountAddress credential = do let creds = Map.singleton initialCredentialIndex credential let newPData = PersistingAccountData { - _accountEncryptionKey = makeEncryptionKey cryptoParams (credId credential), + _accountEncryptionKey = toRawEncryptionKey (makeEncryptionKey cryptoParams (credId credential)), _accountCredentials = toRawAccountCredential <$> creds, _accountVerificationKeys = getAccountInformation 1 creds, _accountRemovedCredentials = emptyHashedRemovedCredentials, @@ -759,7 +759,7 @@ serializeAccount cryptoParams PersistentAccount{..} = do _accountCredentials ) asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId - asfExplicitEncryptionKey = _accountEncryptionKey /= makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId) + asfExplicitEncryptionKey = _accountEncryptionKey /= toRawEncryptionKey (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId)) -- TODO: No need for deserialization (asfMultipleCredentials, putCredentials) = case Map.toList _accountCredentials of [(i, cred)] | i == initialCredentialIndex -> (False, put cred) _ -> (True, putSafeMapOf put put _accountCredentials) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 03bcb05135..675e4e4ec9 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -86,6 +86,7 @@ import Concordium.Utils.Serialization.Put import Concordium.Utils.Serialization import Concordium.Utils.BinarySearch import Concordium.Kontrol.Bakers +import Concordium.ID.Types (unsafeEncryptionKeyFromRaw) -- * Birk parameters @@ -2690,7 +2691,7 @@ instance (PersistentState r m, IsProtocolVersion pv) => AccountOperations (Persi getAccountEncryptedAmount acc = loadPersistentAccountEncryptedAmount =<< loadBufferedRef (acc ^. accountEncryptedAmount) - getAccountEncryptionKey acc = acc ^^. accountEncryptionKey + getAccountEncryptionKey acc = unsafeEncryptionKeyFromRaw <$> acc ^^. accountEncryptionKey getAccountReleaseSchedule acc = loadPersistentAccountReleaseSchedule =<< loadBufferedRef (acc ^. accountReleaseSchedule) From 926cdff6b41967ccd40a5fa0bd9a0349bd12cfed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Mon, 6 Jun 2022 20:56:11 +0200 Subject: [PATCH 06/13] Fix test compilation. --- concordium-base | 2 +- .../Concordium/Skov/MonadImplementations.hs | 8 -------- .../tests/consensus/ConcordiumTests/CatchUp.hs | 18 +++++++++--------- .../globalstate/GlobalStateTests/Accounts.hs | 2 +- .../tests/scheduler/GlobalStateMock.hs | 4 ++-- .../SchedulerTests/EncryptedTransfersTest.hs | 6 +++--- .../SchedulerTests/MaxIncomingAmountsTest.hs | 6 +++--- .../SchedulerTests/UpdateAccountKeys.hs | 2 +- .../SchedulerTests/UpdateCredentials.hs | 2 +- 9 files changed, 21 insertions(+), 29 deletions(-) diff --git a/concordium-base b/concordium-base index 39719621b7..9473e368ba 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit 39719621b7bc41e4b8011be55b36e374c788c7c3 +Subproject commit 9473e368ba4adb1ee83d35f3526648d89d1e479c diff --git a/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs b/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs index 580742e164..6f85d359fe 100644 --- a/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs +++ b/concordium-consensus/src/Concordium/Skov/MonadImplementations.hs @@ -353,14 +353,6 @@ data SkovHandlers pv t c m = SkovHandlers { shPendingLive :: m () } -emptySkovHandlers :: forall m pv t c . Monad m => SkovHandlers pv t c m -emptySkovHandlers = SkovHandlers { - shBroadcastFinalizationMessage = \_ -> return (), - shOnTimeout = \_ _ -> return undefined, - shCancelTimer = \ _ -> return (), - shPendingLive = return () - } - instance SkovFinalizationHandlers (SkovHandlers pv t c m) m where handleBroadcastFinalizationMessage SkovHandlers{..} = shBroadcastFinalizationMessage diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs b/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs index e5a166d109..138432f5ec 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/CatchUp.hs @@ -38,7 +38,7 @@ import Concordium.Skov.Monad import Concordium.Skov.MonadImplementations import Concordium.Afgjort.Finalize import Concordium.Birk.Bake -import Concordium.Types (BlockHash, Energy(..), AccountAddress, protocolVersion) +import Concordium.Types (Energy(..), AccountAddress, protocolVersion) import Concordium.Startup (defaultFinalizationParameters, makeBakersByStake) import ConcordiumTests.Konsensus hiding (tests) @@ -90,7 +90,7 @@ runKonsensus steps g states es continue fs' es' -- |Create initial states where the first baker is a dictator with respect to finalization. -initialiseStatesDictator :: Int -> PropertyM IO (States, BlockHash) +initialiseStatesDictator :: Int -> PropertyM IO States initialiseStatesDictator n = do let bakerAmt = 1000000 stakes = (2*bakerAmt) : replicate (n-1) bakerAmt @@ -125,9 +125,9 @@ initialiseStatesDictator n = do ) bis return $ (Vec.fromList res) -simpleCatchUpCheck :: BlockHash -> States -> Property -simpleCatchUpCheck genHash ss = - conjoin [monadicIO $ catchUpCheck genHash s1 s2 | s1 <- toList ss, s2 <- toList ss ] +simpleCatchUpCheck :: States -> Property +simpleCatchUpCheck ss = + conjoin [monadicIO $ catchUpCheck s1 s2 | s1 <- toList ss, s2 <- toList ss ] type TrivialHandlers = SkovHandlers PV DummyTimer (Config DummyTimer) LogIO @@ -145,8 +145,8 @@ trivialEvalSkovT a ctx st = liftIO $ flip runLoggerT doLog $ evalSkovT a trivial doLog src LLError msg = error $ show src ++ ": " ++ msg doLog _ _ _ = return () -catchUpCheck :: BlockHash -> (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> PropertyM IO Bool -catchUpCheck genHash (_, _, _, c1, s1) (_, _, _, c2, s2) = do +catchUpCheck :: (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> (BakerIdentity, FullBakerInfo, (SigScheme.KeyPair, AccountAddress), SkovContext (Config DummyTimer), SkovState (Config DummyTimer)) -> PropertyM IO Bool +catchUpCheck (_, _, _, c1, s1) (_, _, _, c2, s2) = do request <- myLoggedEvalSkovT (getCatchUpStatus True) c1 s1 (response, result) <- trivialEvalSkovT (handleCatchUpStatus request 2000) c2 s2 let @@ -219,10 +219,10 @@ catchUpCheck genHash (_, _, _, c1, s1) (_, _, _, c2, s2) = do doCatchUpCheck :: Int -> Int -> Property doCatchUpCheck n steps = monadicIO $ do - (s0, genHash) <- initialiseStatesDictator n + s0 <- initialiseStatesDictator n gen <- pick $ mkStdGen <$> arbitrary s1 <- liftIO $ runKonsensus steps gen s0 (makeExecState $ initialEvents s0) - return $ simpleCatchUpCheck genHash s1 + return $ simpleCatchUpCheck s1 tests :: Word -> Spec tests lvl = parallel $ describe "Concordium.CatchUp" $ do diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs index 46adde0389..e311ff5b80 100644 --- a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs +++ b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs @@ -241,7 +241,7 @@ runAccountAction (RegIdExists rid) (ba, pa) = do checkBinary (==) be pe "<->" "regid exists in basic" "regid exists in persistent" return (ba, pa') runAccountAction (RecordRegId rid ai) (ba, pa) = do - let ba' = B.recordRegId rid ai ba + let ba' = B.recordRegId (ID.toRawCredId rid) ai ba pa' <- P.recordRegId rid ai pa return (ba', pa') diff --git a/concordium-consensus/tests/scheduler/GlobalStateMock.hs b/concordium-consensus/tests/scheduler/GlobalStateMock.hs index ecbcb2ef9b..d4dba1e51e 100644 --- a/concordium-consensus/tests/scheduler/GlobalStateMock.hs +++ b/concordium-consensus/tests/scheduler/GlobalStateMock.hs @@ -71,7 +71,7 @@ data AccountOperationsAction (pv :: ProtocolVersion) a where CheckAccountIsAllowed :: MockAccount -> AccountAllowance -> AccountOperationsAction pv Bool GetAccountAvailableAmount :: MockAccount -> AccountOperationsAction pv Amount GetAccountNonce :: MockAccount -> AccountOperationsAction pv Nonce - GetAccountCredentials :: MockAccount -> AccountOperationsAction pv (Map.Map ID.CredentialIndex ID.AccountCredential) + GetAccountCredentials :: MockAccount -> AccountOperationsAction pv (Map.Map ID.CredentialIndex ID.AccountCredentialRaw) GetAccountVerificationKeys :: MockAccount -> AccountOperationsAction pv ID.AccountInformation GetAccountEncryptedAmount :: MockAccount -> AccountOperationsAction pv AccountEncryptedAmount GetAccountEncryptionKey :: MockAccount -> AccountOperationsAction pv ID.AccountEncryptionKey @@ -106,7 +106,7 @@ data BlockStateQueryAction (pv :: ProtocolVersion) a where AccountExists :: MockBlockState -> AccountAddress -> BlockStateQueryAction pv Bool GetActiveBakers :: MockBlockState -> BlockStateQueryAction pv [BakerId] GetActiveBakersAndDelegators :: (AccountVersionFor pv ~ 'AccountV1) => MockBlockState -> BlockStateQueryAction pv ([ActiveBakerInfo' MockBakerInfoRef], [ActiveDelegatorInfo]) - GetAccountByCredId :: MockBlockState -> ID.CredentialRegistrationID -> BlockStateQueryAction pv (Maybe (AccountIndex, MockAccount)) + GetAccountByCredId :: MockBlockState -> ID.CredentialRegistrationIDRaw -> BlockStateQueryAction pv (Maybe (AccountIndex, MockAccount)) GetContractInstance :: MockBlockState -> ContractAddress -> BlockStateQueryAction pv (Maybe (InstanceInfoType MockContractState)) GetModuleList :: MockBlockState -> BlockStateQueryAction pv [ModuleRef] GetAccountList :: MockBlockState -> BlockStateQueryAction pv [AccountAddress] diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/EncryptedTransfersTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/EncryptedTransfersTest.hs index 7f3774b70d..f13e840a90 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/EncryptedTransfersTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/EncryptedTransfersTest.hs @@ -16,7 +16,7 @@ import Concordium.Crypto.EncryptedTransfers import Concordium.Crypto.DummyData import Concordium.Crypto.FFIDataTypes (ElgamalSecretKey) import Concordium.ID.DummyData (dummyEncryptionSecretKey) -import Concordium.ID.Types (AccountEncryptionKey(..)) +import Concordium.ID.Types (AccountEncryptionKey(..), unsafeEncryptionKeyFromRaw) import qualified Data.ByteString.Short as BSS import Concordium.Scheduler.Types @@ -84,12 +84,12 @@ initialBlockState2 = blockStateWithAlesAccount alesEncryptionSecretKey :: ElgamalSecretKey alesEncryptionSecretKey = dummyEncryptionSecretKey dummyCryptographicParameters alesAccount alesEncryptionPublicKey :: AccountEncryptionKey -alesEncryptionPublicKey = (fromJust $ Acc.getAccount alesAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey +alesEncryptionPublicKey = unsafeEncryptionKeyFromRaw ((fromJust $ Acc.getAccount alesAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey) thomasEncryptionSecretKey :: ElgamalSecretKey thomasEncryptionSecretKey = dummyEncryptionSecretKey dummyCryptographicParameters thomasAccount thomasEncryptionPublicKey :: AccountEncryptionKey -thomasEncryptionPublicKey = (fromJust $ Acc.getAccount thomasAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey +thomasEncryptionPublicKey = unsafeEncryptionKeyFromRaw ((fromJust $ Acc.getAccount thomasAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey) createEncryptedTransferData :: AccountEncryptionKey -> ElgamalSecretKey -> AggregatedDecryptedAmount -> Amount -> IO (Maybe EncryptedAmountTransferData) createEncryptedTransferData (AccountEncryptionKey receiverPK) senderSK aggDecAmount amount = diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/MaxIncomingAmountsTest.hs b/concordium-consensus/tests/scheduler/SchedulerTests/MaxIncomingAmountsTest.hs index 77a96211f5..2063db2ce3 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/MaxIncomingAmountsTest.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/MaxIncomingAmountsTest.hs @@ -37,7 +37,7 @@ import Concordium.Types import Concordium.Constants import Concordium.Crypto.FFIDataTypes (ElgamalSecretKey) import Concordium.ID.DummyData (dummyEncryptionSecretKey) -import Concordium.ID.Types (AccountEncryptionKey(..)) +import Concordium.ID.Types (AccountEncryptionKey(..), unsafeEncryptionKeyFromRaw) import qualified Concordium.Scheduler.Types as Types import qualified Concordium.Scheduler.Runner as Runner @@ -59,13 +59,13 @@ initialBlockState = blockStateWithAlesAccount alesEncryptionSecretKey :: ElgamalSecretKey alesEncryptionSecretKey = dummyEncryptionSecretKey dummyCryptographicParameters alesAccount alesEncryptionPublicKey :: AccountEncryptionKey -alesEncryptionPublicKey = fromJust (Acc.getAccount alesAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey +alesEncryptionPublicKey = unsafeEncryptionKeyFromRaw (fromJust (Acc.getAccount alesAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey) -- Thomas' keys thomasEncryptionSecretKey :: ElgamalSecretKey thomasEncryptionSecretKey = dummyEncryptionSecretKey dummyCryptographicParameters thomasAccount thomasEncryptionPublicKey :: AccountEncryptionKey -thomasEncryptionPublicKey = fromJust (Acc.getAccount thomasAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey +thomasEncryptionPublicKey = unsafeEncryptionKeyFromRaw (fromJust (Acc.getAccount thomasAccount (initialBlockState ^. blockAccounts)) ^. accountEncryptionKey) -- Helpers for creating the transfer datas createEncryptedTransferData :: diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs index 6775351527..6aa736e9d1 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs @@ -88,7 +88,7 @@ checkCredentialKeys keys threshold ID.CredentialPublicKeys{..} = do Nothing -> HUnit.assertFailure $ "Found no key at index " ++ show idx Just actualKey -> HUnit.assertEqual ("Key at index " ++ show idx ++ " should be equal") key actualKey) -checkKeysInCredential :: [(ID.KeyIndex, AccountVerificationKey)] -> ID.SignatureThreshold -> ID.AccountCredential -> HUnit.Assertion +checkKeysInCredential :: [(ID.KeyIndex, AccountVerificationKey)] -> ID.SignatureThreshold -> ID.AccountCredentialRaw -> HUnit.Assertion checkKeysInCredential keys threshold credential = checkCredentialKeys keys threshold $ credPubKeys credential tests :: Spec diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs index dceba34a23..266c7d5f59 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs @@ -239,7 +239,7 @@ checkAccountKeys keys threshold ID.AccountInformation{..} = do Just actualKey -> HUnit.assertEqual ("Key at index " ++ show idx ++ " should be equal") key actualKey) -- Checks the keys inside the relevant credentials are correct -checkAllCredentialKeys :: [(ID.CredentialIndex, ID.CredentialPublicKeys)] -> Map.Map ID.CredentialIndex ID.AccountCredential -> HUnit.Assertion +checkAllCredentialKeys :: [(ID.CredentialIndex, ID.CredentialPublicKeys)] -> Map.Map ID.CredentialIndex ID.AccountCredentialRaw -> HUnit.Assertion checkAllCredentialKeys keys credentials = do HUnit.assertEqual "Account keys should have same number of keys" (length keys) (length credentials) let keysInCredentials = fmap credPubKeys credentials From 35df7f2ea99bf83b4727da7e9b0305b8f0837313 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Sat, 11 Jun 2022 13:18:03 +0200 Subject: [PATCH 07/13] Rename Credential...Raw to RawCredential.... --- concordium-base | 2 +- .../src/Concordium/GlobalState/Account.hs | 10 +++++----- .../GlobalState/Basic/BlockState/Accounts.hs | 4 ++-- .../src/Concordium/GlobalState/BlockState.hs | 2 +- .../src/Concordium/GlobalState/Persistent/Accounts.hs | 8 ++++---- .../Concordium/GlobalState/Persistent/BlockState.hs | 2 +- .../src/Concordium/GlobalState/Persistent/Trie.hs | 2 +- .../tests/scheduler/GlobalStateMock.hs | 2 +- 8 files changed, 16 insertions(+), 16 deletions(-) diff --git a/concordium-base b/concordium-base index 9473e368ba..a8b65f4bac 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit 9473e368ba4adb1ee83d35f3526648d89d1e479c +Subproject commit a8b65f4bac3fde47e00e465a5ca564a866436ea5 diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs index a480a7305e..5ee2ba722d 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs @@ -32,11 +32,11 @@ import Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule -- |A list of credential IDs that have been removed from an account. data RemovedCredentials = EmptyRemovedCredentials - | RemovedCredential !CredentialRegistrationIDRaw !RemovedCredentials + | RemovedCredential !RawCredentialRegistrationID !RemovedCredentials deriving (Eq) -- |Convert a 'RemovedCredentials' to a list of 'CredentialRegistrationID's. -removedCredentialsToList :: RemovedCredentials -> [CredentialRegistrationIDRaw] +removedCredentialsToList :: RemovedCredentials -> [RawCredentialRegistrationID] removedCredentialsToList EmptyRemovedCredentials = [] removedCredentialsToList (RemovedCredential cred rest) = cred : removedCredentialsToList rest @@ -59,7 +59,7 @@ emptyRemovedCredentialsHash = Hash.hash "E" {-# NOINLINE emptyRemovedCredentialsHash #-} -- |Function for determining the hash of a 'RemovedCredential'. -removedCredentialHash :: CredentialRegistrationIDRaw -> Hash.Hash -> Hash.Hash +removedCredentialHash :: RawCredentialRegistrationID -> Hash.Hash -> Hash.Hash removedCredentialHash cred hrest = Hash.hash $ "R" <> encode cred <> Hash.hashToByteString hrest instance HashableTo Hash.Hash RemovedCredentials where @@ -67,7 +67,7 @@ instance HashableTo Hash.Hash RemovedCredentials where getHash (RemovedCredential cred rest) = removedCredentialHash cred (getHash rest) -- |Update hashed remove credentials with a new removed credentials. -addRemovedCredential :: CredentialRegistrationIDRaw -> Hashed RemovedCredentials -> Hashed RemovedCredentials +addRemovedCredential :: RawCredentialRegistrationID -> Hashed RemovedCredentials -> Hashed RemovedCredentials addRemovedCredential cred hrc = Hashed (RemovedCredential cred (hrc ^. unhashed)) (removedCredentialHash cred (getHash hrc)) -- |Hashed 'EmptyRemovedCredentials'. @@ -278,7 +278,7 @@ updateCredentials cuRemove cuAdd cuAccountThreshold d = & (accountVerificationKeys %~ updateAccountInformation cuAccountThreshold cuAdd cuRemove) & (accountRemovedCredentials %~ flip (foldl' (flip (addRemovedCredential . removedCredentialId))) cuRemove) where removeKeys = flip (foldl' (flip Map.delete)) cuRemove - removedCredentialId :: CredentialIndex -> CredentialRegistrationIDRaw + removedCredentialId :: CredentialIndex -> RawCredentialRegistrationID removedCredentialId cix = credId $ Map.findWithDefault (error "Removed credential key not found") cix (d ^. accountCredentials) diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs index 61a1a9c1bc..94ede62363 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs @@ -46,7 +46,7 @@ data Accounts (pv :: ProtocolVersion) = Accounts { -- |Hashed Merkle-tree of the accounts. accountTable :: !(AT.AccountTable (AccountVersionFor pv)), -- |A mapping of 'ID.CredentialRegistrationID's to accounts on which they are used. - accountRegIds :: !(Map.Map ID.CredentialRegistrationIDRaw AccountIndex) + accountRegIds :: !(Map.Map ID.RawCredentialRegistrationID AccountIndex) } instance IsProtocolVersion pv => Show (Accounts pv) where @@ -169,7 +169,7 @@ regIdExists :: ID.CredentialRegistrationID -> Accounts pv -> Maybe AccountIndex regIdExists rid Accounts{..} = ID.toRawCredId rid `Map.lookup` accountRegIds -- |Record an account registration ID as used on the account. -recordRegId :: ID.CredentialRegistrationIDRaw -> AccountIndex -> Accounts pv -> Accounts pv +recordRegId :: ID.RawCredentialRegistrationID -> AccountIndex -> Accounts pv -> Accounts pv recordRegId rid idx accs = accs { accountRegIds = Map.insert rid idx (accountRegIds accs) } -- |Record multiple registration ids as used. This implementation is marginally diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 7adbc16201..62dda16ae1 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -371,7 +371,7 @@ class (ContractStateOperations m, AccountOperations m) => BlockStateQuery m wher getActiveBakersAndDelegators :: (AccountVersionFor (MPV m) ~ 'AccountV1) => BlockState m -> m ([ActiveBakerInfo m], [ActiveDelegatorInfo]) -- |Query an account by the id of the credential that belonged to it. - getAccountByCredId :: BlockState m -> ID.CredentialRegistrationIDRaw -> m (Maybe (AccountIndex, Account m)) + getAccountByCredId :: BlockState m -> ID.RawCredentialRegistrationID -> m (Maybe (AccountIndex, Account m)) -- |Query an account by the account index that belonged to it. getAccountByIndex :: BlockState m -> AccountIndex -> m (Maybe (AccountIndex, Account m)) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs index df8ac0af0e..b9e50ae953 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs @@ -61,9 +61,9 @@ data Accounts (pv :: ProtocolVersion) = Accounts { -- |Hashed Merkle-tree of the accounts accountTable :: !(LFMBTree AccountIndex HashedBufferedRef (PersistentAccount (AccountVersionFor pv))), -- |Optional cached set of used 'ID.CredentialRegistrationID's - accountRegIds :: !(Nullable (Map.Map ID.CredentialRegistrationIDRaw AccountIndex)), + accountRegIds :: !(Nullable (Map.Map ID.RawCredentialRegistrationID AccountIndex)), -- |Persisted representation of the map from registration ids to account indices. - accountRegIdHistory :: !(Trie.TrieN (BufferedBlobbed BlobRef) ID.CredentialRegistrationIDRaw AccountIndex) + accountRegIdHistory :: !(Trie.TrieN (BufferedBlobbed BlobRef) ID.RawCredentialRegistrationID AccountIndex) } -- |Convert a (non-persistent) 'Transient.Accounts' to a (persistent) 'Accounts'. @@ -95,7 +95,7 @@ instance MonadBlobStore m => BlobStorable m RegIdHistory -- |Load the registration ids. If 'accountRegIds' is @Null@, then 'accountRegIdHistory' -- is used (reading from disk as necessary) to determine it, in which case 'accountRegIds' -- is updated with the determined value. -loadRegIds :: forall m pv. MonadBlobStore m => Accounts pv -> m (Map.Map ID.CredentialRegistrationIDRaw AccountIndex, Accounts pv) +loadRegIds :: forall m pv. MonadBlobStore m => Accounts pv -> m (Map.Map ID.RawCredentialRegistrationID AccountIndex, Accounts pv) loadRegIds a@Accounts{accountRegIds = Some regids} = return (regids, a) loadRegIds a@Accounts{accountRegIds = Null, ..} = do regids <- Trie.toMap accountRegIdHistory @@ -167,7 +167,7 @@ getAccount addr Accounts{..} = AccountMap.lookup addr accountMap >>= \case -- |Retrieve an account associated with the given credential registration ID. -- Returns @Nothing@ if no such account exists. -getAccountByCredId :: (MonadBlobStore m, IsProtocolVersion pv) => ID.CredentialRegistrationIDRaw -> Accounts pv -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) +getAccountByCredId :: (MonadBlobStore m, IsProtocolVersion pv) => ID.RawCredentialRegistrationID -> Accounts pv -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) getAccountByCredId cid accs@Accounts{accountRegIds = Null,..} = Trie.lookup cid accountRegIdHistory >>= \case Nothing -> return Nothing Just ai -> fmap (ai, ) <$> indexedAccount ai accs diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 675e4e4ec9..869209f73b 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -1665,7 +1665,7 @@ doGetActiveBakers pbs = do ab <- refLoad $ bspBirkParameters bsp ^. birkActiveBakers Trie.keysAsc (ab ^. activeBakers) -doGetAccountByCredId :: (IsProtocolVersion pv, MonadBlobStore m) => PersistentBlockState pv -> ID.CredentialRegistrationIDRaw -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) +doGetAccountByCredId :: (IsProtocolVersion pv, MonadBlobStore m) => PersistentBlockState pv -> ID.RawCredentialRegistrationID -> m (Maybe (AccountIndex, PersistentAccount (AccountVersionFor pv))) doGetAccountByCredId pbs cid = do bsp <- loadPBS pbs Accounts.getAccountByCredId cid (bspAccounts bsp) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs index 9f3f615594..e5b3a60b80 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs @@ -62,7 +62,7 @@ instance FixedTrieKey AccountAddress deriving via Word64 instance FixedTrieKey BakerId deriving via Word64 instance FixedTrieKey DelegatorId instance FixedTrieKey Bls.PublicKey -- FIXME: This is a bad instance. Serialization of these is expensive. -instance FixedTrieKey IDTypes.CredentialRegistrationIDRaw +instance FixedTrieKey IDTypes.RawCredentialRegistrationID -- |Class for Trie keys that respect the 'Ord' instance. -- That is, @a `compare` b == unpackKey a `compare` unpackKey b@. diff --git a/concordium-consensus/tests/scheduler/GlobalStateMock.hs b/concordium-consensus/tests/scheduler/GlobalStateMock.hs index d4dba1e51e..cbd635c6d1 100644 --- a/concordium-consensus/tests/scheduler/GlobalStateMock.hs +++ b/concordium-consensus/tests/scheduler/GlobalStateMock.hs @@ -106,7 +106,7 @@ data BlockStateQueryAction (pv :: ProtocolVersion) a where AccountExists :: MockBlockState -> AccountAddress -> BlockStateQueryAction pv Bool GetActiveBakers :: MockBlockState -> BlockStateQueryAction pv [BakerId] GetActiveBakersAndDelegators :: (AccountVersionFor pv ~ 'AccountV1) => MockBlockState -> BlockStateQueryAction pv ([ActiveBakerInfo' MockBakerInfoRef], [ActiveDelegatorInfo]) - GetAccountByCredId :: MockBlockState -> ID.CredentialRegistrationIDRaw -> BlockStateQueryAction pv (Maybe (AccountIndex, MockAccount)) + GetAccountByCredId :: MockBlockState -> ID.RawCredentialRegistrationID -> BlockStateQueryAction pv (Maybe (AccountIndex, MockAccount)) GetContractInstance :: MockBlockState -> ContractAddress -> BlockStateQueryAction pv (Maybe (InstanceInfoType MockContractState)) GetModuleList :: MockBlockState -> BlockStateQueryAction pv [ModuleRef] GetAccountList :: MockBlockState -> BlockStateQueryAction pv [AccountAddress] From f77a69b1adee8cc9c7bde5150cc05c4b92fb80b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Sat, 11 Jun 2022 19:00:08 +0200 Subject: [PATCH 08/13] Ensure consistent naming of Raw* types. --- concordium-base | 2 +- concordium-consensus/src/Concordium/GlobalState/Account.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/concordium-base b/concordium-base index 4313a8057d..80cd732178 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit 4313a8057d26d5014d02ca9e03d1b28514ead15a +Subproject commit 80cd7321783b4818d6d9bacc7f916b1ade1ec0b6 diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs index 5ee2ba722d..cb2947cdc2 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs @@ -80,7 +80,7 @@ data PersistingAccountData = PersistingAccountData { -- |Address of the account _accountAddress :: !AccountAddress -- |Account encryption key (for encrypted amounts) - ,_accountEncryptionKey :: !AccountEncryptionKeyRaw + ,_accountEncryptionKey :: !RawAccountEncryptionKey -- |Account signature verification keys. Except for the threshold, -- these are derived from the account credentials, and are provided -- for convenience. From e04c37e5144493bdfcd121abcc9e0a5ebaff1711 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Sun, 12 Jun 2022 21:13:44 +0200 Subject: [PATCH 09/13] Add documentation and ensure consistent naming. --- concordium-base | 2 +- .../src/Concordium/GlobalState/Account.hs | 10 ++++++++-- .../src/Concordium/GlobalState/BlockState.hs | 2 +- .../Concordium/GlobalState/Persistent/Account.hs | 8 +++++++- .../GlobalState/Persistent/BlockState.hs | 6 ++++-- .../src/Concordium/MultiVersion.hs | 2 +- concordium-consensus/src/Concordium/Scheduler.hs | 14 +++++++------- .../src/Concordium/Scheduler/InvokeContract.hs | 2 +- .../tests/scheduler/GlobalStateMock.hs | 2 +- .../scheduler/SchedulerTests/UpdateAccountKeys.hs | 2 +- .../scheduler/SchedulerTests/UpdateCredentials.hs | 2 +- 11 files changed, 33 insertions(+), 19 deletions(-) diff --git a/concordium-base b/concordium-base index 80cd732178..de81c05dc9 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit 80cd7321783b4818d6d9bacc7f916b1ade1ec0b6 +Subproject commit de81c05dc945d31cfc6a90dd8d4d8ba23c4ead82 diff --git a/concordium-consensus/src/Concordium/GlobalState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Account.hs index cb2947cdc2..467efe2fa8 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Account.hs @@ -79,7 +79,13 @@ emptyHashedRemovedCredentials = makeHashed EmptyRemovedCredentials data PersistingAccountData = PersistingAccountData { -- |Address of the account _accountAddress :: !AccountAddress - -- |Account encryption key (for encrypted amounts) + -- |Account encryption key (for encrypted amounts). This is stored as a "Raw" + -- encryption key for two reasons. First, it takes up around 1/3 of the space + -- of a deserialized key and second it is much faster to load from a byte + -- array since expensive validity checks are not needed. This raw key will + -- always be possible to convert to an 'AccountEncryptionKey' since only valid + -- keys are stored. When this process is needed the cost of conversion is + -- dominated by other costs. ,_accountEncryptionKey :: !RawAccountEncryptionKey -- |Account signature verification keys. Except for the threshold, -- these are derived from the account credentials, and are provided @@ -87,7 +93,7 @@ data PersistingAccountData = PersistingAccountData { ,_accountVerificationKeys :: !AccountInformation -- |Current credentials. This map is always non-empty and (presently) -- will have a credential at index 'initialCredentialIndex' (0) that cannot be changed. - ,_accountCredentials :: !(Map.Map CredentialIndex AccountCredentialRaw) + ,_accountCredentials :: !(Map.Map CredentialIndex RawAccountCredential) -- |Credential IDs of removed credentials. ,_accountRemovedCredentials :: !(Hashed RemovedCredentials) } diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 62dda16ae1..b60632379a 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -164,7 +164,7 @@ class (BlockStateTypes m, Monad m) => AccountOperations m where -- |Get the list of credentials deployed on the account, ordered from most -- recently deployed. The list should be non-empty. - getAccountCredentials :: Account m -> m (Map.Map ID.CredentialIndex ID.AccountCredentialRaw) + getAccountCredentials :: Account m -> m (Map.Map ID.CredentialIndex ID.RawAccountCredential) -- |Get the key used to verify transaction signatures, it records the signature scheme used as well getAccountVerificationKeys :: Account m -> m ID.AccountInformation diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs index 6cf4c6f867..e6c30e9b3c 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Account.hs @@ -759,7 +759,13 @@ serializeAccount cryptoParams PersistentAccount{..} = do _accountCredentials ) asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId - asfExplicitEncryptionKey = _accountEncryptionKey /= toRawEncryptionKey (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId)) -- TODO: No need for deserialization + -- There is an opportunity for improvement here. There is no need to go + -- through the deserialized key. The way the encryption key is formed is + -- that the first half is the generator, the second half is the credId. + -- So we could just concatenate them. This requires a bit of scaffolding + -- to get the right component out of cryptoParams, so it is not yet + -- done. + asfExplicitEncryptionKey = _accountEncryptionKey /= toRawEncryptionKey (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId)) (asfMultipleCredentials, putCredentials) = case Map.toList _accountCredentials of [(i, cred)] | i == initialCredentialIndex -> (False, put cred) _ -> (True, putSafeMapOf put put _accountCredentials) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 879d896d2e..f2d390203d 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -86,7 +86,6 @@ import Concordium.Utils.Serialization.Put import Concordium.Utils.Serialization import Concordium.Utils.BinarySearch import Concordium.Kontrol.Bakers -import Concordium.ID.Types (unsafeEncryptionKeyFromRaw) -- * Birk parameters @@ -2702,7 +2701,10 @@ instance (PersistentState r m, IsProtocolVersion pv) => AccountOperations (Persi getAccountEncryptedAmount acc = loadPersistentAccountEncryptedAmount =<< loadBufferedRef (acc ^. accountEncryptedAmount) - getAccountEncryptionKey acc = unsafeEncryptionKeyFromRaw <$> acc ^^. accountEncryptionKey + -- The use of the unsafe @unsafeEncryptionKeyFromRaw@ function here is + -- justified because the encryption key was validated when it was + -- created/deployed (this is part of credential validation) + getAccountEncryptionKey acc = ID.unsafeEncryptionKeyFromRaw <$> acc ^^. accountEncryptionKey getAccountReleaseSchedule acc = loadPersistentAccountReleaseSchedule =<< loadBufferedRef (acc ^. accountReleaseSchedule) diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs index beea203af2..1c46b55e57 100644 --- a/concordium-consensus/src/Concordium/MultiVersion.hs +++ b/concordium-consensus/src/Concordium/MultiVersion.hs @@ -475,7 +475,7 @@ checkForProtocolUpdate = liftSkov body TreeStateMonad (VersionedSkovM gc fc pv) ) => VersionedSkovM gc fc pv () - body = do + body = Skov.getProtocolUpdateStatus >>= \case ProtocolUpdated pu -> case checkUpdate @pv pu of Left err -> do diff --git a/concordium-consensus/src/Concordium/Scheduler.hs b/concordium-consensus/src/Concordium/Scheduler.hs index af1d521a3b..190bf4dd22 100644 --- a/concordium-consensus/src/Concordium/Scheduler.hs +++ b/concordium-consensus/src/Concordium/Scheduler.hs @@ -934,7 +934,7 @@ checkAndGetBalanceAccountV1 :: (TransactionMonad m, AccountOperations m) => AccountAddress -- ^Used address -> IndexedAccount m -> Amount - -> m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) + -> m (Either WasmV1.ContractCallFailure (Address, [ID.RawAccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) checkAndGetBalanceAccountV1 usedAddress senderAccount transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Right (usedAddress, senderAccount)) senderamount <- getCurrentAccountAvailableAmount senderAccount @@ -951,7 +951,7 @@ checkAndGetBalanceAccountV0 :: (TransactionMonad m, AccountOperations m) => AccountAddress -- ^Used address -> IndexedAccount m -> Amount - -> m (Address, [ID.AccountCredentialRaw], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) + -> m (Address, [ID.RawAccountCredential], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress)) checkAndGetBalanceAccountV0 usedAddress senderAccount transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Right (usedAddress, senderAccount)) senderamount <- getCurrentAccountAvailableAmount senderAccount @@ -967,7 +967,7 @@ checkAndGetBalanceInstanceV1 :: forall m vOrigin . (TransactionMonad m, AccountO => IndexedAccount m -> UInstanceInfoV m vOrigin -> Amount - -> m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredentialRaw], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) + -> m (Either WasmV1.ContractCallFailure (Address, [ID.RawAccountCredential], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) checkAndGetBalanceInstanceV1 ownerAccount istance transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Left (ownerAccount, instanceAddress istance)) senderamount <- getCurrentContractAmount (Wasm.getWasmVersion @vOrigin) istance @@ -983,7 +983,7 @@ checkAndGetBalanceInstanceV0 :: forall m vOrigin . (TransactionMonad m, AccountO => IndexedAccount m -> UInstanceInfoV m vOrigin -> Amount - -> m (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress) + -> m (Address, [ID.RawAccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress) checkAndGetBalanceInstanceV0 ownerAccount istance transferAmount = do (senderAddr, senderCredentials) <- mkSenderAddrCredentials (Left (ownerAccount, instanceAddress istance)) senderamount <- getCurrentContractAmount (Wasm.getWasmVersion @vOrigin) istance @@ -1001,7 +1001,7 @@ handleContractUpdateV1 :: forall r m. (StaticInformation m, AccountOperations m, ContractStateOperations m, MonadProtocolVersion m) => AccountAddress -- ^The address that was used to send the top-level transaction. -> UInstanceInfoV m GSWasm.V1 -- ^The current state of the target contract of the transaction, which must exist. - -> (Amount -> LocalT r m (Either WasmV1.ContractCallFailure (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) + -> (Amount -> LocalT r m (Either WasmV1.ContractCallFailure (Address, [ID.RawAccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) -- ^Check that the sender has sufficient amount to cover the given amount and return a triple of -- - used address -- - credentials of the address, either account or owner of the contract @@ -1187,7 +1187,7 @@ handleContractUpdateV0 :: forall r m. (StaticInformation m, AccountOperations m, ContractStateOperations m, MonadProtocolVersion m) => AccountAddress -- ^The address that was used to send the top-level transaction. -> UInstanceInfoV m GSWasm.V0 -- ^The current state of the target contract of the transaction, which must exist. - -> (Amount -> LocalT r m (Address, [ID.AccountCredentialRaw], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) + -> (Amount -> LocalT r m (Address, [ID.RawAccountCredential], (Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress))) -- ^The sender of the message (contract instance or account). In case this is -- a contract the first parameter is the owner account of the instance. In case this is an account -- (i.e., this is called from a top-level transaction) the value is a pair of the address that was used @@ -1321,7 +1321,7 @@ foldEvents originAddr istance initEvent = fmap (initEvent:) . go -- will be a contract address, and the credentials will be of the owner account. mkSenderAddrCredentials :: AccountOperations m => Either (IndexedAccount m, ContractAddress) (AccountAddress, IndexedAccount m) - -> m (Address, [ID.AccountCredentialRaw]) + -> m (Address, [ID.RawAccountCredential]) mkSenderAddrCredentials sender = case sender of Left (ownerAccount, iaddr) -> do diff --git a/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs b/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs index bf32dbbdce..731c607319 100644 --- a/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs +++ b/concordium-consensus/src/Concordium/Scheduler/InvokeContract.hs @@ -107,7 +107,7 @@ invokeContract ContractContext{..} cm bs = do (Either (Maybe RejectReason) -- Invocation failed because the relevant contract/account does not exist. ( -- Check that the requested account or contract has enough balance. - Amount -> LocalT r (InvokeContractMonad m) (Address, [ID.AccountCredentialRaw], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress), + Amount -> LocalT r (InvokeContractMonad m) (Address, [ID.RawAccountCredential], Either (Wasm.WasmVersion, ContractAddress) IndexedAccountAddress), AccountAddress, -- Address of the invoker account, or of its owner if the invoker is a contract. AccountIndex -- And its index. )) diff --git a/concordium-consensus/tests/scheduler/GlobalStateMock.hs b/concordium-consensus/tests/scheduler/GlobalStateMock.hs index cbd635c6d1..7c90f60b9f 100644 --- a/concordium-consensus/tests/scheduler/GlobalStateMock.hs +++ b/concordium-consensus/tests/scheduler/GlobalStateMock.hs @@ -71,7 +71,7 @@ data AccountOperationsAction (pv :: ProtocolVersion) a where CheckAccountIsAllowed :: MockAccount -> AccountAllowance -> AccountOperationsAction pv Bool GetAccountAvailableAmount :: MockAccount -> AccountOperationsAction pv Amount GetAccountNonce :: MockAccount -> AccountOperationsAction pv Nonce - GetAccountCredentials :: MockAccount -> AccountOperationsAction pv (Map.Map ID.CredentialIndex ID.AccountCredentialRaw) + GetAccountCredentials :: MockAccount -> AccountOperationsAction pv (Map.Map ID.CredentialIndex ID.RawAccountCredential) GetAccountVerificationKeys :: MockAccount -> AccountOperationsAction pv ID.AccountInformation GetAccountEncryptedAmount :: MockAccount -> AccountOperationsAction pv AccountEncryptedAmount GetAccountEncryptionKey :: MockAccount -> AccountOperationsAction pv ID.AccountEncryptionKey diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs index 6aa736e9d1..d93d92d21b 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateAccountKeys.hs @@ -88,7 +88,7 @@ checkCredentialKeys keys threshold ID.CredentialPublicKeys{..} = do Nothing -> HUnit.assertFailure $ "Found no key at index " ++ show idx Just actualKey -> HUnit.assertEqual ("Key at index " ++ show idx ++ " should be equal") key actualKey) -checkKeysInCredential :: [(ID.KeyIndex, AccountVerificationKey)] -> ID.SignatureThreshold -> ID.AccountCredentialRaw -> HUnit.Assertion +checkKeysInCredential :: [(ID.KeyIndex, AccountVerificationKey)] -> ID.SignatureThreshold -> ID.RawAccountCredential -> HUnit.Assertion checkKeysInCredential keys threshold credential = checkCredentialKeys keys threshold $ credPubKeys credential tests :: Spec diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs index 266c7d5f59..e8373bdcb0 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/UpdateCredentials.hs @@ -239,7 +239,7 @@ checkAccountKeys keys threshold ID.AccountInformation{..} = do Just actualKey -> HUnit.assertEqual ("Key at index " ++ show idx ++ " should be equal") key actualKey) -- Checks the keys inside the relevant credentials are correct -checkAllCredentialKeys :: [(ID.CredentialIndex, ID.CredentialPublicKeys)] -> Map.Map ID.CredentialIndex ID.AccountCredentialRaw -> HUnit.Assertion +checkAllCredentialKeys :: [(ID.CredentialIndex, ID.CredentialPublicKeys)] -> Map.Map ID.CredentialIndex ID.RawAccountCredential -> HUnit.Assertion checkAllCredentialKeys keys credentials = do HUnit.assertEqual "Account keys should have same number of keys" (length keys) (length credentials) let keysInCredentials = fmap credPubKeys credentials From f24f5f764fd5f029e619f0e40bdce5f644e745a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Mon, 13 Jun 2022 19:53:33 +0200 Subject: [PATCH 10/13] Elaborate on TODOs --- .../GlobalState/Basic/BlockState/Account.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs index f62973258b..bd14de8f37 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs @@ -126,7 +126,12 @@ serializeAccount cryptoParams acct@Account{..} = do _accountCredentials ) asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId - asfExplicitEncryptionKey = unsafeEncryptionKeyFromRaw _accountEncryptionKey /= makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId) -- TODO: No need to deserialize + -- There is an opportunity for improvement here. We do not have to convert + -- the raw key to a structured one. We can check the equality directly on + -- the byte representation (in fact equality is defined on those). However + -- that requires a bit of work to expose the right raw values from + -- cryptographic parameters. + asfExplicitEncryptionKey = unsafeEncryptionKeyFromRaw _accountEncryptionKey /= makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId) (asfMultipleCredentials, putCredentials) = case Map.toList _accountCredentials of [(i, cred)] | i == initialCredentialIndex -> (False, S.put cred) _ -> (True, putSafeMapOf S.put S.put _accountCredentials) @@ -161,7 +166,11 @@ deserializeAccount migration cryptoParams = do _accountRemovedCredentials <- if asfHasRemovedCredentials then makeHashed <$> S.get else return emptyHashedRemovedCredentials let _accountVerificationKeys = getAccountInformation threshold _accountCredentials let _accountAddress = fromMaybe (addressFromRegIdRaw initialCredId) preAddress - _accountEncryptionKey = fromMaybe (toRawEncryptionKey (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId))) preEncryptionKey -- TODO: No need to deserialize + -- There is an opportunity for improvement here. We do not have to convert + -- the raw credId to a structured one. We can directly construct the + -- However that requires a bit of work to expose the right raw values from + -- cryptographic parameters. + _accountEncryptionKey = fromMaybe (toRawEncryptionKey (makeEncryptionKey cryptoParams (unsafeCredIdFromRaw initialCredId))) preEncryptionKey _accountNonce <- S.get _accountAmount <- S.get _accountEncryptedAmount <- if asfExplicitEncryptedAmount then S.get else return initialAccountEncryptedAmount From e24b87e0bb948aad192029093d27c85bb46d8a11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Mon, 13 Jun 2022 19:54:41 +0200 Subject: [PATCH 11/13] Revert needless empty line change. --- concordium-consensus/test-runners/deterministic/Main.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/concordium-consensus/test-runners/deterministic/Main.hs b/concordium-consensus/test-runners/deterministic/Main.hs index cb50decbc6..9ad2ffffdf 100644 --- a/concordium-consensus/test-runners/deterministic/Main.hs +++ b/concordium-consensus/test-runners/deterministic/Main.hs @@ -286,7 +286,6 @@ initialState = do hconfig = NoHandler config = SkovConfig gsconfig finconfig hconfig (_bsContext, _bsState) <- runLoggerT (initialiseSkov genData config) (logFor (fromIntegral bakerId)) - return BakerState{..} _ssEvents = makeEvents $ (PEvent 0 (TransactionEvent (transactions (mkStdGen 1)))) : [PEvent 0 (BakerEvent i (EBake 0)) | i <- allBakers] _ssNextTimer = 0 From 911bc3a834a4725bd020846c3dbe79c6081d2768 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Mon, 13 Jun 2022 20:01:58 +0200 Subject: [PATCH 12/13] Bump base after merge. --- concordium-base | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/concordium-base b/concordium-base index e001d76d96..089e90668b 160000 --- a/concordium-base +++ b/concordium-base @@ -1 +1 @@ -Subproject commit e001d76d965576d30f7adc3615b093bf175f8d80 +Subproject commit 089e90668b8b8ed9f8ec22e9477fab20a73bb4ea From 91afb8f086a95c25b70900b078bd765ebd8dc278 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ale=C5=A1=20Bizjak?= Date: Mon, 13 Jun 2022 20:07:28 +0200 Subject: [PATCH 13/13] Fix test compilation. --- .../tests/globalstate/GlobalStateTests/Accounts.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs index e311ff5b80..634fac458f 100644 --- a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs +++ b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs @@ -241,7 +241,7 @@ runAccountAction (RegIdExists rid) (ba, pa) = do checkBinary (==) be pe "<->" "regid exists in basic" "regid exists in persistent" return (ba, pa') runAccountAction (RecordRegId rid ai) (ba, pa) = do - let ba' = B.recordRegId (ID.toRawCredId rid) ai ba + let ba' = B.recordRegId (ID.toRawCredRegId rid) ai ba pa' <- P.recordRegId rid ai pa return (ba', pa')