Add url support to metadata hash cmd

cardano-cli/cardano-cli.cabal

@@ -335,6 +335,7 @@ test-suite cardano-cli-test
     Test.Cli.AddCostModels
     Test.Cli.CreateCardano
     Test.Cli.CreateTestnetData
+    Test.Cli.DRepMetadata
     Test.Cli.FilePermissions
     Test.Cli.Governance.DRep
     Test.Cli.Governance.Hash

cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs

@@ -11,10 +11,13 @@ module Cardano.CLI.EraBased.Commands.Governance.DRep
   , GovernanceDRepRetirementCertificateCmdArgs (..)
   , GovernanceDRepUpdateCertificateCmdArgs (..)
   , GovernanceDRepMetadataHashCmdArgs (..)
+  , DRepMetadataSource (..)
+  , DRepHashGoal (..)
   )
 where
 
 import           Cardano.Api
+import qualified Cardano.Api.Ledger as L
 
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Key
@@ -81,10 +84,24 @@ data GovernanceDRepUpdateCertificateCmdArgs era
 data GovernanceDRepMetadataHashCmdArgs era
   = GovernanceDRepMetadataHashCmdArgs
   { eon :: !(ConwayEraOnwards era)
-  , metadataFile :: !(DRepMetadataFile In)
-  , mOutFile :: !(Maybe (File () Out))
+  , drepMetadataSource :: !DRepMetadataSource
+  , hashGoal :: !DRepHashGoal
   }
 
+data DRepMetadataSource
+  = DrepMetadataFileIn !(DRepMetadataFile In)
+  | DrepMetadataURL !L.Url
+  deriving Show
+
+data DRepHashGoal
+  = -- | The hash is written to stdout
+    DRepHashToStdout
+  | -- | The hash to check against
+    CheckDRepHash !(Hash DRepMetadata)
+  | -- | The output file to which the hash is written
+    DRepHashToFile !(File () Out)
+  deriving Show
+
 renderGovernanceDRepCmds
   :: ()
   => GovernanceDRepCmds era

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs

@@ -10,7 +10,9 @@ module Cardano.CLI.EraBased.Options.Governance.DRep
 where
 
 import           Cardano.Api
+import           Cardano.Api.Ledger (extractHash)
 import qualified Cardano.Api.Ledger as L
+import           Cardano.Api.Shelley (Hash (DRepMetadataHash))
 
 import           Cardano.CLI.Environment
 import           Cardano.CLI.EraBased.Commands.Governance.DRep
@@ -19,6 +21,7 @@ import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Key
+import           Cardano.Ledger.SafeHash (castSafeHash)
 
 import           Control.Applicative
 import           Data.Foldable
@@ -129,6 +132,19 @@ pDrepMetadataUrl =
   AnchorUrl
     <$> pUrl "drep-metadata-url" "DRep anchor URL"
 
+pExpectedDrepMetadataHash :: Parser (Hash DRepMetadata)
+pExpectedDrepMetadataHash =
+  Opt.option (DRepMetadataHash . extractHash . castSafeHash <$> readSafeHash) $
+    mconcat
+      [ Opt.long "expected-hash"
+      , Opt.metavar "HASH"
+      , Opt.help $
+          mconcat
+            [ "Expected hash for the DRep metadata, for verification purposes. "
+            , "If provided, the hash of the DRep metadata is compared to this value."
+            ]
+      ]
+
 pDrepMetadataHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData)
 pDrepMetadataHash =
   Opt.option readSafeHash $
@@ -188,10 +204,26 @@ pGovernanceDrepMetadataHashCmd era = do
     $ Opt.info
       ( fmap GovernanceDRepMetadataHashCmd $
           GovernanceDRepMetadataHashCmdArgs w
-            <$> pFileInDirection "drep-metadata-file" "JSON Metadata file to hash."
-            <*> pMaybeOutputFile
+            <$> pDRepMetadataSource
+            <*> pDRepHashGoal
       )
-    $ Opt.progDesc "Calculate the hash of a metadata file."
+    $ Opt.progDesc
+      "Calculate the hash of a metadata file, optionally checking the obtained hash against an expected value."
+
+pDRepHashGoal :: Parser DRepHashGoal
+pDRepHashGoal =
+  asum
+    [ CheckDRepHash <$> pExpectedDrepMetadataHash
+    , DRepHashToFile <$> pOutputFile
+    ]
+    <|> pure DRepHashToStdout
+
+pDRepMetadataSource :: Parser DRepMetadataSource
+pDRepMetadataSource =
+  asum
+    [ DrepMetadataFileIn <$> pFileInDirection "drep-metadata-file" "JSON Metadata file to hash."
+    , DrepMetadataURL <$> pUrl "drep-metadata-url" "URL pointing to the JSON Metadata file to hash."
+    ]
 
 --------------------------------------------------------------------------------
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs

