Skip to content

Commit 37b2a92

Browse files
newhoggynewhoggy
committed
Fix query protocol-state
1 parent 6eb466a commit 37b2a92

File tree

2 files changed

+76
-33
lines changed

2 files changed

+76
-33
lines changed

‎cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs

+46-22
Original file line numberDiff line numberDiff line change
@@ -10,41 +10,42 @@
1010
{-# LANGUAGE UndecidableInstances #-}
1111

1212
{-# OPTIONS_GHC -Wno-orphans #-}
13+
{-# LANGUAGE LambdaCase #-}
1314

1415
module Cardano.CLI.Shelley.Orphans () where
1516

16-
import Cardano.Prelude
17-
18-
import Control.SetAlgebra as SetAlgebra
19-
import Data.Aeson
20-
import qualified Data.ByteString.Base16 as Base16
21-
import qualified Data.ByteString.Short as SBS
22-
import qualified Data.Text.Encoding as Text
23-
2417
import Cardano.Api.Orphans ()
25-
18+
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
19+
import Cardano.Ledger.PoolDistr (PoolDistr (..))
20+
import Cardano.Ledger.TxIn (TxId (..))
21+
import Cardano.Prelude (Bool(True), Category((.)))
22+
import Cardano.Protocol.TPraos.BHeader (HashHeader (..))
23+
import Data.Aeson (FromJSON(..), KeyValue((.=)), ToJSON(..), ToJSONKey)
2624
import Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..))
2725
import Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..))
26+
import Ouroboros.Consensus.Protocol.Praos (PraosState)
27+
import Ouroboros.Consensus.Protocol.TPraos (TPraosState)
2828
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
2929
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..))
3030
import Ouroboros.Network.Block (BlockNo (..), HeaderHash, Tip (..))
3131

32-
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
33-
import qualified Cardano.Ledger.Crypto as CC (Crypto)
34-
import Cardano.Ledger.PoolDistr (PoolDistr (..))
35-
import Cardano.Protocol.TPraos.BHeader (HashHeader (..))
36-
3732
import qualified Cardano.Ledger.Credential as Ledger
38-
import qualified Cardano.Protocol.TPraos.API as Ledger
33+
import qualified Cardano.Ledger.Crypto as CC (Crypto)
34+
import qualified Cardano.Ledger.Mary.Value as Ledger.Mary
3935
import qualified Cardano.Ledger.Shelley.EpochBoundary as Ledger
40-
import Cardano.Ledger.TxIn (TxId (..))
36+
import qualified Cardano.Ledger.Shelley.PoolRank as Ledger
37+
import qualified Cardano.Protocol.TPraos.API as Ledger
4138
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger
4239
import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger
43-
44-
import qualified Cardano.Ledger.Mary.Value as Ledger.Mary
45-
40+
import qualified Cardano.Slotting.Slot as Cardano
41+
import qualified Control.SetAlgebra as SetAlgebra (BiMap, forwards)
42+
import qualified Data.Aeson as J
43+
import qualified Data.ByteString.Base16 as Base16
44+
import qualified Data.ByteString.Short as SBS
45+
import qualified Data.Text.Encoding as Text
4646
import qualified Data.VMap as VMap
47-
import qualified Cardano.Ledger.Shelley.PoolRank as Ledger
47+
import qualified Ouroboros.Consensus.Protocol.Praos as Consensus
48+
import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
4849

4950
instance ToJSON (OneEraHash xs) where
5051
toJSON = toJSON
@@ -58,9 +59,9 @@ deriving newtype instance ToJSON ByronHash
5859
-- This instance is temporarily duplicated in cardano-config
5960

