stuff

IntersectMBO · Jan 6, 2023 · 3f95f83 · 3f95f83
1 parent 0bb11f6
commit 3f95f83
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 17 deletions.
diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs
@@ -14,6 +14,8 @@
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module Cardano.Api.Orphans () where
 
@@ -691,34 +693,34 @@ instance Crypto.Crypto crypto => ToJSON (VMap VB VP (Shelley.Credential 'Shelley
 
 -----
 
-instance ToJSON (Consensus.StakeSnapshots crypto) where
+instance Crypto.Crypto crypto => ToJSON (Consensus.StakeSnapshots crypto) where
   toJSON = object . stakeSnapshotsToPair
   toEncoding = pairs . mconcat . stakeSnapshotsToPair
 
-stakeSnapshotsToPair :: Aeson.KeyValue a => Consensus.StakeSnapshots crypto -> [a]
+stakeSnapshotsToPair :: (Aeson.KeyValue a, Crypto.Crypto crypto) => Consensus.StakeSnapshots crypto -> [a]
 stakeSnapshotsToPair Consensus.StakeSnapshots
     { Consensus.ssStakeSnapshots
     , Consensus.ssMarkTotal
     , Consensus.ssSetTotal
     , Consensus.ssGoTotal
-    } = mconcat
-    -- Only output the first pool in order to preserve backwards compatibility of the output
-    -- format.  The output format will have to change to support multiple pools when that
-    -- functionality is added.
-    [ take 1 (Map.elems ssStakeSnapshots) >>= stakeSnapshotToPair
-    , [ "activeStakeMark" .= ssMarkTotal
-      , "activeStakeSet" .= ssSetTotal
-      , "activeStakeGo" .= ssGoTotal
-      ]
+    } =
+    [ "pools" .= ssStakeSnapshots
+    , "activeStakeMark" .= ssMarkTotal
+    , "activeStakeSet" .= ssSetTotal
+    , "activeStakeGo" .= ssGoTotal
     ]
 
+instance ToJSON (Consensus.StakeSnapshot crypto) where
+  toJSON = object . stakeSnapshotToPair
+  toEncoding = pairs . mconcat . stakeSnapshotToPair
+
 stakeSnapshotToPair :: Aeson.KeyValue a => Consensus.StakeSnapshot crypto -> [a]
 stakeSnapshotToPair Consensus.StakeSnapshot
     { Consensus.ssMarkPool
     , Consensus.ssSetPool
     , Consensus.ssGoPool
     } =
-    [ "poolStakeMark" .= ssMarkPool
-    , "poolStakeSet" .= ssSetPool
-    , "poolStakeGo" .= ssGoPool
-    ]
+    [ "stakeMark" .= ssMarkPool
+    , "stakeSet" .= ssSetPool
+    , "stakeGo" .= ssGoPool
+    ]
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -89,12 +89,13 @@ import           Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCT
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime (..),
                    toRelativeTime)
 import           Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..))
-import           Ouroboros.Consensus.Protocol.TPraos
+import           Ouroboros.Consensus.Protocol.TPraos ( StandardCrypto )
 import           Ouroboros.Network.Block (Serialised (..))
 
 import qualified Ouroboros.Consensus.HardFork.History as Consensus
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus
 
 import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry
 import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
@@ -860,7 +861,19 @@ writeStakeSnapshot qState =
 
     Right (StakeSnapshot snapshot) -> do
       -- Calculate the three pool and active stake values for the given pool
-      liftIO . LBS.putStrLn $ encodePretty snapshot
+      liftIO . LBS.putStrLn $ encodePretty $ Aeson.object $
+        [ "activeStakeMark" .= Consensus.ssMarkTotal snapshot
+        , "activeStakeSet"  .= Consensus.ssSetTotal snapshot
+        , "activeStakeGo"   .= Consensus.ssGoTotal snapshot
+        ] <> poolFields snapshot
+  where poolFields :: Consensus.StakeSnapshots (Ledger.Crypto (ShelleyLedgerEra era)) -> [Aeson.Pair]
+        poolFields snapshot = case Map.elems (Consensus.ssStakeSnapshots snapshot) of
+          [pool] -> 
+            [ "poolStakeMark"   .= Consensus.ssMarkPool pool
+            , "poolStakeSet"    .= Consensus.ssSetPool pool
+            , "poolStakeGo"     .= Consensus.ssGoPool pool
+            ]
+          _ -> []
 
 -- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state
 --   .nesEs.esLState._delegationState._pstate._pParams.<pool_id>