Merge pull request #314 from Concordium/cooldown-changes

Changes to support GRPC changes.

.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

ChangeLog.md

@@ -2,6 +2,8 @@
 
 ## Unreleased
 
+- Support node version 7 and protocol version 7.
+
 ## 6.3.0
 
 - Remove command `raw SendTransaction`.

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

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

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.

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