From 4586fb556aeaf003df44cddb0b06595d9ee06251 Mon Sep 17 00:00:00 2001 From: Thomas Dinsdale-Young Date: Fri, 16 Aug 2024 16:55:30 +0200 Subject: [PATCH 1/4] Changes to support GRPC changes. --- deps/concordium-base | 2 +- src/Concordium/Client/GRPC2.hs | 63 ++++++++++++++++++++++++--------- src/Concordium/Client/Runner.hs | 40 ++++++++++----------- 3 files changed, 67 insertions(+), 38 deletions(-) diff --git a/deps/concordium-base b/deps/concordium-base index 1c97f303..48add0cd 160000 --- a/deps/concordium-base +++ b/deps/concordium-base @@ -1 +1 @@ -Subproject commit 1c97f30317960427e59e2643bd55fd8f6f26697a +Subproject commit 48add0cda0364624fc75f0bc4cdd3692d9b449a7 diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs index 60f7a669..b84c019f 100644 --- a/src/Concordium/Client/GRPC2.hs +++ b/src/Concordium/Client/GRPC2.hs @@ -692,6 +692,21 @@ instance FromProto Proto.CredentialPublicKeys where then fromProtoFail $ "Unable to convert 'CredentialPublicKeys'. Key index exceeds " <> show (maxBound :: Word8) <> "." else return (fromIntegral ki, VerifyKeyEd25519 k) +instance FromProto Proto.Cooldown'CooldownStatus where + type Output Proto.Cooldown'CooldownStatus = CooldownStatus + fromProto Proto.Cooldown'COOLDOWN = return StatusCooldown + fromProto Proto.Cooldown'PRE_COOLDOWN = return StatusPreCooldown + fromProto Proto.Cooldown'PRE_PRE_COOLDOWN = return StatusPrePreCooldown + fromProto _ = fromProtoFail "Unable to convert 'CooldownStatus'. Unrecognized status." + +instance FromProto Proto.Cooldown where + type Output Proto.Cooldown = Cooldown + fromProto c = do + cooldownTimestamp <- fromProto $ c ^. ProtoFields.endTime + cooldownAmount <- fromProto $ c ^. ProtoFields.amount + cooldownStatus <- fromProto $ c ^. ProtoFields.status + return Cooldown{..} + instance FromProto Proto.AccountInfo where type Output Proto.AccountInfo = AccountInfo fromProto ai = do @@ -713,6 +728,8 @@ instance FromProto Proto.AccountInfo where Nothing -> return AccountStakingNone Just asi -> fromProto asi aiAccountAddress <- fromProto $ ai ^. ProtoFields.address + aiAccountCooldowns <- mapM fromProto $ ai ^. ProtoFields.cooldowns + aiAccountAvailableAmount <- fromProto $ ai ^. ProtoFields.availableBalance return AccountInfo{..} where versionTag = 0 @@ -937,30 +954,34 @@ instance FromProto Proto.PoolCurrentPaydayInfo where return CurrentPaydayBakerPoolStatus{..} instance FromProto Proto.PoolInfoResponse where - type Output Proto.PoolInfoResponse = PoolStatus + type Output Proto.PoolInfoResponse = BakerPoolStatus fromProto pir = do psBakerId <- fromProto $ pir ^. ProtoFields.baker psBakerAddress <- fromProto $ pir ^. ProtoFields.address - psBakerEquityCapital <- fromProto $ pir ^. ProtoFields.equityCapital - psDelegatedCapital <- fromProto $ pir ^. ProtoFields.delegatedCapital - psDelegatedCapitalCap <- fromProto $ pir ^. ProtoFields.delegatedCapitalCap - psPoolInfo <- fromProto $ pir ^. ProtoFields.poolInfo - psBakerStakePendingChange <- - case pir ^. ProtoFields.maybe'equityPendingChange of - Nothing -> return PPCNoChange - Just ppc -> fromProto ppc + psActiveStatus <- case pir ^. ProtoFields.maybe'poolInfo of + Nothing -> return Nothing + Just poolInfo -> do + abpsPoolInfo <- fromProto poolInfo + abpsBakerEquityCapital <- fromProto $ pir ^. ProtoFields.equityCapital + abpsDelegatedCapital <- fromProto $ pir ^. ProtoFields.delegatedCapital + abpsDelegatedCapitalCap <- fromProto $ pir ^. ProtoFields.delegatedCapitalCap + abpsBakerStakePendingChange <- + case pir ^. ProtoFields.maybe'equityPendingChange of + Nothing -> return PPCNoChange + Just ppc -> fromProto ppc + return $ Just ActiveBakerPoolStatus{..} psCurrentPaydayStatus <- fromProtoMaybe $ pir ^. ProtoFields.maybe'currentPaydayInfo psAllPoolTotalCapital <- fromProto $ pir ^. ProtoFields.allPoolTotalCapital return BakerPoolStatus{..} instance FromProto Proto.PassiveDelegationInfo where - type Output Proto.PassiveDelegationInfo = PoolStatus + type Output Proto.PassiveDelegationInfo = PassiveDelegationStatus fromProto pdi = do - psDelegatedCapital <- fromProto $ pdi ^. ProtoFields.delegatedCapital - psCommissionRates <- fromProto $ pdi ^. ProtoFields.commissionRates - psCurrentPaydayTransactionFeesEarned <- fromProto $ pdi ^. ProtoFields.currentPaydayTransactionFeesEarned - psCurrentPaydayDelegatedCapital <- fromProto $ pdi ^. ProtoFields.currentPaydayDelegatedCapital - psAllPoolTotalCapital <- fromProto $ pdi ^. ProtoFields.allPoolTotalCapital + pdsDelegatedCapital <- fromProto $ pdi ^. ProtoFields.delegatedCapital + pdsCommissionRates <- fromProto $ pdi ^. ProtoFields.commissionRates + pdsCurrentPaydayTransactionFeesEarned <- fromProto $ pdi ^. ProtoFields.currentPaydayTransactionFeesEarned + pdsCurrentPaydayDelegatedCapital <- fromProto $ pdi ^. ProtoFields.currentPaydayDelegatedCapital + pdsAllPoolTotalCapital <- fromProto $ pdi ^. ProtoFields.allPoolTotalCapital return PassiveDelegationStatus{..} instance FromProto Proto.PoolPendingChange where @@ -2167,6 +2188,10 @@ instance FromProto (Proto.AccountAddress, Proto.DelegationEvent) where let edrAccount = sender edrDelegatorId <- fromProto dRemoved return DelegationRemoved{..} + ProtoFields.DelegationEvent'BakerRemoved' bkrRemoved -> do + let ebrAccount = sender + ebrBakerId <- fromProto $ bkrRemoved ^. ProtoFields.bakerId + return BakerRemoved{..} instance FromProto (Proto.AccountAddress, Proto.BakerEvent) where type Output (Proto.AccountAddress, Proto.BakerEvent) = Event @@ -2229,6 +2254,10 @@ instance FromProto (Proto.AccountAddress, Proto.BakerEvent) where ebsfrcBakerId <- fromProto $ bsfrCommission ^. ProtoFields.bakerId ebsfrcFinalizationRewardCommission <- fromProto $ bsfrCommission ^. ProtoFields.finalizationRewardCommission return BakerSetFinalizationRewardCommission{..} + ProtoFields.BakerEvent'DelegationRemoved' delRemoved -> do + let edrAccount = sender + edrDelegatorId <- fromProto $ delRemoved ^. ProtoFields.delegatorId + return DelegationRemoved{..} instance FromProto Proto.BlockItemStatus where type Output Proto.BlockItemStatus = TransactionStatus @@ -3259,13 +3288,13 @@ getBlocksAtHeight blockHeight = withUnary (call @"getBlocksAtHeight") msg (fmap msg = toProto blockHeight -- | Get information about the passive delegators at the end of a given block. -getPassiveDelegationInfo :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult PoolStatus)) +getPassiveDelegationInfo :: (MonadIO m) => BlockHashInput -> ClientMonad m (GRPCResult (FromProtoResult PassiveDelegationStatus)) getPassiveDelegationInfo bhInput = withUnary (call @"getPassiveDelegationInfo") msg (fmap fromProto) where msg = toProto bhInput -- | Get information about a given pool at the end of a given block. -getPoolInfo :: (MonadIO m) => BlockHashInput -> BakerId -> ClientMonad m (GRPCResult (FromProtoResult PoolStatus)) +getPoolInfo :: (MonadIO m) => BlockHashInput -> BakerId -> ClientMonad m (GRPCResult (FromProtoResult BakerPoolStatus)) getPoolInfo bhInput baker = withUnary (call @"getPoolInfo") msg (fmap fromProto) where msg = defMessage & ProtoFields.blockHash .~ toProto bhInput & ProtoFields.baker .~ toProto baker diff --git a/src/Concordium/Client/Runner.hs b/src/Concordium/Client/Runner.hs index 90be31ee..e8d8a0d7 100644 --- a/src/Concordium/Client/Runner.hs +++ b/src/Concordium/Client/Runner.hs @@ -1165,7 +1165,7 @@ getDelegatorCooldown (Queries.EChainParametersAndKeys (ecpParams :: ChainParamet return $ Just $ addUTCTime cooldownTime currTime -- | Query the chain for the given account. --- Die printing an error message containing the nature of the error if such occured. +-- Die printing an error message containing the nature of the error if such occurred. getAccountInfoOrDie :: (MonadIO m) => Types.AccountIdentifier -> BlockHashInput -> ClientMonad m Types.AccountInfo getAccountInfoOrDie sender bhInput = do res <- getAccountInfo sender bhInput @@ -1179,12 +1179,10 @@ getAccountInfoOrDie sender bhInput = do RequestFailed err -> logFatal ["I/O error: " <> err] -- | Query the chain for the given pool. --- Die printing an error message containing the nature of the error if such occured. -getPoolStatusOrDie :: Maybe Types.BakerId -> ClientMonad IO Queries.PoolStatus -getPoolStatusOrDie mbid = do - psRes <- case mbid of - Nothing -> getPassiveDelegationInfo Best - Just bId -> getPoolInfo Best bId +-- Die printing an error message containing the nature of the error if such occurred. +getPoolStatusOrDie :: Types.BakerId -> ClientMonad IO Queries.BakerPoolStatus +getPoolStatusOrDie bId = do + psRes <- getPoolInfo Best bId let res = case psRes of StatusOk resp -> case grpcResponseVal resp of Left err -> Left $ "Cannot decode pool status response from the node: " <> err @@ -3804,16 +3802,20 @@ processDelegatorConfigureCmd baseCfgDir verbose backend txOpts cdCapital cdResta Nothing -> return () Just Types.DelegatePassive -> return () Just (Types.DelegateToBaker bid) -> do - poolStatus <- getPoolStatusOrDie $ Just bid - let alreadyDelegatedToThisBaker = case alreadyBakerId of - Just abid -> if abid == bid then alreadyDelegatedToBakerPool else 0 - Nothing -> 0 - case poolStatus of - Queries.BakerPoolStatus{..} -> when (psDelegatedCapital + capital - alreadyDelegatedToThisBaker > psDelegatedCapitalCap) $ do - logWarn [[i|Staked amount (#{showCcd capital}) plus the stake already delegated the pool is larger than the maximum allowed delegated stake).|]] + poolStatus <- getPoolStatusOrDie bid + case Queries.psActiveStatus poolStatus of + Nothing -> do + logWarn [[i|The delegation target (#{bid}) is not an active pool.|]] confirmed <- askConfirmation $ Just "This transaction will most likely be rejected by the chain, do you wish to send it anyway" unless confirmed exitTransactionCancelled - _ -> return () -- Should not happen + Just (Queries.ActiveBakerPoolStatus{..}) -> do + let alreadyDelegatedToThisBaker = case alreadyBakerId of + Just abid -> if abid == bid then alreadyDelegatedToBakerPool else 0 + Nothing -> 0 + when (abpsDelegatedCapital + capital - alreadyDelegatedToThisBaker > abpsDelegatedCapitalCap) $ do + logWarn [[i|Staked amount (#{showCcd capital}) plus the stake already delegated the pool is larger than the maximum allowed delegated stake).|]] + confirmed <- askConfirmation $ Just "This transaction will most likely be rejected by the chain, do you wish to send it anyway" + unless confirmed exitTransactionCancelled warnAboutBadCapital txCfg capital = do let senderAddr = naAddr . esdAddress . tcEncryptedSigningData $ txCfg Types.AccountInfo{..} <- getAccountInfoOrDie (Types.AccAddress senderAddr) Best @@ -4077,11 +4079,9 @@ processLegacyCmd action backend = GetPoolStatus pool block -> withClient backend $ do b <- readBlockHashOrDefault Best block - ( case pool of - Nothing -> getPassiveDelegationInfo b - Just p -> getPoolInfo b p - ) - >>= printResponseValueAsJSON + case pool of + Nothing -> getPassiveDelegationInfo b >>= printResponseValueAsJSON + Just p -> getPoolInfo b p >>= printResponseValueAsJSON GetBakerList block -> withClient backend $ readBlockHashOrDefault Best block From 7fef26d48b5a5cfde1dfa59b0da7c522e5cf710b Mon Sep 17 00:00:00 2001 From: Thomas Dinsdale-Young Date: Mon, 19 Aug 2024 11:26:20 +0200 Subject: [PATCH 2/4] Fix test setup. --- test/SimpleClientTests/AccountSpec.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/SimpleClientTests/AccountSpec.hs b/test/SimpleClientTests/AccountSpec.hs index af2d83db..096e5fff 100644 --- a/test/SimpleClientTests/AccountSpec.hs +++ b/test/SimpleClientTests/AccountSpec.hs @@ -124,7 +124,9 @@ exampleAccountInfoResult staking cs = }, aiAccountEncryptionKey = dummyEncryptionPublicKey, aiAccountIndex = 27, - aiAccountAddress = exampleAddress1 + aiAccountAddress = exampleAddress1, + aiAccountCooldowns = [], + aiAccountAvailableAmount = Types.Amount 1 } exampleCredentials :: IDTypes.Policy -> IDTypes.RawAccountCredential From 4df7190b82ec2ce2c14eda992406ed276f82fd2a Mon Sep 17 00:00:00 2001 From: Thomas Dinsdale-Young Date: Mon, 19 Aug 2024 12:45:02 +0200 Subject: [PATCH 3/4] Update change log --- ChangeLog.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ChangeLog.md b/ChangeLog.md index df6ba540..b724ff72 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,8 @@ ## Unreleased +- Support node version 7 and protocol version 7. + ## 6.3.0 - Remove command `raw SendTransaction`. From ba1dc42eb095114234c92e3d487b39007450f916 Mon Sep 17 00:00:00 2001 From: Thomas Dinsdale-Young Date: Mon, 19 Aug 2024 17:23:03 +0200 Subject: [PATCH 4/4] Fix warnings and force no warnings in CI. --- .github/workflows/ci.yaml | 2 +- src/Concordium/Client/Types/Transaction.hs | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index d7b55a93..8e556aa9 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -96,6 +96,6 @@ jobs: key: ${{ runner.os }}-rust-stack-deps-${{ env.RUST }}-${{ hashFiles('stack.yaml', 'package.yaml', 'deps/concordium-base/haskell-src/**.hs', 'deps/concordium-base/rust-src/Cargo.toml', 'deps/concordium-base/rust-src/**.rs') }} - name: Stack build # build all the binaries and tests, but don't run the tests - run: stack build --test --no-run-tests + run: stack build --test --no-run-tests --ghc-options "-Werror" - name: Stack test # run the tests run: stack build --test diff --git a/src/Concordium/Client/Types/Transaction.hs b/src/Concordium/Client/Types/Transaction.hs index 15c93118..85bad9e6 100644 --- a/src/Concordium/Client/Types/Transaction.hs +++ b/src/Concordium/Client/Types/Transaction.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module Concordium.Client.Types.Transaction where @@ -11,7 +9,6 @@ import Concordium.Types.Execution as Types import qualified Concordium.Types.Transactions as Types import Data.Aeson as AE -import Data.Text hiding (length, map) -- | Base cost of checking the transaction. The cost is always at least this, -- but in most cases it will have a transaction specific cost.