Skip to content

Commit e6abfc1

Browse files
carbolymercarbolymer
committed
Add ledger peer type parameter for the ledger peer query
1 parent 5f13196 commit e6abfc1

3 files changed

Lines changed: 47 additions & 44 deletions

File tree

‎cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -151,6 +151,7 @@ data QueryLedgerStateCmdArgs = QueryLedgerStateCmdArgs
151151

152152
data QueryLedgerPeerSnapshotCmdArgs = QueryLedgerPeerSnapshotCmdArgs
153153
{ commons :: !QueryCommons
154+
, ledgerPeerKind :: !Consensus.LedgerPeersKind
154155
, outputFormat :: !(Vary [FormatJson, FormatYaml])
155156
, mOutFile :: !(Maybe (File () Out))
156157
}

‎cardano-cli/src/Cardano/CLI/EraBased/Query/Option.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -447,12 +447,21 @@ pQueryLedgerPeerSnapshotCmd envCli =
447447
fmap QueryLedgerPeerSnapshotCmd $
448448
QueryLedgerPeerSnapshotCmdArgs
449449
<$> pQueryCommons @era envCli
450+
<*> pLedgerPeersKind
450451
<*> pFormatQueryOutputFlags
451452
"ledger-peer-snapshot"
452453
[ flagFormatJson & setDefault
453454
, flagFormatYaml
454455
]
455456
<*> pMaybeOutputFile
457+
where
458+
pLedgerPeersKind :: Parser LedgerPeersKind
459+
pLedgerPeersKind =
460+
Opt.flag BigLedgerPeers AllLedgerPeers $
461+
mconcat
462+
[ Opt.long "all-ledger-peers"
463+
, Opt.help "Query all ledger peers instead of big ones"
464+
]
456465

457466
pQueryProtocolStateCmd :: forall era. IsEra era => EnvCli -> Parser (QueryCmds era)
458467
pQueryProtocolStateCmd envCli =

‎cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs‎

Lines changed: 37 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,6 @@ import Cardano.Api.Experimental (obtainCommonConstraints)
4444
import Cardano.Api.Experimental qualified as Exp
4545
import Cardano.Api.Ledger (strictMaybeToMaybe)
4646
import Cardano.Api.Ledger qualified as L
47-
import Cardano.Ledger.Address qualified as L
4847
import Cardano.Api.Network qualified as Consensus
4948

5049
import Cardano.Binary qualified as CBOR
@@ -67,6 +66,7 @@ import Cardano.CLI.Type.Key
6766
import Cardano.CLI.Type.Output (QueryDRepStateOutput (..))
6867
import Cardano.CLI.Type.Output qualified as O
6968
import Cardano.Crypto.Hash (hashToBytesAsHex)
69+
import Cardano.Ledger.Address qualified as L
7070
import Cardano.Ledger.Api.State.Query qualified as L
7171
import Cardano.Ledger.Conway.State (ChainAccountState (..))
7272
import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo)
@@ -359,7 +359,7 @@ runQueryKesPeriodInfoCmd
359359
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
360360
AnyCardanoEra cEra <- easyRunQueryCurrentEra
361361

362-
era <- hoist liftIO $ supportedEra cEra
362+
era <- supportedEra cEra
363363
let sbe = convert era
364364
-- We check that the KES period specified in the operational certificate is correct
365365
-- based on the KES period defined in the genesis parameters and the current slot number
@@ -653,7 +653,7 @@ runQueryPoolStateCmd
653653
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
654654
AnyCardanoEra cEra <- easyRunQueryCurrentEra
655655

656-
era <- hoist liftIO $ supportedEra cEra
656+
era <- supportedEra cEra
657657

658658
let beo = convert era
659659
poolFilter = case allOrOnlyPoolIds of
@@ -733,7 +733,7 @@ runQueryRefScriptSizeCmd
733733
r <- fromEitherIOCli $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
734734
AnyCardanoEra cEra <- easyRunQueryCurrentEra
735735

736-
era <- hoist liftIO $ supportedEra cEra
736+
era <- supportedEra cEra
737737

738738
let beo = convert era
739739
sbe = convert era
@@ -780,7 +780,7 @@ runQueryStakeSnapshotCmd
780780
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
781781
AnyCardanoEra cEra <- easyRunQueryCurrentEra
782782

783-
era <- hoist liftIO $ supportedEra cEra
783+
era <- supportedEra cEra
784784

785785
let poolFilter = case allOrOnlyPoolIds of
786786
All -> Nothing
@@ -814,7 +814,7 @@ runQueryLedgerStateCmd
814814
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
815815
AnyCardanoEra cEra <- easyRunQueryCurrentEra
816816

817-
era <- hoist liftIO $ supportedEra cEra
817+
era <- supportedEra cEra
818818
let sbe = convert era
819819
serialisedDebugLedgerState <- easyRunQuery (queryDebugLedgerState sbe)
820820

