Tidy up coding style.

Use hoistMaybe to flatten code. Reduce use of where clauses, especially nested where clauses. Add documentation.
IntersectMBO · Apr 13, 2021 · 7a64068 · 7a64068
1 parent 499803b
commit 7a64068
Show file tree

Hide file tree

Showing 6 changed files with 260 additions and 176 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -690,11 +690,10 @@ pQueryCmd =
         <*> pMaybeOutputFile
 
     pQueryTip :: Parser QueryCmd
-    pQueryTip =
-      QueryTip
-        <$> pConsensusModeParams
-        <*> pNetworkId
-        <*> pMaybeOutputFile
+    pQueryTip = QueryTip
+                  <$> pConsensusModeParams
+                  <*> pNetworkId
+                  <*> pMaybeOutputFile
 
     pQueryUTxO :: Parser QueryCmd
     pQueryUTxO =
@@ -720,32 +719,28 @@ pQueryCmd =
         <*> pMaybeOutputFile
 
     pQueryLedgerState :: Parser QueryCmd
-    pQueryLedgerState =
-      QueryLedgerState'
-        <$> pConsensusModeParams
-        <*> pNetworkId
-        <*> pMaybeOutputFile
+    pQueryLedgerState = QueryLedgerState'
+                          <$> pConsensusModeParams
+                          <*> pNetworkId
+                          <*> pMaybeOutputFile
 
     pQueryProtocolState :: Parser QueryCmd
-    pQueryProtocolState =
-      QueryProtocolState'
-        <$> pConsensusModeParams
-        <*> pNetworkId
-        <*> pMaybeOutputFile
+    pQueryProtocolState = QueryProtocolState'
+                            <$> pConsensusModeParams
+                            <*> pNetworkId
+                            <*> pMaybeOutputFile
 
     pQueryStakeSnapshot :: Parser QueryCmd
-    pQueryStakeSnapshot =
-      QueryStakeSnapshot'
-        <$> pConsensusModeParams
-        <*> pNetworkId
-        <*> pStakePoolVerificationKeyHash
+    pQueryStakeSnapshot = QueryStakeSnapshot'
+      <$> pConsensusModeParams
+      <*> pNetworkId
+      <*> pStakePoolVerificationKeyHash
 
     pQueryPoolParams :: Parser QueryCmd
-    pQueryPoolParams =
-      QueryPoolParams'
-        <$> pConsensusModeParams
-        <*> pNetworkId
-        <*> pStakePoolVerificationKeyHash
+    pQueryPoolParams = QueryPoolParams'
+      <$> pConsensusModeParams
+      <*> pNetworkId
+      <*> pStakePoolVerificationKeyHash
 
 
 pGovernanceCmd :: Parser GovernanceCmd

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -24,7 +24,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.HashMap.Strict as HMS
 import           Data.List (nub)
 import qualified Data.Map.Strict as Map
-import           Data.Maybe
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
@@ -256,60 +255,44 @@ runQueryPoolParams
   -> NetworkId
   -> Hash StakePoolKey
   -> ExceptT ShelleyQueryCmdError IO ()
-runQueryPoolParams (AnyConsensusModeParams cModeParams)
-                    network poolid = do
+runQueryPoolParams (AnyConsensusModeParams cModeParams) network poolid = do
   SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
   anyE@(AnyCardanoEra era) <- determineEra cModeParams localNodeConnInfo
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
 
-  case toEraInMode era cMode of
-    Just eInMode -> do
-      let qInMode = QueryInEra eInMode
-                      . QueryInShelleyBasedEra sbe
-                      $ QueryLedgerState
-      result <- executeQuery
-                  era
-                  cModeParams
-                  localNodeConnInfo
-                  qInMode
-      obtainLedgerEraClassConstraints sbe (writePoolParams poolid) result
-    Nothing -> left . ShelleyQueryCmdEraConsensusModeMismatch anyE $ AnyConsensusMode cMode
+  eInMode <- toEraInMode era cMode
+    & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyE (AnyConsensusMode cMode))
+
+  let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryLedgerState
+  result <- executeQuery era cModeParams localNodeConnInfo qInMode
+  obtainLedgerEraClassConstraints sbe (writePoolParams poolid) result
 
 
 -- | Obtain stake snapshot information for a pool, plus information about the total active stake.
 -- This information can be used for leader slot calculation, for example, and has been requested by SPOs.
 -- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump.
---
-
 runQueryStakeSnapshot
   :: AnyConsensusModeParams
   -> NetworkId
   -> Hash StakePoolKey
   -> ExceptT ShelleyQueryCmdError IO ()
