Merge #2149

2149: Update dependencies r=dcoutts a=mrBliss Visible changes: * IntersectMBO/cardano-ledger#1993 * IntersectMBO/cardano-ledger#2021 Co-authored-by: Thomas Winant <[email protected]> Co-authored-by: Duncan Coutts <[email protected]> Co-authored-by: Luke Nadur <[email protected]>
IntersectMBO · Dec 1, 2020 · 8d7dad4 · 8d7dad4
2 parents d4a3251 + d13bf0d
commit 8d7dad4
Show file tree

Hide file tree

Showing 2 changed files with 68 additions and 56 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -46,16 +46,15 @@ import           Cardano.CLI.Types
 import           Cardano.Binary (decodeFull)
 import           Cardano.Crypto.Hash (hashToBytesAsHex)
 
-import           Ouroboros.Consensus.Cardano.Block (Either (..), EraMismatch (..), Query (..))
+import           Ouroboros.Consensus.Cardano.Block as Consensus
+                   (Either (..), EraMismatch (..), Query (..))
 import qualified Ouroboros.Consensus.Cardano.Block as Consensus
-import           Ouroboros.Consensus.HardFork.Combinator.Degenerate (Either (DegenQueryResult),
-                     Query (DegenQuery))
+import           Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
 import           Ouroboros.Network.Block (Serialised (..), getTipPoint)
 
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Era as Ledger
-import qualified Cardano.Ledger.Shelley as Ledger
-import qualified Ouroboros.Consensus.Shelley.Ledger as Ledger
+import qualified Cardano.Ledger.Shelley.Constraints as Ledger
 
 import qualified Shelley.Spec.Ledger.Address as Ledger
 import qualified Shelley.Spec.Ledger.API.Protocol as Ledger
@@ -70,7 +69,7 @@ import           Shelley.Spec.Ledger.Scripts ()
 import qualified Shelley.Spec.Ledger.TxBody as Ledger (TxId (..), TxIn (..), TxOut (..))
 import qualified Shelley.Spec.Ledger.UTxO as Ledger (UTxO (..))
 
-import           Ouroboros.Consensus.Shelley.Ledger hiding (ShelleyBasedEra)
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 import           Ouroboros.Consensus.Shelley.Protocol (StandardCrypto)
 
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
@@ -320,7 +319,7 @@ writeProtocolState mOutFile pstate =
 
 writeFilteredUTxOs :: forall era ledgerera.
                       Ledger.Value ledgerera ~ Coin --TODO: support multi-asset
-                   => Ledger.ShelleyBasedEra ledgerera
+                   => Consensus.ShelleyBasedEra ledgerera
                    => CardanoEra era
                    -> Maybe OutputFile
                    -> Ledger.UTxO ledgerera
@@ -441,10 +440,13 @@ queryUTxOFromLocalState era qFilter
 
     ShelleyMode{} | ShelleyBasedEraShelley <- era -> do
       tip <- liftIO $ getLocalTip connectInfo
-      DegenQueryResult result <- firstExceptT AcquireFailureError . newExceptT $
-        queryNodeLocalState
-          connectInfo
-          (getTipPoint tip, DegenQuery (applyUTxOFilter qFilter))
+      Consensus.DegenQueryResult result <-
+        firstExceptT AcquireFailureError . newExceptT $
+          queryNodeLocalState
+            connectInfo
+            ( getTipPoint tip
+            , Consensus.DegenQuery (applyUTxOFilter qFilter)
+            )
       return result
 
     ShelleyMode{} | otherwise -> throwError ShelleyProtocolEraMismatch
@@ -460,10 +462,10 @@ queryUTxOFromLocalState era qFilter
         QueryResultSuccess utxo -> return utxo
   where
     applyUTxOFilter :: QueryFilter
-                    -> Query (ShelleyBlock ledgerera)
+                    -> Query (Consensus.ShelleyBlock ledgerera)
                              (Ledger.UTxO ledgerera)
