stuff

cardano-api/src/Cardano/Api/Orphans.hs

@@ -19,7 +19,7 @@ module Cardano.Api.Orphans () where
 
 import           Prelude
 
-import           Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, (.=))
+import           Data.Aeson (FromJSON (..), ToJSON (..), object, (.=))
 import qualified Data.Aeson as Aeson
 import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
 import           Data.BiMap (BiMap (..), Bimap)
@@ -70,7 +70,6 @@ import qualified Cardano.Ledger.Shelley.Rewards as Shelley
 import qualified Cardano.Ledger.Shelley.RewardUpdate as Shelley
 import           Cardano.Ledger.Val (Val)
 import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
-import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus
 
 -- Orphan instances involved in the JSON output of the API queries.
 -- We will remove/replace these as we provide more API wrapper types
@@ -688,37 +687,3 @@ instance Crypto.Crypto crypto => ToJSON (VMap VB VB (Shelley.KeyHash    'Shelley
 instance Crypto.Crypto crypto => ToJSON (VMap VB VP (Shelley.Credential 'Shelley.Staking   crypto) (Shelley.CompactForm Shelley.Coin)) where
   toJSON = toJSON . fmap fromCompact . VMap.toMap
   toEncoding = toEncoding . fmap fromCompact . VMap.toMap
-
------
-
-instance ToJSON (Consensus.StakeSnapshots crypto) where
-  toJSON = object . stakeSnapshotsToPair
-  toEncoding = pairs . mconcat . stakeSnapshotsToPair
-
-stakeSnapshotsToPair :: Aeson.KeyValue a => 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
-      ]
-    ]
-
-stakeSnapshotToPair :: Aeson.KeyValue a => Consensus.StakeSnapshot crypto -> [a]
-stakeSnapshotToPair Consensus.StakeSnapshot
-    { Consensus.ssMarkPool
-    , Consensus.ssSetPool
-    , Consensus.ssGoPool
-    } =
-    [ "poolStakeMark" .= ssMarkPool
-    , "poolStakeSet" .= ssSetPool
-    , "poolStakeGo" .= ssGoPool
-    ]

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>

cardano-cli/src/Cardano/CLI/Types.hs

@@ -36,7 +36,6 @@ module Cardano.CLI.Types
   , TxMempoolQuery (..)
   , UpdateProposalFile (..)
   , VerificationKeyFile (..)
-  , Stakes (..)
   , Params (..)
   , RequiredSigner (..)
   ) where
@@ -182,43 +181,6 @@ data OutputFormat
   | OutputFormatBech32
   deriving (Eq, Show)
 
-
--- | This data structure is used to allow nicely formatted output within the query stake-snapshot command.
---
--- "markPool", "setPool", "goPool" are the three ledger state stake snapshots (from most recent to least recent)
--- go is the snapshot that is used for the current epoch, set will be used in the next epoch,
--- mark for the epoch after that.  "markTotal", "setTotal", "goTotal" record the total active stake for each snapshot.
---
--- This information can be used by community tools to calculate upcoming leader schedules.
-data Stakes =  Stakes
-  { markPool :: Integer
-  , setPool :: Integer
-  , goPool :: Integer
-  , markTotal :: Integer
-  , setTotal :: Integer
-  , goTotal :: Integer
-  } deriving Show
-
--- | Pretty printing for stake information
-instance ToJSON Stakes where
-  toJSON (Stakes m s g mt st gt) = object
-    [ "poolStakeMark" .= m
-    , "poolStakeSet" .= s
-    , "poolStakeGo" .= g
-    , "activeStakeMark" .= mt
-    , "activeStakeSet" .= st
-    , "activeStakeGo" .= gt
-    ]
-
-  toEncoding  (Stakes m s g mt st gt) = pairs $ mconcat
-    [ "poolStakeMark" .= m
-    , "poolStakeSet" .= s
-    , "poolStakeGo" .= g
-    , "activeStakeMark" .= mt
-    , "activeStakeSet" .= st
-    , "activeStakeGo" .= gt
-    ]
-
 -- | This data structure is used to allow nicely formatted output in the query pool-params command.
 -- params are the current pool parameter settings, futureparams are new parameters, retiringEpoch is the
 -- epoch that has been set for pool retirement.  Any of these may be Nothing.