@@ -18,17 +18,19 @@ where
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
 
+import           Cardano.CLI.EraBased.Commands.Governance.DRep (DRepHashGoal (..))
 import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd
 import qualified Cardano.CLI.EraBased.Run.Key as Key
-import           Cardano.CLI.Run.Hash (getByteStringFromURL, httpsAndIpfsSchemas)
+import           Cardano.CLI.Run.Hash (allSchemas, getByteStringFromURL, httpsAndIpfsSchemas)
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
-import           Cardano.CLI.Types.Errors.HashCmdError (HashCheckError (..))
+import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError, HashCheckError (..))
 import           Cardano.CLI.Types.Errors.RegistrationError
 import           Cardano.CLI.Types.Key
 
 import           Control.Monad (void, when)
+import           Data.ByteString (ByteString)
 import           Data.Function
 import qualified Data.Text.Encoding as Text
 
@@ -178,16 +180,37 @@ runGovernanceDRepMetadataHashCmd
   -> ExceptT GovernanceCmdError IO ()
 runGovernanceDRepMetadataHashCmd
   Cmd.GovernanceDRepMetadataHashCmdArgs
-    { metadataFile
-    , mOutFile
+    { drepMetadataSource
+    , hashGoal
     } = do
-    metadataBytes <- firstExceptT ReadFileError . newExceptT $ readByteStringFile metadataFile
+    metadataBytes <- case drepMetadataSource of
+      Cmd.DrepMetadataFileIn metadataFile ->
+        firstExceptT ReadFileError . newExceptT $ readByteStringFile metadataFile
+      Cmd.DrepMetadataURL urlText ->
+        fetchURLToGovernanceCmdError $ getByteStringFromURL allSchemas urlText
     let (_metadata, metadataHash) = hashDRepMetadata metadataBytes
-    firstExceptT WriteFileError
-      . newExceptT
-      . writeByteStringOutput mOutFile
-      . serialiseToRawBytesHex
-      $ metadataHash
+    case hashGoal of
+      CheckDRepHash expectedHash
+        | metadataHash /= expectedHash ->
+            left $ GovernanceCmdHashMismatchError expectedHash metadataHash
+        | otherwise -> liftIO $ putStrLn "Hashes match!"
+      DRepHashToFile outFile -> writeOutput (Just outFile) metadataHash
+      DRepHashToStdout -> writeOutput Nothing metadataHash
+   where
+    writeOutput
+      :: MonadIO m
+      => Maybe (File content Out)
+      -> Hash DRepMetadata
+      -> ExceptT GovernanceCmdError m ()
+    writeOutput mOutFile =
+      firstExceptT WriteFileError
+        . newExceptT
+        . writeByteStringOutput mOutFile
+        . serialiseToRawBytesHex
+
+    fetchURLToGovernanceCmdError
+      :: ExceptT FetchURLError IO ByteString -> ExceptT GovernanceCmdError IO ByteString
+    fetchURLToGovernanceCmdError = withExceptT GovernanceCmdFetchURLError
 
 -- | Check the hash of the anchor data against the hash in the anchor if
 -- checkHash is set to CheckHash.

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

@@ -9,7 +9,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.Binary (DecoderError)
 import           Cardano.CLI.Read
-import           Cardano.CLI.Types.Errors.HashCmdError (HashCheckError)
+import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError, HashCheckError)
 import           Cardano.CLI.Types.Errors.StakeAddressCmdError
 
 import           Control.Exception (displayException)
@@ -56,6 +56,12 @@ data GovernanceCmdError
     GovernanceCmdMIRCertNotSupportedInConway
   | GovernanceCmdGenesisDelegationNotSupportedInConway
   | GovernanceDRepHashCheckError HashCheckError
+  | GovernanceCmdHashMismatchError
+      !(Hash DRepMetadata)
+      -- ^ Expected hash
+      !(Hash DRepMetadata)
+      -- ^ Actual hash
+  | GovernanceCmdFetchURLError !FetchURLError
   deriving Show
 
 instance Error GovernanceCmdError where
@@ -119,5 +125,13 @@ instance Error GovernanceCmdError where
       "Genesis delegation is not supported in Conway era onwards."
     GovernanceDRepHashCheckError hashCheckError ->
       "Error while checking DRep metadata hash: " <> pretty (displayException hashCheckError)
+    GovernanceCmdHashMismatchError (DRepMetadataHash expectedHash) (DRepMetadataHash actualHash) ->
+      "Hashes do not match!"
+        <> "\nExpected:"
+          <+> pretty (show expectedHash)
+        <> "\n  Actual:"
+          <+> pretty (show actualHash)
+    GovernanceCmdFetchURLError fetchErr ->
+      pretty (displayException fetchErr)
    where
     renderDecoderError = pretty . TL.toLazyText . B.build