-    applyUTxOFilter (FilterByAddress as) = GetFilteredUTxO (toShelleyAddrs as)
-    applyUTxOFilter NoFilter             = GetUTxO
+    applyUTxOFilter (FilterByAddress as) = Consensus.GetFilteredUTxO (toShelleyAddrs as)
+    applyUTxOFilter NoFilter             = Consensus.GetUTxO
 
     toShelleyAddrs :: Set AddressAny -> Set (Ledger.Addr ledgerera)
     toShelleyAddrs = Set.map (toShelleyAddr
@@ -522,10 +524,13 @@ queryPParamsFromLocalState era connectInfo@LocalNodeConnectInfo{
                                }
   | ShelleyBasedEraShelley <- era = do
     tip <- liftIO $ getLocalTip connectInfo
-    DegenQueryResult result <- firstExceptT AcquireFailureError . newExceptT $
-      queryNodeLocalState
-        connectInfo
-        (getTipPoint tip, DegenQuery GetCurrentPParams)
+    Consensus.DegenQueryResult result <-
+      firstExceptT AcquireFailureError . newExceptT $
+        queryNodeLocalState
+          connectInfo
+          ( getTipPoint tip
+          , Consensus.DegenQuery Consensus.GetCurrentPParams
+          )
     return result
 
   | otherwise = throwError ShelleyProtocolEraMismatch
@@ -537,7 +542,7 @@ queryPParamsFromLocalState era connectInfo@LocalNodeConnectInfo{
     result <- firstExceptT AcquireFailureError . newExceptT $
       queryNodeLocalState
         connectInfo
-        (getTipPoint tip, queryIfCurrentEra era GetCurrentPParams)
+        (getTipPoint tip, queryIfCurrentEra era Consensus.GetCurrentPParams)
     case result of
       QueryResultEraMismatch eraerr  -> throwError (EraMismatchError eraerr)
       QueryResultSuccess     pparams -> return pparams
@@ -565,10 +570,13 @@ queryStakeDistributionFromLocalState era connectInfo@LocalNodeConnectInfo{
                                          }
   | ShelleyBasedEraShelley <- era = do
     tip <- liftIO $ getLocalTip connectInfo
-    DegenQueryResult result <- firstExceptT AcquireFailureError . newExceptT $
-      queryNodeLocalState
-        connectInfo
-        (getTipPoint tip, DegenQuery GetStakeDistribution)
+    Consensus.DegenQueryResult result <-
+      firstExceptT AcquireFailureError . newExceptT $
+        queryNodeLocalState
+          connectInfo
+          ( getTipPoint tip
+          , Consensus.DegenQuery Consensus.GetStakeDistribution
+          )
     return result
 
   | otherwise = throwError ShelleyProtocolEraMismatch
@@ -580,15 +588,15 @@ queryStakeDistributionFromLocalState era connectInfo@LocalNodeConnectInfo{
   result <- firstExceptT AcquireFailureError . newExceptT $
     queryNodeLocalState
       connectInfo
-      (getTipPoint tip, queryIfCurrentEra era GetStakeDistribution)
+      (getTipPoint tip, queryIfCurrentEra era Consensus.GetStakeDistribution)
   case result of
     QueryResultEraMismatch err -> throwError (EraMismatchError err)
     QueryResultSuccess stakeDist -> return stakeDist
 
 queryLocalLedgerState
   :: forall era ledgerera mode block.
      ShelleyLedgerEra era ~ ledgerera
-  => Ledger.ShelleyBasedEra ledgerera
+  => Ledger.ShelleyBased ledgerera
   => ShelleyBasedEra era
   -> LocalNodeConnectInfo mode block
   -> ExceptT ShelleyQueryCmdLocalStateQueryError IO
@@ -599,12 +607,14 @@ queryLocalLedgerState era connectInfo@LocalNodeConnectInfo{localNodeConsensusMod
 
     ShelleyMode{} | ShelleyBasedEraShelley <- era -> do
       tip <- liftIO $ getLocalTip connectInfo
-      DegenQueryResult result <- firstExceptT AcquireFailureError . newExceptT $
+      Consensus.DegenQueryResult result <-
+        firstExceptT AcquireFailureError . newExceptT $
           queryNodeLocalState
             connectInfo
             ( getTipPoint tip
-            , DegenQuery $
-                GetCBOR DebugNewEpochState  -- Get CBOR-in-CBOR version
+            , Consensus.DegenQuery $
+                Consensus.GetCBOR Consensus.DebugNewEpochState
+                -- Get CBOR-in-CBOR version
             )
       return (decodeLedgerState result)
 
@@ -615,7 +625,9 @@ queryLocalLedgerState era connectInfo@LocalNodeConnectInfo{localNodeConsensusMod
       result <- firstExceptT AcquireFailureError . newExceptT $
         queryNodeLocalState
           connectInfo
-          (getTipPoint tip, queryIfCurrentEra era (GetCBOR DebugNewEpochState)) -- Get CBOR-in-CBOR version
+          (getTipPoint tip,
+           queryIfCurrentEra era (Consensus.GetCBOR Consensus.DebugNewEpochState))
+           -- Get CBOR-in-CBOR version
       case result of
         QueryResultEraMismatch err -> throwError (EraMismatchError err)
         QueryResultSuccess ls -> return (decodeLedgerState ls)
@@ -638,12 +650,14 @@ queryLocalProtocolState era connectInfo@LocalNodeConnectInfo{localNodeConsensusM
 
     ShelleyMode{} | ShelleyBasedEraShelley <- era -> do
       tip <- liftIO $ getLocalTip connectInfo
-      DegenQueryResult result <- firstExceptT AcquireFailureError . newExceptT $
+      Consensus.DegenQueryResult result <-
+        firstExceptT AcquireFailureError . newExceptT $
           queryNodeLocalState
             connectInfo
             ( getTipPoint tip
-            , DegenQuery $
-                GetCBOR DebugChainDepState  -- Get CBOR-in-CBOR version
+            , Consensus.DegenQuery $
+                Consensus.GetCBOR Consensus.DebugChainDepState
+                -- Get CBOR-in-CBOR version
             )
       return (decodeProtocolState result)
 
@@ -654,7 +668,9 @@ queryLocalProtocolState era connectInfo@LocalNodeConnectInfo{localNodeConsensusM
       result <- firstExceptT AcquireFailureError . newExceptT $
         queryNodeLocalState
           connectInfo
-          (getTipPoint tip, queryIfCurrentEra era (GetCBOR DebugChainDepState)) -- Get CBOR-in-CBOR version
+          (getTipPoint tip,
+           queryIfCurrentEra era (Consensus.GetCBOR Consensus.DebugChainDepState))
+                                  -- Get CBOR-in-CBOR version
       case result of
         QueryResultEraMismatch err -> throwError (EraMismatchError err)
         QueryResultSuccess ls -> return (decodeProtocolState ls)
@@ -689,13 +705,13 @@ queryDelegationsAndRewardsFromLocalState era stakeaddrs
 
     ShelleyMode{} | ShelleyBasedEraShelley <- era -> do
       tip <- liftIO $ getLocalTip connectInfo
-      DegenQueryResult result <-
+      Consensus.DegenQueryResult result <-
         firstExceptT AcquireFailureError . newExceptT $
           queryNodeLocalState
             connectInfo
             ( getTipPoint tip
-            , DegenQuery $
-                GetFilteredDelegationsAndRewardAccounts
+            , Consensus.DegenQuery $
+                Consensus.GetFilteredDelegationsAndRewardAccounts
                   (toShelleyStakeCredentials stakeaddrs)
             )
       return (uncurry toDelegsAndRwds result)
@@ -709,7 +725,7 @@ queryDelegationsAndRewardsFromLocalState era stakeaddrs
           connectInfo
           ( getTipPoint tip
           , queryIfCurrentEra era $
-              GetFilteredDelegationsAndRewardAccounts
+              Consensus.GetFilteredDelegationsAndRewardAccounts
                 (toShelleyStakeCredentials stakeaddrs)
           )
       case result of
@@ -744,17 +760,17 @@ queryDelegationsAndRewardsFromLocalState era stakeaddrs
 --
 --
 queryIfCurrentEra :: ShelleyBasedEra era
-                  -> Query (ShelleyBlock (ShelleyLedgerEra era)) result
+                  -> Query (Consensus.ShelleyBlock (ShelleyLedgerEra era)) result
                   -> Consensus.CardanoQuery StandardCrypto
                        (Consensus.CardanoQueryResult StandardCrypto result)
-queryIfCurrentEra ShelleyBasedEraShelley = QueryIfCurrentShelley
-queryIfCurrentEra ShelleyBasedEraAllegra = QueryIfCurrentAllegra
-queryIfCurrentEra ShelleyBasedEraMary    = QueryIfCurrentMary
+queryIfCurrentEra ShelleyBasedEraShelley = Consensus.QueryIfCurrentShelley
+queryIfCurrentEra ShelleyBasedEraAllegra = Consensus.QueryIfCurrentAllegra
+queryIfCurrentEra ShelleyBasedEraMary    = Consensus.QueryIfCurrentMary
 
 obtainLedgerEraClassConstraints
   :: ShelleyLedgerEra era ~ ledgerera
   => ShelleyBasedEra era
-  -> (Ledger.ShelleyBasedEra ledgerera => a) -> a
+  -> (Consensus.ShelleyBasedEra ledgerera => a) -> a
 obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f
 obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f
 obtainLedgerEraClassConstraints ShelleyBasedEraMary    f = f

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
@@ -18,7 +18,6 @@ import           Prelude (String)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality(..))
 
@@ -56,7 +55,7 @@ data ShelleyTxCmdError
   | ShelleyTxCmdWriteFileError !(FileError ())
   | ShelleyTxCmdMetaDataJsonParseError !FilePath !String
   | ShelleyTxCmdMetaDataConversionError !FilePath !TxMetadataJsonError
-  | ShelleyTxCmdMetaValidationError !FilePath !TxMetadataRangeError
+  | ShelleyTxCmdMetaValidationError !FilePath ![(Word64, TxMetadataRangeError)]
   | ShelleyTxCmdMetaDecodeError !FilePath !CBOR.DecoderError
   | ShelleyTxCmdBootstrapWitnessError !ShelleyBootstrapWitnessError
   | ShelleyTxCmdSocketEnvError !EnvSocketError
@@ -96,9 +95,11 @@ renderShelleyTxCmdError err =
     ShelleyTxCmdMetaDecodeError fp metaDataErr ->
        "Error decoding CBOR metadata at: " <> show fp
                              <> " Error: " <> show metaDataErr
-    ShelleyTxCmdMetaValidationError fp valErr ->
-      "Error validating transaction metadata at: " <> show fp
-                                           <> "\n" <> Text.pack (displayError valErr)
+    ShelleyTxCmdMetaValidationError fp errs ->
+      "Error validating transaction metadata at: " <> show fp <> "\n" <>
+      Text.intercalate "\n"
+        [ "key " <> show k <> ":" <> Text.pack (displayError valErr)
+        | (k, valErr) <- errs ]
     ShelleyTxCmdSocketEnvError envSockErr -> renderEnvSocketError envSockErr
     ShelleyTxCmdAesonDecodeProtocolParamsError fp decErr ->
       "Error while decoding the protocol parameters at: " <> show fp
@@ -131,7 +132,7 @@ renderShelleyTxCmdError err =
       " era transactions."
 
     ShelleyTxCmdTxBodyError (SomeTxBodyError err') ->
-      "TxBody error: " <> renderTxBodyError err'
+      "Transaction validaton error: " <> Text.pack (displayError err')
 
     ShelleyTxCmdNotImplemented msg ->
       "Feature not yet implemented: " <> msg
@@ -167,12 +168,6 @@ renderFeature TxFeatureMultiAssetOutputs    = "Multi-Asset outputs"
 renderFeature TxFeatureScriptWitnesses      = "Script witnesses"
 renderFeature TxFeatureShelleyKeys          = "Shelley keys"
 
-renderTxBodyError :: TxBodyError era -> Text
-renderTxBodyError TxBodyEmptyTxIns = "Transaction body has no inputs"
-renderTxBodyError TxBodyEmptyTxOuts = "Transaction body has no outputs"
-renderTxBodyError (TxBodyLovelaceOverflow txout) =
-  "Lovelace overflow error: " <> show txout
-
 runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO ()
 runTransactionCmd cmd =
   case cmd of
@@ -934,5 +929,6 @@ readFileTxMetaData _ (MetaDataFileCBOR fp) = do
           BS.readFile fp
     txMetadata <- firstExceptT (ShelleyTxCmdMetaDecodeError fp) $ hoistEither $
       Api.deserialiseFromCBOR Api.AsTxMetadata bs
-    firstExceptT (ShelleyTxCmdMetaValidationError fp . NE.head) $ hoistEither $
-      validateTxMetadata txMetadata
+    firstExceptT (ShelleyTxCmdMetaValidationError fp) $ hoistEither $ do
+        validateTxMetadata txMetadata
+        return txMetadata