diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index c920646133..1fc1590c30 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -220,6 +220,7 @@ library cryptonite, deepseq, directory, + errors, exceptions, filepath, formatting, diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs index 7faa12f9a2..6e57c1881c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs @@ -21,7 +21,7 @@ import Cardano.CLI.EraBased.Commands.Governance.Actions import qualified Cardano.CLI.EraBased.Commands.Governance.Actions as Cmd import Cardano.CLI.Json.Friendly import Cardano.CLI.Read -import Cardano.CLI.Run.Hash (getByteStringFromURL, httpsAndIpfsSchemas) +import Cardano.CLI.Run.Hash (getByteStringFromURL, httpsAndIpfsSchemes) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.GovernanceActionsError import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError) @@ -526,7 +526,7 @@ carryHashChecks checkHash anchor checkType = L.AnchorData <$> fetchURLErrorToGovernanceActionError checkType - (getByteStringFromURL httpsAndIpfsSchemas $ L.urlToText $ L.anchorUrl anchor) + (getByteStringFromURL httpsAndIpfsSchemes $ L.urlToText $ L.anchorUrl anchor) let hash = L.hashAnchorData anchorData when (hash /= L.anchorDataHash anchor) $ left $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs index 12f283d56f..2fc2bbd809 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs @@ -20,7 +20,7 @@ import qualified Cardano.Api.Ledger as L import qualified Cardano.CLI.Commands.Hash as Cmd import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd -import Cardano.CLI.Run.Hash (allSchemas, carryHashChecks, getByteStringFromURL) +import Cardano.CLI.Run.Hash (allSchemes, carryHashChecks, getByteStringFromURL) import qualified Cardano.CLI.Run.Key as Key import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CmdError @@ -187,7 +187,7 @@ runGovernanceDRepMetadataHashCmd Cmd.DrepMetadataFileIn metadataFile -> firstExceptT ReadFileError . newExceptT $ readByteStringFile metadataFile Cmd.DrepMetadataURL urlText -> - fetchURLToGovernanceCmdError $ getByteStringFromURL allSchemas $ L.urlToText urlText + fetchURLToGovernanceCmdError $ getByteStringFromURL allSchemes $ L.urlToText urlText let (_metadata, metadataHash) = hashDRepMetadata metadataBytes case hashGoal of Cmd.CheckHash expectedHash diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakePool.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakePool.hs index 15ea5d6e59..9c48392bc8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakePool.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakePool.hs @@ -20,7 +20,7 @@ import Cardano.Api.Shelley import qualified Cardano.CLI.Commands.Hash as Cmd import Cardano.CLI.EraBased.Commands.StakePool import qualified Cardano.CLI.EraBased.Commands.StakePool as Cmd -import Cardano.CLI.Run.Hash (allSchemas, getByteStringFromURL, httpsAndIpfsSchemas) +import Cardano.CLI.Run.Hash (allSchemes, getByteStringFromURL, httpsAndIpfsSchemes) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError (..)) import Cardano.CLI.Types.Errors.StakePoolCmdError @@ -235,7 +235,7 @@ runStakePoolMetadataHashCmd . newExceptT $ readByteStringFile poolMetadataFile StakePoolMetadataURL urlText -> - fetchURLToStakePoolCmdError $ getByteStringFromURL allSchemas $ L.urlToText urlText + fetchURLToStakePoolCmdError $ getByteStringFromURL allSchemes $ L.urlToText urlText (_metadata, metadataHash) <- firstExceptT StakePoolCmdMetadataValidationError @@ -275,7 +275,7 @@ carryHashChecks potentiallyCheckedAnchor = metadataBytes <- withExceptT StakePoolCmdFetchURLError - (getByteStringFromURL httpsAndIpfsSchemas urlText) + (getByteStringFromURL httpsAndIpfsSchemes urlText) let expectedHash = stakePoolMetadataHash anchor diff --git a/cardano-cli/src/Cardano/CLI/Run/Hash.hs b/cardano-cli/src/Cardano/CLI/Run/Hash.hs index 30596958f0..fcab588842 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Hash.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Hash.hs @@ -9,9 +9,8 @@ module Cardano.CLI.Run.Hash ( runHashCmds , getByteStringFromURL - , SupportedSchemas (..) - , allSchemas - , httpsAndIpfsSchemas + , allSchemes + , httpsAndIpfsSchemes , carryHashChecks ) where @@ -25,6 +24,7 @@ import Cardano.CLI.Types.Common (MustCheckHash (..), PotentiallyChecke import Cardano.CLI.Types.Errors.HashCmdError import Cardano.Crypto.Hash (hashToTextAsHex) +import Control.Error ((??)) import Control.Exception (throw) import Control.Monad (when) import Control.Monad.Catch (Exception, Handler (Handler)) @@ -71,7 +71,7 @@ runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{toHash, hashGoal} = do return $ Text.encodeUtf8 text Cmd.AnchorDataHashSourceText text -> return $ Text.encodeUtf8 text Cmd.AnchorDataHashSourceURL urlText -> - fetchURLToHashCmdError $ getByteStringFromURL allSchemas $ L.urlToText urlText + fetchURLToHashCmdError $ getByteStringFromURL allSchemes $ L.urlToText urlText let hash = L.hashAnchorData anchorData case hashGoal of Cmd.CheckHash expectedHash @@ -94,30 +94,56 @@ runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{toHash, hashGoal} = do :: ExceptT FetchURLError IO BS8.ByteString -> ExceptT HashCmdError IO BS8.ByteString fetchURLToHashCmdError = withExceptT HashFetchURLError -data SupportedSchemas = FileSchema | HttpSchema | HttpsSchema | IpfsSchema - deriving (Show, Eq) - -allSchemas :: [SupportedSchemas] -allSchemas = [FileSchema, HttpSchema, HttpsSchema, IpfsSchema] +-- | Specifies the schemes that are allowed to fetch anchor data. +type SupportedSchemes = [AnchorScheme] -httpsAndIpfsSchemas :: [SupportedSchemas] -httpsAndIpfsSchemas = [HttpsSchema, IpfsSchema] +-- | The different schemes that can be used to fetch anchor data. +data AnchorScheme = FileScheme | HttpScheme | HttpsScheme | IpfsScheme + deriving (Show, Eq) -getByteStringFromURL :: [SupportedSchemas] -> Text -> ExceptT FetchURLError IO BS.ByteString -getByteStringFromURL supportedSchemas urlText = do +-- | All the supported schemes are allowed. +allSchemes :: SupportedSchemes +allSchemes = [FileScheme, HttpScheme, HttpsScheme, IpfsScheme] + +-- | Only HTTPS and IPFS schemes are allowed. We also allow HTTP for testing purposes +-- but it is discouraged, because it can lead to security vulnerabilities. +-- For example: If a user checks the anchor-data through a web browser and through the +-- `cardano-cli` independently, one of them could easily get spoofed, and the user would +-- not notice that the anchor-data being verified in the browser is not the same. +httpsAndIpfsSchemes :: SupportedSchemes +httpsAndIpfsSchemes = + [ HttpScheme -- Insecure, only for testing purposes + , HttpsScheme + , IpfsScheme + ] + +-- | Converts a string to an 'AnchorScheme' if it is a valid scheme, otherwise returns 'Nothing'. +stringToScheme :: String -> Maybe AnchorScheme +stringToScheme "file:" = Just FileScheme +stringToScheme "http:" = Just HttpScheme +stringToScheme "https:" = Just HttpsScheme +stringToScheme "ipfs:" = Just IpfsScheme +stringToScheme _ = Nothing + +-- | Fetches the content of a URL as a 'ByteString'. +-- The URL must be an absolute URL. The supported schemes are specified in the 'SupportedSchemes' argument. +-- If the scheme is not supported, an error is thrown. +getByteStringFromURL :: SupportedSchemes -> Text -> ExceptT FetchURLError IO BS.ByteString +getByteStringFromURL supportedSchemes urlText = do let urlString = Text.unpack urlText - uri <- hoistMaybe (FetchURLInvalidURLError urlString) $ parseAbsoluteURI urlString - case map toLower $ uriScheme uri of - "file:" - | FileSchema `elem` supportedSchemas -> - let path = uriPathToFilePath (pathSegments uri) - in handleIOExceptT (FetchURLReadFileError path) $ BS.readFile path - "http:" | HttpSchema `elem` supportedSchemas -> getFileFromHttp uri - "https:" | HttpsSchema `elem` supportedSchemas -> getFileFromHttp uri - "ipfs:" | IpfsSchema `elem` supportedSchemas -> do + uri@URI{uriScheme} <- hoistMaybe (FetchURLInvalidURLError urlString) $ parseAbsoluteURI urlString + scheme <- + filterMaybe (`elem` supportedSchemes) (stringToScheme $ map toLower uriScheme) + ?? FetchURLUnsupportedURLSchemeError uriScheme + case scheme of + FileScheme -> + let path = uriPathToFilePath (pathSegments uri) + in handleIOExceptT (FetchURLReadFileError path) $ BS.readFile path + HttpScheme -> getFileFromHttp uri + HttpsScheme -> getFileFromHttp uri + IpfsScheme -> do httpUri <- convertToHttp uri getFileFromHttp httpUri - unsupportedScheme -> left $ FetchURLUnsupportedURLSchemeError unsupportedScheme where uriPathToFilePath :: [String] -> FilePath uriPathToFilePath allPath@(letter : path) = @@ -140,6 +166,12 @@ getByteStringFromURL supportedSchemas urlText = do (BS8.unpack (statusMessage status) ++ ": " ++ BSL8.unpack (responseBody response)) else return $ BS.concat . BSL.toChunks $ responseBody response + filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a + filterMaybe _ Nothing = Nothing + filterMaybe f input@(Just x) + | f x = input + | otherwise = Nothing + handlers :: [Handler IO FetchURLError] handlers = [ mkHandler id @@ -196,7 +228,7 @@ carryHashChecks potentiallyCheckedAnchor = L.AnchorData <$> withExceptT FetchURLError - (getByteStringFromURL httpsAndIpfsSchemas $ L.urlToText $ L.anchorUrl anchor) + (getByteStringFromURL httpsAndIpfsSchemes $ L.urlToText $ L.anchorUrl anchor) let hash = L.hashAnchorData anchorData when (hash /= L.anchorDataHash anchor) $ left $ diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs index 7441cc4fd1..e896961c97 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs @@ -63,7 +63,7 @@ instance Exception FetchURLError where displayException (FetchURLUnsupportedURLSchemeError text) = "Unsupported URL scheme: " <> text displayException (FetchURLReadEnvVarError exc) = "Cannot read environment variable: " <> displayException exc displayException (FetchURLGetFileFromHttpError err) = displayException err - displayException FetchURLIpfsGatewayNotSetError = "IPFS schema requires IPFS_GATEWAY_URI environment variable to be set." + displayException FetchURLIpfsGatewayNotSetError = "IPFS scheme requires IPFS_GATEWAY_URI environment variable to be set." data HttpRequestError = BadStatusCodeHRE !Int !String