@@ -878,47 +878,37 @@ runQueryLedgerPeerSnapshot
878878
{ Cmd.nodeConnInfo
879879
, Cmd.target
880880
}
881+
, Cmd.ledgerPeerKind
881882
, Cmd.outputFormat
882883
, Cmd.mOutFile
883884
} = do
884-
result <-
885-
fromEitherIOCli
885+
(ntcVersion, result) <-
886+
(fromEitherIOCli . fromEitherIOCli)
886887
( executeLocalStateQueryExprWithVersion nodeConnInfo target $ \globalNtcVersion -> runExceptT $ do
887888
AnyCardanoEra cEra <-
888889
lift queryCurrentEra
889890
& onLeft (left . QueryCmdUnsupportedNtcVersion)
890891

891-
era <- hoist liftIO $ supportedEra cEra
892-
let sbe = convert era
893-
894-
let ledgerPeerKind = undefined -- TODO(10.7)
895-
result <- easyRunQuery (queryLedgerPeerSnapshot sbe ledgerPeerKind)
896-
897-
shelleyNtcVersion <- hoistEither $ getShelleyNodeToClientVersion era globalNtcVersion
898-
899-
hoist liftIO $
900-
obtainCommonConstraints era $
901-
case decodeLedgerPeerSnapshot shelleyNtcVersion result of
902-
Left (bs, _decoderError) -> undefined -- pure $ Left bs -- TODO(10.7)
903-
Right snapshot -> undefined -- pure $ Right snapshot -- TODO(10.7)
892+
era <- supportedEra cEra
893+
ntcVersion <- hoistEither (getShelleyNodeToClientVersion era globalNtcVersion)
894+
result <- easyRunQuery (queryLedgerPeerSnapshot (convert era) ledgerPeerKind)
895+
pure (ntcVersion, result)
904896
)
905-
& fromEitherCIOCli
906897

907-
case result of
908-
Left (bs :: LBS.ByteString) -> do
898+
case decodeLedgerPeerSnapshot ntcVersion result of
899+
Left (bs, decoderError) -> do
900+
-- unable to decode, just dump cbor with a warning
901+
liftIO . IO.hPrint IO.stderr $ decoderError
909902
fromExceptTCli $ pPrintCBOR bs
910-
-- Right (snapshot :: LedgerPeerSnapshot) -> do
911-
Right _ -> do
912-
let snapshot = undefined -- TODO(10.7)
913-
let output = undefined -- TODO(10.7)
914-
-- outputFormat
915-
-- & ( id
916-
-- . Vary.on (\FormatJson -> Json.encodeJson)
917-
-- . Vary.on (\FormatYaml -> Json.encodeYaml)
918-
-- $ Vary.exhaustiveCase
919-
-- )
920-
-- $ snapshot
921-
903+
Right (SomeLedgerPeerSnapshot Proxy snapshot) -> do
904+
let output =
905+
outputFormat
906+
& ( id
907+
. Vary.on (\FormatJson -> Json.encodeJson)
908+
. Vary.on (\FormatYaml -> Json.encodeYaml)
909+
$ Vary.exhaustiveCase
910+
)
911+
$ snapshot
922912
fromEitherIOCli @(FileError ()) $
923913
writeLazyByteStringOutput mOutFile output
924914

@@ -1028,7 +1018,7 @@ getQueryStakeAddressInfo
10281018
lift $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
10291019
AnyCardanoEra cEra <- easyRunQueryCurrentEra
10301020

1031-
era <- hoist liftIO $ supportedEra cEra
1021+
era <- supportedEra cEra
10321022

10331023
let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr
10341024
sbe = convert era
@@ -1055,7 +1045,7 @@ getQueryStakeAddressInfo
10551045
| gas <- toList govActionStates
10561046
, let proc = L.gasProposalProcedure gas
10571047
, let rewardAccount = L.pProcReturnAddr proc
1058-
stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential ( rewardAccount ^. L.accountAddressCredentialL)
1048+
stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential (rewardAccount ^. L.accountAddressCredentialL)
10591049
, stakeCredential == fromShelleyStakeCredential addr
10601050
]
10611051

@@ -1291,7 +1281,7 @@ runQueryStakePoolsCmd
12911281
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT @QueryCmdError $ do
12921282
AnyCardanoEra cEra <- easyRunQueryCurrentEra
12931283

1294-
era <- hoist liftIO $ supportedEra cEra
1284+
era <- supportedEra cEra
12951285
let sbe = convert era
12961286
poolIds <- easyRunQuery (queryStakePools sbe)
12971287

@@ -1363,7 +1353,7 @@ runQueryStakeDistributionCmd
13631353
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
13641354
AnyCardanoEra cEra <- easyRunQueryCurrentEra
13651355

1366-
era <- hoist liftIO $ supportedEra cEra
1356+
era <- supportedEra cEra
13671357
let sbe = convert era
13681358
result <- easyRunQuery (queryStakeDistribution sbe)
13691359

@@ -1441,7 +1431,7 @@ runQueryLeadershipScheduleCmd
14411431
( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
14421432
AnyCardanoEra cEra <- easyRunQueryCurrentEra
14431433

1444-
era <- hoist liftIO $ supportedEra cEra
1434+
era <- supportedEra cEra
14451435
let sbe = convert era
14461436

14471437
pparams <- easyRunQuery (queryProtocolParameters sbe)
@@ -2102,7 +2092,10 @@ easyRunQuery q =
21022092
& onLeft (left . QueryCmdUnsupportedNtcVersion)
21032093
& onLeft (left . QueryCmdEraMismatch)
21042094

2105-
supportedEra :: Typeable era => CardanoEra era -> ExceptT QueryCmdError IO (Exp.Era era)
2095+
supportedEra
2096+
:: Typeable era
2097+
=> MonadError QueryCmdError m
2098+
=> CardanoEra era
2099+
-> m (Exp.Era era)
21062100
supportedEra cEra =
2107-
pure (forEraMaybeEon cEra)
2108-
& onNothing (left $ QueryCmdEraNotSupported (AnyCardanoEra cEra))
2101+
maybe (throwError $ QueryCmdEraNotSupported (AnyCardanoEra cEra)) pure $ forEraMaybeEon cEra

0 commit comments

Comments
 (0)