-runQueryStakeSnapshot (AnyConsensusModeParams cModeParams)
-                    network poolid = do
+runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network poolid = do
   SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
   anyE@(AnyCardanoEra era) <- determineEra cModeParams localNodeConnInfo
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
 
-  case toEraInMode era cMode of
-    Just eInMode -> do
-      let qInMode = QueryInEra eInMode
-                      . QueryInShelleyBasedEra sbe
-                      $ QueryLedgerState
-      result <- executeQuery
-                  era
-                  cModeParams
-                  localNodeConnInfo
-                  qInMode
-      obtainLedgerEraClassConstraints sbe (writeStakeSnapshot poolid) result
-    Nothing -> left . ShelleyQueryCmdEraConsensusModeMismatch anyE $ AnyConsensusMode cMode
+  eInMode <- toEraInMode era cMode
+    & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyE (AnyConsensusMode cMode))
+
+  let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryLedgerState
+  result <- executeQuery era cModeParams localNodeConnInfo qInMode
+  obtainLedgerEraClassConstraints sbe (writeStakeSnapshot poolid) result
 
 
 runQueryLedgerState
@@ -453,111 +436,86 @@ writeLedgerState mOutFile qState@(SerialisedLedgerState serLedgerState) =
       handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath)
         $ LBS.writeFile fpath $ unSerialised serLedgerState
 
-writeStakeSnapshot :: forall era ledgerera.
-                      ShelleyLedgerEra era ~ ledgerera
-                   => Era.Era ledgerera
-                   => FromCBOR (LedgerState era)
-                   => Hash StakePoolKey
-                   -> SerialisedLedgerState era
-                   -> ExceptT ShelleyQueryCmdError IO ()
-
+writeStakeSnapshot :: forall era ledgerera. ()
+  => ShelleyLedgerEra era ~ ledgerera
+  => Era.Era ledgerera
+  => FromCBOR (LedgerState era)
+  => Hash StakePoolKey
+  -> SerialisedLedgerState era
+  -> ExceptT ShelleyQueryCmdError IO ()
 writeStakeSnapshot poolId qState =
   case decodeLedgerState qState of
+    -- In the event of decode failure print the CBOR instead
     Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs
-    Right ledgerState ->
-      if isNothing maybehk then
-        left $ ShelleyQueryCmdPoolIdError poolId
-      else
-        liftIO . LBS.putStrLn $ encodePretty $
-          Stakes { markpool = markStake
-                 , setpool = setStake
-                 , gopool = goStake
-                 , marktot = markTotal
-                 , settot = setTotal
-                 , gotot = goTotal
-                 }
-      where
-        -- Ledger State
-        (LedgerState snapshot) = ledgerState
-
-        -- The three stake snapshots, obtained from the ledger state
-        (SnapShots markS setS goS _) = esSnapshots $ nesEs snapshot
-
-
-        -- Calculate the three pool and active stake values for the given pool
-        markStake =  getPoolStake hk markS
-        setStake = getPoolStake hk setS
-        goStake = getPoolStake hk goS
-
-        markTotal = getAllStake markS
-        setTotal = getAllStake setS
-        goTotal = getAllStake goS
-
-        -- Convert the hash string into a KeyHash for use by the ledger
-        maybehk = hashFromStringAsHex $ filter (/= '"') $ show poolId
-        hk = KeyHash $ fromJust maybehk
-
-        -- Sum all the stake that is held by the pool
-        getPoolStake :: KeyHash Shelley.Spec.Ledger.Keys.StakePool crypto
-                     -> SnapShot crypto
-                     -> Integer
-        getPoolStake hash ss = pStake
-          where
-            Coin pStake = fold s
-            (Stake s) = poolStake hash (_delegations ss) (_stake ss)
-
-        -- Sum the active stake from a snapshot
-        getAllStake :: SnapShot crypto
-                    -> Integer
-        getAllStake (SnapShot stake _ _) = activeStake
-          where
-            Coin activeStake = fold . unStake $ stake
+
+    Right ledgerState -> do
+      -- Convert the hash string into a KeyHash for use by the ledger
+      hk <- KeyHash <$> hashFromStringAsHex (filter (/= '"') (show poolId))
+        & hoistMaybe (ShelleyQueryCmdPoolIdError poolId)
+
+      -- Ledger State
+      let (LedgerState snapshot) = ledgerState
+
+      -- The three stake snapshots, obtained from the ledger state
+      let (SnapShots markS setS goS _) = esSnapshots $ nesEs snapshot
+
+      -- Calculate the three pool and active stake values for the given pool
+      liftIO . LBS.putStrLn $ encodePretty $ Stakes
+        { markPool = getPoolStake hk markS
+        , setPool = getPoolStake hk setS
+        , goPool = getPoolStake hk goS
+        , markTotal = getAllStake markS
+        , setTotal = getAllStake setS
+        , goTotal = getAllStake goS
+        }
+
+-- | Sum all the stake that is held by the pool
+getPoolStake :: KeyHash Shelley.Spec.Ledger.Keys.StakePool crypto -> SnapShot crypto -> Integer
+getPoolStake hash ss = pStake
+  where
+    Coin pStake = fold s
+    (Stake s) = poolStake hash (_delegations ss) (_stake ss)
+
+-- | Sum the active stake from a snapshot
+getAllStake :: SnapShot crypto -> Integer
+getAllStake (SnapShot stake _ _) = activeStake
+  where
+    Coin activeStake = fold . unStake $ stake
 
 -- | 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>