6061
instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
61-
toJSON TipGenesis = object [ "genesis" .= True ]
62+
toJSON TipGenesis = J.object [ "genesis" .= True ]
6263
toJSON (Tip slotNo headerHash blockNo) =
63-
object
64+
J.object
6465
[ "slotNo" .= slotNo
6566
, "headerHash" .= headerHash
6667
, "blockNo" .= blockNo
@@ -94,3 +95,26 @@ deriving newtype instance ToJSON (Ledger.Mary.PolicyID StandardCrypto)
9495

9596
instance (ToJSONKey k, ToJSON v) => ToJSON (SetAlgebra.BiMap v k v) where
9697
toJSON = toJSON . SetAlgebra.forwards -- to normal Map
98+
99+
instance ToJSON (TPraosState StandardCrypto) where
100+
toJSON s = J.object
101+
[ "lastSlot" .= Consensus.tpraosStateLastSlot s
102+
, "chainDepState" .= Consensus.tpraosStateChainDepState s
103+
]
104+
105+
instance ToJSON (PraosState StandardCrypto) where
106+
toJSON s = J.object
107+
[ "lastSlot" .= Consensus.praosStateLastSlot s
108+
, "oCertCounters" .= Consensus.praosStateOCertCounters s
109+
, "evolvingNonce" .= Consensus.praosStateEvolvingNonce s
110+
, "candidateNonce" .= Consensus.praosStateCandidateNonce s
111+
, "epochNonce" .= Consensus.praosStateEpochNonce s
112+
, "labNonce" .= Consensus.praosStateLabNonce s
113+
, "lastEpochBlockNonce" .= Consensus.praosStateLastEpochBlockNonce s
114+
]
115+
116+
117+
instance ToJSON (Cardano.WithOrigin Cardano.SlotNo) where
118+
toJSON = \case
119+
Cardano.Origin -> J.String "origin"
120+
Cardano.At (Cardano.SlotNo n) -> toJSON n

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

+30-11
Original file line numberDiff line numberDiff line change
@@ -676,7 +676,7 @@ runQueryProtocolState
676676
-> Maybe OutputFile
677677
-> ExceptT ShelleyQueryCmdError IO ()
678678
runQueryProtocolState (AnyConsensusModeParams cModeParams)
679-
network _mOutFile = do
679+
network mOutFile = do
680680
SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
681681
let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
682682

@@ -689,12 +689,16 @@ runQueryProtocolState (AnyConsensusModeParams cModeParams)
689689
let qInMode = QueryInEra eInMode
690690
. QueryInShelleyBasedEra sbe
691691
$ QueryProtocolState
692-
_result <- executeQuery
692+
result <- executeQuery
693693
era
694694
cModeParams
695695
localNodeConnInfo
696696
qInMode
697-
panic "currentlyBroken: runQueryProtocolState writeProtocolState mOutFile result"
697+
698+
case cMode of
699+
CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result
700+
mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode
701+
698702
Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
699703

700704
-- | Query the current delegations and reward accounts, filtered by a given
@@ -853,16 +857,18 @@ writePoolParams (StakePoolKeyHash hk) qState =
853857

854858
liftIO . LBS.putStrLn $ encodePretty $ Params poolParams fPoolParams retiring
855859

856-
_writeProtocolState :: FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
857-
=> ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
858-
=> Maybe OutputFile
859-
-> ProtocolState era
860-
-> ExceptT ShelleyQueryCmdError IO ()
861-
_writeProtocolState mOutFile ps@(ProtocolState pstate) =
860+
writeProtocolState ::
861+
( FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
862+
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
863+
)
864+
=> Maybe OutputFile
865+
-> ProtocolState era
866+
-> ExceptT ShelleyQueryCmdError IO ()
867+
writeProtocolState mOutFile ps@(ProtocolState pstate) =
862868
case mOutFile of
863869
Nothing -> case decodeProtocolState ps of
864-
Left (bs, _) -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs
865-
Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate
870+
Left (bs, _) -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs
871+
Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate
866872
Just (OutputFile fpath) ->
867873
handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath)
868874
. LBS.writeFile fpath $ unSerialised pstate
@@ -1365,6 +1371,19 @@ eligibleLeaderSlotsConstaints ShelleyBasedEraMary f = f
13651371
eligibleLeaderSlotsConstaints ShelleyBasedEraAlonzo f = f
13661372
eligibleLeaderSlotsConstaints ShelleyBasedEraBabbage f = f
13671373

1374+
eligibleWriteProtocolStateConstaints
1375+
:: ShelleyBasedEra era
1376+
-> (( FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
1377+
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
1378+
) => a
1379+
)
1380+
-> a
1381+
eligibleWriteProtocolStateConstaints ShelleyBasedEraShelley f = f
1382+
eligibleWriteProtocolStateConstaints ShelleyBasedEraAllegra f = f
1383+
eligibleWriteProtocolStateConstaints ShelleyBasedEraMary f = f
1384+
eligibleWriteProtocolStateConstaints ShelleyBasedEraAlonzo f = f
1385+
eligibleWriteProtocolStateConstaints ShelleyBasedEraBabbage f = f
1386+
13681387
-- Required instances
13691388
-- instance FromCBOR (TPraosState StandardCrypto) where
13701389
-- instance FromCBOR (Praos.PraosState StandardCrypto) where

0 commit comments

Comments
 (0)