Update to use getAnchorDataFromCertificate from cardano-api and prettyException

Author: palas

cabal.project

@@ -19,6 +19,13 @@ index-state:
 packages:
   cardano-cli
 
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api
+  tag: b00053d15adc71c835eba64e7c9cf68af296ea63
+  subdir: cardano-api
+  --sha256: sha256-pSJeH9qpc0Vs4FkfUdRvX50uWfATcZarBf85p2U/x1I=
+
 program-options
   ghc-options: -Werror
 

cardano-cli/cardano-cli.cabal

@@ -84,7 +84,6 @@ library
     Cardano.CLI.EraBased.Commands.StakePool
     Cardano.CLI.EraBased.Commands.TextView
     Cardano.CLI.EraBased.Commands.Transaction
-    Cardano.CLI.EraBased.HashChecking
     Cardano.CLI.EraBased.Options.Common
     Cardano.CLI.EraBased.Options.Genesis
     Cardano.CLI.EraBased.Options.Governance
@@ -114,6 +113,7 @@ library
     Cardano.CLI.EraBased.Run.StakePool
     Cardano.CLI.EraBased.Run.TextView
     Cardano.CLI.EraBased.Run.Transaction
+    Cardano.CLI.EraBased.Transaction.HashCheck
     Cardano.CLI.Helpers
     Cardano.CLI.IO.Compat
     Cardano.CLI.IO.Lazy
@@ -208,7 +208,6 @@ library
     cardano-crypto-wrapper ^>=1.5.1,
     cardano-data >=1.1,
     cardano-git-rev ^>=0.2.2,
-    cardano-ledger-api,
     cardano-ping ^>=0.5,
     cardano-prelude,
     cardano-slotting ^>=0.2.0.0,

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -43,10 +43,10 @@ import           Cardano.Api.Shelley
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd
-import           Cardano.CLI.EraBased.HashChecking (checkCertificateHashes, checkProposalHashes,
-                   checkVotingProcedureHashes)
 import           Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters)
 import           Cardano.CLI.EraBased.Run.Query
+import           Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes,
+                   checkProposalHashes, checkVotingProcedureHashes)
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError

…src/Cardano/CLI/EraBased/HashChecking.hs …no/CLI/EraBased/Transaction/HashCheck.hscardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs renamed to cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs cardano-cli/src/Cardano/CLI/EraBased/HashChecking.hs renamed to cardano-cli/src/Cardano/CLI/EraBased/Transaction/HashCheck.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Cardano.CLI.EraBased.HashChecking
+module Cardano.CLI.EraBased.Transaction.HashCheck
   ( checkCertificateHashes
   , checkVotingProcedureHashes
   , checkProposalHashes
@@ -14,10 +14,9 @@ import qualified Cardano.Api.Shelley as Shelley
 import           Cardano.CLI.Run.Hash (carryHashChecks)
 import           Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyCheckedAnchor (..))
 import           Cardano.CLI.Types.Errors.TxCmdError (TxCmdError (..))
-import qualified Cardano.Ledger.Api.Governance as L
 
 import           Control.Monad (forM_)
-import           Control.Monad.Trans.Except.Extra (left)
+import qualified Cardano.Api as L
 
 -- | Check the hash of the anchor data against the hash in the anchor
 checkAnchorMetadataHash :: L.Anchor L.StandardCrypto -> ExceptT TxCmdError IO ()
@@ -33,48 +32,9 @@ checkAnchorMetadataHash anchor =
 -- | Find references to anchor data and check the hashes are valid
 -- and they match the linked data.
 checkCertificateHashes :: Certificate era -> ExceptT TxCmdError IO ()