-writePoolParams :: forall era ledgerera.
-                   ShelleyLedgerEra era ~ ledgerera
-                => FromCBOR (LedgerState era)
-                => Crypto.Crypto (Era.Crypto ledgerera)
-                => Hash StakePoolKey
-                -> SerialisedLedgerState era
-                -> ExceptT ShelleyQueryCmdError IO ()
+writePoolParams :: forall era ledgerera. ()
+  => ShelleyLedgerEra era ~ ledgerera
+  => FromCBOR (LedgerState era)
+  => Crypto.Crypto (Era.Crypto ledgerera)
+  => Hash StakePoolKey
+  -> SerialisedLedgerState era
+  -> ExceptT ShelleyQueryCmdError IO ()
 writePoolParams poolId qState =
   case decodeLedgerState qState of
+    -- In the event of decode failure print the CBOR instead
     Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs
-    Right ledgerState ->
-      if isNothing maybehk then
-        left $ ShelleyQueryCmdPoolIdError poolId
-      else
-        liftIO . LBS.putStrLn $  encodePretty $ Params poolparams fpoolparams retiring
-      where
-        (LedgerState snapshot)  = ledgerState
-
-        -- pool state
-        ps = _pstate $ _delegationState $ esLState $ nesEs snapshot
-
-        -- Convert the hash string into a KeyHash for use by the ledger
-        maybehk = hashFromStringAsHex $ filter (/= '"') $ show poolId
-        hk = KeyHash $ fromJust maybehk
-
-        -- pool parameters
-        poolparams = getPoolParams hk $ _pParams ps
-        fpoolparams = getPoolParams hk $ _fPParams ps
-        retiring = getPoolParams hk $ _retiring ps
-
-
-        getPoolParams :: KeyHash StakePool (Era.Crypto ledgerera)
-                      -> Map (KeyHash StakePool (Era.Crypto ledgerera)) params
-                      -> Maybe params
-        getPoolParams poolid poolparammap = Map.lookup poolid poolparammap
-
-decodeLedgerState ::
-  forall era.
-     FromCBOR (LedgerState era)
+
+    Right ledgerState -> do
+      let LedgerState snapshot = ledgerState
+      let poolState = _pstate $ _delegationState $ esLState $ nesEs snapshot
+
+      -- Convert the hash string into a KeyHash for use by the ledger
+      hk <- KeyHash <$> hashFromStringAsHex (filter (/= '"') (show poolId))
+        & hoistMaybe (ShelleyQueryCmdPoolIdError poolId)
+
+      -- Pool parameters
+      let poolParams = Map.lookup hk $ _pParams poolState
+      let fPoolParams = Map.lookup hk $ _fPParams poolState
+      let retiring = Map.lookup hk $ _retiring poolState
+
+      liftIO . LBS.putStrLn $ encodePretty $ Params poolParams fPoolParams retiring
+
+decodeLedgerState :: forall era. ()
+  => FromCBOR (LedgerState era)
   => SerialisedLedgerState era
   -> Either LBS.ByteString (LedgerState era)
-decodeLedgerState (SerialisedLedgerState (Serialised ls)) =
-  first (const ls) (decodeFull ls)
+decodeLedgerState (SerialisedLedgerState (Serialised ls)) = first (const ls) (decodeFull ls)
 
 writeProtocolState :: Crypto.Crypto StandardCrypto
                    => Maybe OutputFile