Skip to content

Commit

Permalink
Merge pull request #603 from palas/add-immutable-tip
Browse files Browse the repository at this point in the history 
Add immutable tip parameter to conway queries
  • Loading branch information
@palas
palas authored Feb 12, 2024
2 parents 7e457f7 + 5b04a3b commit 07180c3
Show file tree
Hide file tree
Showing 25 changed files with 286 additions and 76 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/haskell.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ jobs:

env:
# Modify this value to "invalidate" the cabal cache.
CABAL_CACHE_VERSION: "2024-02-12-1"
CABAL_CACHE_VERSION: "2024-02-12-2"

concurrency:
group: >
Expand Down
18 changes: 18 additions & 0 deletions cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@ import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))

import Cardano.CLI.Types.Common
import Cardano.CLI.Types.Key
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus

import Data.Text (Text)
import Data.Time.Clock
Expand Down Expand Up @@ -67,6 +68,7 @@ data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs
, poolColdVerKeyFile :: !(VerificationKeyOrHashOrFile StakePoolKey)
, vrkSkeyFp :: !(SigningKeyFile In)
, whichSchedule :: !EpochLeadershipSchedule
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

Expand All @@ -81,27 +83,31 @@ data QueryConstitutionHashCmdArgs = QueryConstitutionHashCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

data QueryTipCmdArgs = QueryTipCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

data QueryStakePoolsCmdArgs = QueryStakePoolsCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

data QueryStakeDistributionCmdArgs = QueryStakeDistributionCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

Expand All @@ -110,6 +116,7 @@ data QueryStakeAddressInfoCmdArgs = QueryStakeAddressInfoCmdArgs
, consensusModeParams :: !ConsensusModeParams
, addr :: !StakeAddress
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

Expand All @@ -118,20 +125,23 @@ data QueryUTxOCmdArgs = QueryUTxOCmdArgs
, consensusModeParams :: !ConsensusModeParams
, queryFilter :: !QueryUTxOFilter
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

data QueryLedgerStateCmdArgs = QueryLedgerStateCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

data QueryProtocolStateCmdArgs = QueryProtocolStateCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

Expand All @@ -140,6 +150,7 @@ data QueryStakeSnapshotCmdArgs = QueryStakeSnapshotCmdArgs
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, allOrOnlyPoolIds :: !(AllOrOnly (Hash StakePoolKey))
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

Expand All @@ -148,6 +159,7 @@ data QueryKesPeriodInfoCmdArgs = QueryKesPeriodInfoCmdArgs
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, nodeOpCertFp :: !(File () In) -- ^ Node operational certificate
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving (Generic, Show)

Expand All @@ -156,6 +168,7 @@ data QueryPoolStateCmdArgs = QueryPoolStateCmdArgs
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, allOrOnlyPoolIds :: !(AllOrOnly (Hash StakePoolKey))
, target :: !(Consensus.Target ChainPoint)
} deriving (Generic, Show)

data QueryTxMempoolCmdArgs = QueryTxMempoolCmdArgs
Expand All @@ -171,6 +184,7 @@ data QuerySlotNumberCmdArgs = QuerySlotNumberCmdArgs
{ nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, utcTime :: !UTCTime
} deriving (Generic, Show)

Expand All @@ -179,6 +193,7 @@ data QueryNoArgCmdArgs era = QueryNoArgCmdArgs
, nodeSocketPath :: !SocketPath
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving Show

Expand All @@ -188,6 +203,7 @@ data QueryDRepStateCmdArgs era = QueryDRepStateCmdArgs
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, drepKeys :: !(AllOrOnly (VerificationKeyOrHashOrFile DRepKey))
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving Show

Expand All @@ -197,6 +213,7 @@ data QueryDRepStakeDistributionCmdArgs era = QueryDRepStakeDistributionCmdArgs
, consensusModeParams :: !ConsensusModeParams
, networkId :: !NetworkId
, drepKeys :: !(AllOrOnly (VerificationKeyOrHashOrFile DRepKey))
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving Show

Expand All @@ -208,6 +225,7 @@ data QueryCommitteeMembersStateCmdArgs era = QueryCommitteeMembersStateCmdArgs
, committeeColdKeys :: ![VerificationKeyOrHashOrFile CommitteeColdKey]
, committeeHotKeys :: ![VerificationKeyOrHashOrFile CommitteeHotKey]
, memberStatuses :: ![MemberStatus]
, target :: !(Consensus.Target ChainPoint)
, mOutFile :: !(Maybe (File () Out))
} deriving Show

Expand Down
26 changes: 25 additions & 1 deletion cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ import qualified Cardano.Ledger.BaseTypes as L
import qualified Cardano.Ledger.Crypto as Crypto
import qualified Cardano.Ledger.SafeHash as L
import qualified Cardano.Ledger.Shelley.API as Shelley
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus

import Control.Monad (mfilter)
import qualified Data.Aeson as Aeson
Expand Down Expand Up @@ -102,6 +103,29 @@ pNetworkId envCli = asum $ mconcat
pure <$> maybeToList (envCliNetworkId envCli)
]

pTarget :: CardanoEra era -> Parser (Consensus.Target ChainPoint)
pTarget = inEonForEra (pure Consensus.VolatileTip) pTargetFromConway
where
pTargetFromConway :: ConwayEraOnwards era -> Parser (Consensus.Target ChainPoint)
pTargetFromConway _ =
asum $ mconcat
[ [ Opt.flag' Consensus.VolatileTip $ mconcat
[ Opt.long "volatile-tip"
, Opt.help $ mconcat
[ "Use the volatile tip as a target. (This is the default)"
]
]
, Opt.flag' Consensus.ImmutableTip $ mconcat
[ Opt.long "immutable-tip"
, Opt.help $ mconcat
[ "Use the immutable tip as a target."
]
]
]
, -- Default to volatile tip if not specified
[ pure Consensus.VolatileTip ]
]

toUnitIntervalOrErr :: Rational -> L.UnitInterval
toUnitIntervalOrErr r = case Ledger.boundRational r of
Nothing ->
Expand Down Expand Up @@ -3217,7 +3241,7 @@ pNetworkIdForTestnetData envCli = asum $ mconcat
[ Opt.long "testnet-magic"
, Opt.metavar "NATURAL"
, Opt.help $ mconcat
[ "Specify a testnet magic id for the cluster. "
[ "Specify a testnet magic id for the cluster. "
, "This overrides both the network magic from the "
, "spec file and CARDANO_NODE_NETWORK_ID environment variable."
]
Expand Down
Loading

0 comments on commit 07180c3

Please sign in to comment.