Merge pull request #377 from Concordium/speed-up-credential-loading

Speed up credential loading

concordium-consensus/src/Concordium/GlobalState/Account.hs

@@ -79,15 +79,21 @@ emptyHashedRemovedCredentials = makeHashed EmptyRemovedCredentials
 data PersistingAccountData = PersistingAccountData {
   -- |Address of the account
   _accountAddress :: !AccountAddress
-  -- |Account encryption key (for encrypted amounts)
-  ,_accountEncryptionKey :: !AccountEncryptionKey
+  -- |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
   -- for convenience.
   ,_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 RawAccountCredential)
   -- |Credential IDs of removed credentials.
   ,_accountRemovedCredentials :: !(Hashed RemovedCredentials)
 }
@@ -274,15 +280,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 cix = toRawCredRegId . credId $ Map.findWithDefault (error "Removed credential key not found") cix (d ^. accountCredentials)
+        removedCredentialId :: CredentialIndex -> RawCredentialRegistrationID
+        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
 

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
 

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Account.hs

@@ -125,8 +125,13 @@ serializeAccount cryptoParams acct@Account{..} = do
             initialCredentialIndex
             _accountCredentials
           )
-    asfExplicitAddress = _accountAddress /= addressFromRegId initialCredId
-    asfExplicitEncryptionKey = _accountEncryptionKey /= makeEncryptionKey cryptoParams initialCredId
+    asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId
+    -- 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)
@@ -160,8 +165,12 @@ 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
+        -- 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
@@ -196,8 +205,8 @@ newAccountMultiCredential :: forall av. (IsAccountVersion av)
   -> Account av
 newAccountMultiCredential cryptoParams threshold _accountAddress cs = Account {
         _accountPersisting = makeAccountPersisting PersistingAccountData {
-        _accountEncryptionKey = makeEncryptionKey cryptoParams (credId (cs Map.! initialCredentialIndex)),
-        _accountCredentials = cs,
+        _accountEncryptionKey = toRawEncryptionKey (makeEncryptionKey cryptoParams (credId (cs Map.! initialCredentialIndex))),
+        _accountCredentials = toRawAccountCredential <$> cs,
         _accountVerificationKeys = getAccountInformation threshold cs,
         _accountRemovedCredentials = emptyHashedRemovedCredentials,
         ..

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Accounts.hs

@@ -169,13 +169,13 @@ regIdExists :: ID.CredentialRegistrationID -> Accounts pv -> Maybe AccountIndex
 regIdExists rid Accounts{..} = ID.toRawCredRegId rid `Map.lookup` accountRegIds
 
 -- |Record an account registration ID as used on the account.
-recordRegId :: ID.CredentialRegistrationID -> AccountIndex -> Accounts pv -> Accounts pv
-recordRegId rid idx accs = accs { accountRegIds = Map.insert (ID.toRawCredRegId rid) idx (accountRegIds accs) }
+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
 -- 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 ((_1 %~ ID.toRawCredRegId) <$> rids)) }
+recordRegIds rids accs = accs { accountRegIds = Map.union (accountRegIds accs) (Map.fromAscList . map (\(x, y) -> (ID.toRawCredRegId 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
@@ -223,7 +223,7 @@ deserializeAccounts migration cryptoParams = do
                   | cred `Map.member` regids = fail "Duplicate credential"
                   | otherwise = return $ Map.insert cred acctId regids
             newRegIds <- foldM addRegId accountRegIds $
-                (ID.toRawCredRegId . ID.credId <$> Map.elems (acct ^. accountCredentials))
+                (ID.credId <$> Map.elems (acct ^. accountCredentials))
                 ++ removedCredentialsToList (acct ^. accountRemovedCredentials . unhashed)
             loop (i+1)
               Accounts {

concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/Invariants.hs

@@ -74,7 +74,7 @@ invariantBlockState bs extraBalance = do
                         unless (Set.member (binfo ^. bakerAggregationVerifyKey) bakerKeys) $ Left "Baker aggregation key is missing from active bakers"
                         return (Map.delete (BakerId i) bakerIds, Set.delete (binfo ^. bakerAggregationVerifyKey) bakerKeys)
             return (creds', Map.insert addr i amp, bal + (acct ^. accountAmount), bakerIds', bakerKeys')
-        checkCred i creds (ID.toRawCredRegId . ID.credId -> cred)
+        checkCred i creds (ID.credId -> cred)
             | cred `Map.member` creds = Left $ "Duplicate credential: " ++ show cred
             | otherwise = return $ Map.insert cred i creds
         checkEpochBakers EpochBakers{..} = do

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.RawAccountCredential)
 
   -- |Get the key used to verify transaction signatures, it records the signature scheme used as well
   getAccountVerificationKeys :: Account m -> m ID.AccountInformation

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
@@ -519,8 +518,8 @@ 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),
-        _accountCredentials = creds,
+        _accountEncryptionKey = toRawEncryptionKey (makeEncryptionKey cryptoParams (credId credential)),
+        _accountCredentials = toRawAccountCredential <$> creds,
         _accountVerificationKeys = getAccountInformation 1 creds,
         _accountRemovedCredentials = emptyHashedRemovedCredentials,
         ..
@@ -759,8 +758,14 @@ serializeAccount cryptoParams PersistentAccount{..} = do
                 initialCredentialIndex
                 _accountCredentials
               )
-        asfExplicitAddress = _accountAddress /= addressFromRegId initialCredId
-        asfExplicitEncryptionKey = _accountEncryptionKey /= makeEncryptionKey cryptoParams initialCredId
+        asfExplicitAddress = _accountAddress /= addressFromRegIdRaw initialCredId
+        -- 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)

concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs

@@ -2701,7 +2701,10 @@ instance (PersistentState r m, IsProtocolVersion pv) => AccountOperations (Persi
 
   getAccountEncryptedAmount acc = loadPersistentAccountEncryptedAmount =<< loadBufferedRef (acc ^. accountEncryptedAmount)
 
-  getAccountEncryptionKey acc = 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)
 

concordium-consensus/src/Concordium/GlobalState/Persistent/Trie.hs

@@ -63,11 +63,10 @@ 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.RawCredentialRegistrationID) where
-  unpackKey (IDTypes.RawCredRegId x) = FBS.unpack x
-  packKey = IDTypes.RawCredRegId . FBS.pack
+  unpackKey (IDTypes.RawCredentialRegistrationID x) = FBS.unpack x
+  packKey = IDTypes.RawCredentialRegistrationID . FBS.pack
 
 -- |Class for Trie keys that respect the 'Ord' instance.
 -- That is, @a `compare` b == unpackKey a `compare` unpackKey b@.