-checkCertificateHashes c =
-  case c of
-    ShelleyRelatedCertificate _ shelleyCert ->
-      case shelleyCert of
-        L.ShelleyTxCertDelegCert shelleyDelegCert ->
-          case shelleyDelegCert of
-            L.ShelleyRegCert _ -> return ()
-            L.ShelleyUnRegCert _ -> return ()
-            L.ShelleyDelegCert _ _ -> return ()
-        L.ShelleyTxCertPool shelleyPoolCert ->
-          case shelleyPoolCert of
-            L.RegPool poolParams -> forM_ (L.ppMetadata poolParams) checkPoolMetadataHash
-            L.RetirePool _ _ -> return ()
-        L.ShelleyTxCertGenesisDeleg _ -> return ()
-        L.ShelleyTxCertMir _ -> return ()
-    ConwayCertificate ceo conwayCert ->
-      Shelley.conwayEraOnwardsConstraints ceo $
-        case conwayCert of
-          L.ConwayTxCertDeleg _ -> return ()
-          L.ConwayTxCertPool conwayPoolCert ->
-            case conwayPoolCert of
-              L.RegPool poolParams -> forM_ (L.ppMetadata poolParams) checkPoolMetadataHash
-              L.RetirePool _ _ -> return ()
-          L.ConwayTxCertGov govCert ->
-            case govCert of
-              L.ConwayRegDRep _ _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash
-              L.ConwayUnRegDRep _ _ -> return ()
-              L.ConwayUpdateDRep _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash
-              L.ConwayAuthCommitteeHotKey _ _ -> return ()
-              L.ConwayResignCommitteeColdKey _ mAnchor -> forM_ mAnchor checkAnchorMetadataHash
- where
-  checkPoolMetadataHash :: L.PoolMetadata -> ExceptT TxCmdError IO ()
-  checkPoolMetadataHash (L.PoolMetadata{L.pmUrl = url, L.pmHash = hashBytes}) = do
-    let mHash = L.hashFromBytes hashBytes
-    hash <- maybe (left $ TxCmdPoolMetadataHashError url) return mHash
-    let safeHash = L.unsafeMakeSafeHash hash
-    checkAnchorMetadataHash
-      ( L.Anchor
-          { L.anchorUrl = url
-          , L.anchorDataHash = safeHash
-          }
-      )
+checkCertificateHashes cert = do
+  mAnchor <- L.withExceptT TxCmdPoolMetadataHashError $ L.getAnchorDataFromCertificate cert
+  maybe (return mempty) checkAnchorMetadataHash mAnchor
 
 -- | Find references to anchor data in voting procedures and check the hashes are valid
 -- and they match the linked data.

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

@@ -31,7 +31,6 @@ import           Cardano.CLI.Types.TxFeature
 import qualified Cardano.Prelude as List
 import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
 
-import           Control.Exception (displayException)
 import           Data.Text (Text)
 
 {- HLINT ignore "Use let" -}
@@ -87,7 +86,7 @@ data TxCmdError
   | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError
   | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era)
   | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era)
-  | TxCmdPoolMetadataHashError L.Url
+  | TxCmdPoolMetadataHashError AnchorDataFromCertificateException
   | TxCmdHashCheckError L.Url HashCheckError
 
 renderTxCmdError :: TxCmdError -> Doc ann
@@ -222,10 +221,10 @@ renderTxCmdError = \case
     prettyError e
   TxCmdFeeEstimationError e ->
     prettyError e
-  TxCmdPoolMetadataHashError url ->
-    "Hash of the pool metadata file is not valid. Url:" <+> pretty (L.urlToText url)
+  TxCmdPoolMetadataHashError e ->
+    "Hash of the pool metadata hash is not valid:" <+> prettyException e
   TxCmdHashCheckError url e ->
-    "Hash of the file is not valid. Url:" <+> pretty (L.urlToText url) <+> pretty (displayException e)
+    "Hash of the file is not valid. Url:" <+> pretty (L.urlToText url) <+> prettyException e
 
 prettyPolicyIdList :: [PolicyId] -> Doc ann
 prettyPolicyIdList =