diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000000..e6ade18bba --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +cardano-cli/test/cardano-cli-test/files/input/example_anchor_data.txt -text diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 9b187f99ce..322d2bcd7d 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -235,13 +235,18 @@ library cryptonite, deepseq, directory, + exceptions, filepath, formatting, + http-client, + http-client-tls, + http-types, io-classes, iproute, microlens, mtl, network, + network-uri, optparse-applicative-fork, ouroboros-consensus ^>=0.20, ouroboros-consensus-cardano ^>=0.19, @@ -321,10 +326,15 @@ test-suite cardano-cli-test cardano-ledger-alonzo, cardano-slotting, containers, + directory, exceptions, filepath, hedgehog, hedgehog-extras ^>=0.6.1.0, + http-types, + lifted-base, + monad-control, + network, parsec, regex-tdfa, tasty, @@ -332,6 +342,9 @@ test-suite cardano-cli-test text, time, transformers, + utf8-string, + wai, + warp, build-tool-depends: tasty-discover:tasty-discover other-modules: @@ -340,6 +353,7 @@ test-suite cardano-cli-test Test.Cli.FilePermissions Test.Cli.Governance.DRep Test.Cli.Governance.Hash + Test.Cli.Hash Test.Cli.ITN Test.Cli.Json Test.Cli.MonadWarning diff --git a/cardano-cli/src/Cardano/CLI/Commands/Hash.hs b/cardano-cli/src/Cardano/CLI/Commands/Hash.hs index f0509c74ea..0672f8ee50 100644 --- a/cardano-cli/src/Cardano/CLI/Commands/Hash.hs +++ b/cardano-cli/src/Cardano/CLI/Commands/Hash.hs @@ -4,6 +4,7 @@ module Cardano.CLI.Commands.Hash ( HashCmds (..) + , HashGoal (..) , HashAnchorDataCmdArgs (..) , HashScriptCmdArgs (..) , AnchorDataHashSource (..) @@ -12,6 +13,7 @@ module Cardano.CLI.Commands.Hash where import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.CLI.Types.Common @@ -21,11 +23,19 @@ data HashCmds = HashAnchorDataCmd !HashAnchorDataCmdArgs | HashScriptCmd !HashScriptCmdArgs +data HashGoal + = -- | The hash is written to stdout + HashToStdout + | -- | The hash to check against + CheckHash !(L.SafeHash L.StandardCrypto L.AnchorData) + | -- | The output file to which the hash is written + HashToFile !(File () Out) + deriving Show + data HashAnchorDataCmdArgs = HashAnchorDataCmdArgs { toHash :: !AnchorDataHashSource - , mOutFile :: !(Maybe (File () Out)) - -- ^ The output file to which the hash is written + , hashGoal :: !HashGoal } deriving Show @@ -33,6 +43,7 @@ data AnchorDataHashSource = AnchorDataHashSourceBinaryFile (File ProposalBinary In) | AnchorDataHashSourceTextFile (File ProposalText In) | AnchorDataHashSourceText Text + | AnchorDataHashSourceURL L.Url deriving Show data HashScriptCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 0d4e8679c3..b6c09081b5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -3618,6 +3618,19 @@ pAnchorUrl = ProposalUrl <$> pUrl "anchor-url" "Anchor URL" +pExpectedHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData) +pExpectedHash = + Opt.option readSafeHash $ + mconcat + [ Opt.long "expected-hash" + , Opt.metavar "HASH" + , Opt.help $ + mconcat + [ "Expected hash for the anchor data for verification purposes. " + , "If provided, the hash of the anchor data will be compared to this value." + ] + ] + pAnchorDataHash :: Parser (L.SafeHash L.StandardCrypto L.AnchorData) pAnchorDataHash = Opt.option readSafeHash $ diff --git a/cardano-cli/src/Cardano/CLI/Options/Hash.hs b/cardano-cli/src/Cardano/CLI/Options/Hash.hs index 80ef0602d6..7af0003f49 100644 --- a/cardano-cli/src/Cardano/CLI/Options/Hash.hs +++ b/cardano-cli/src/Cardano/CLI/Options/Hash.hs @@ -32,11 +32,19 @@ pHashAnchorDataCmd = do Cmd.HashAnchorDataCmd ( Cmd.HashAnchorDataCmdArgs <$> pAnchorDataHashSource - <*> optional pOutputFile + <*> pHashGoal ) ) $ Opt.progDesc "Compute the hash of some anchor data (to then pass it to other commands)." +pHashGoal :: Parser Cmd.HashGoal +pHashGoal = + asum + [ Cmd.CheckHash <$> pExpectedHash + , Cmd.HashToFile <$> pOutputFile + ] + <|> pure Cmd.HashToStdout + pAnchorDataHashSource :: Parser Cmd.AnchorDataHashSource pAnchorDataHashSource = asum @@ -52,6 +60,8 @@ pAnchorDataHashSource = <$> pFileInDirection "file-binary" "Binary file to hash" , Cmd.AnchorDataHashSourceTextFile <$> pFileInDirection "file-text" "Text file to hash" + , Cmd.AnchorDataHashSourceURL + <$> pUrl "url" "A URL to the file to hash (HTTP(S) and IPFS only)" ] pHashScriptCmd :: Parser Cmd.HashCmds diff --git a/cardano-cli/src/Cardano/CLI/Run/Hash.hs b/cardano-cli/src/Cardano/CLI/Run/Hash.hs index 301df84fe2..a8b2ee6744 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Hash.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Hash.hs @@ -14,15 +14,30 @@ where import Cardano.Api import qualified Cardano.Api.Ledger as L +import Cardano.CLI.Commands.Hash (HashGoal (..)) import qualified Cardano.CLI.Commands.Hash as Cmd import Cardano.CLI.Read import Cardano.CLI.Types.Errors.HashCmdError import Cardano.Crypto.Hash (hashToTextAsHex) +import Control.Exception (throw) +import Control.Monad.Catch (Exception, Handler (Handler)) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as BSL +import Data.Char (toLower) import Data.Function +import Data.List (intercalate) +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.IO as Text +import Network.HTTP.Client (Response (..), httpLbs, newManager, requestFromURI) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types (Status (statusCode), statusMessage) +import Network.URI (URI (..), URIAuth (..), parseAbsoluteURI, pathSegments) +import qualified System.Environment as IO +import System.FilePath (()) +import System.FilePath.Posix (isDrive) runHashCmds :: () @@ -36,30 +51,98 @@ runHashAnchorDataCmd :: () => Cmd.HashAnchorDataCmdArgs -> ExceptT HashCmdError IO () -runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{toHash, mOutFile} = - case toHash of - Cmd.AnchorDataHashSourceBinaryFile fp -> do - let path = unFile fp - bytes <- handleIOExceptT (HashReadFileError path) $ BS.readFile path - let hash = L.hashAnchorData $ L.AnchorData bytes - writeHash hash - Cmd.AnchorDataHashSourceTextFile fp -> do - let path = unFile fp - text <- handleIOExceptT (HashReadFileError path) $ Text.readFile path - let hash = L.hashAnchorData $ L.AnchorData $ Text.encodeUtf8 text - writeHash hash - Cmd.AnchorDataHashSourceText text -> do - let hash = L.hashAnchorData $ L.AnchorData $ Text.encodeUtf8 text - writeHash hash +runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{toHash, hashGoal} = do + anchorData <- + L.AnchorData <$> case toHash of + Cmd.AnchorDataHashSourceBinaryFile fp -> do + let path = unFile fp + handleIOExceptT (HashReadFileError path) $ BS.readFile path + Cmd.AnchorDataHashSourceTextFile fp -> do + let path = unFile fp + text <- handleIOExceptT (HashReadFileError path) $ Text.readFile path + return $ Text.encodeUtf8 text + Cmd.AnchorDataHashSourceText text -> return $ Text.encodeUtf8 text + Cmd.AnchorDataHashSourceURL urlText -> + getByteStringFromURL urlText + let hash = L.hashAnchorData anchorData + case hashGoal of + CheckHash expectedHash + | hash /= expectedHash -> + left $ HashMismatchedHashError expectedHash hash + | otherwise -> do + liftIO $ putStrLn "Hashes match!" + HashToFile outFile -> writeHash (Just outFile) hash + HashToStdout -> writeHash Nothing hash where - writeHash :: L.SafeHash L.StandardCrypto i -> ExceptT HashCmdError IO () - writeHash hash = do + writeHash :: Maybe (File () Out) -> L.SafeHash L.StandardCrypto i -> ExceptT HashCmdError IO () + writeHash mOutFile hash = do firstExceptT HashWriteFileError $ newExceptT $ writeTextOutput mOutFile text where text = hashToTextAsHex . L.extractHash $ hash + getByteStringFromURL :: L.Url -> ExceptT HashCmdError IO BS.ByteString + getByteStringFromURL urlText = do + let urlString = Text.unpack $ L.urlToText urlText + uri <- hoistMaybe (HashInvalidURLError urlString) $ parseAbsoluteURI urlString + case map toLower $ uriScheme uri of + "file:" -> + let path = uriPathToFilePath (pathSegments uri) + in handleIOExceptT (HashReadFileError path) $ BS.readFile path + "http:" -> getFileFromHttp uri + "https:" -> getFileFromHttp uri + "ipfs:" -> do + httpUri <- convertToHttp uri + getFileFromHttp httpUri + unsupportedScheme -> left $ HashUnsupportedURLSchemeError unsupportedScheme + where + uriPathToFilePath :: [String] -> FilePath + uriPathToFilePath allPath@(letter : path) = + if isDrive letter + then foldl () letter path + else foldl () "/" allPath + uriPathToFilePath [] = "/" + + getFileFromHttp :: URI -> ExceptT HashCmdError IO BS.ByteString + getFileFromHttp uri = handlesExceptT handlers $ liftIO $ do + request <- requestFromURI uri + manager <- newManager tlsManagerSettings + response <- httpLbs request manager + let status = responseStatus response + if statusCode status /= 200 + then throw $ BadStatusCodeHRE (statusCode status) (BS8.unpack $ statusMessage status) + else return $ BS.concat . BSL.toChunks $ responseBody response + + handlers :: [Handler IO HashCmdError] + handlers = + [ mkHandler id + , mkHandler HttpExceptionHRE + , mkHandler IOExceptionHRE + ] + where + mkHandler :: (Monad m, Exception e) => (e -> HttpRequestError) -> Handler m HashCmdError + mkHandler x = Handler $ return . HashGetFileFromHttpError . x + +convertToHttp :: URI -> ExceptT HashCmdError IO URI +convertToHttp ipfsUri = do + mIpfsGatewayUriString <- handleIOExceptT HashReadEnvVarError $ IO.lookupEnv "IPFS_GATEWAY_URI" + ipfsGatewayUriString <- hoistMaybe HashIpfsGatewayNotSetError mIpfsGatewayUriString + ipfsGatewayUri <- + hoistMaybe (HashInvalidURLError ipfsGatewayUriString) $ parseAbsoluteURI ipfsGatewayUriString + return $ + ipfsGatewayUri + { uriPath = + '/' + : intercalate + "/" + ( pathSegments ipfsGatewayUri + ++ ["ipfs"] + ++ maybe [] (\ipfsAuthority -> [uriRegName ipfsAuthority]) (uriAuthority ipfsUri) + ++ pathSegments ipfsUri + ) + } + runHashScriptCmd :: () => Cmd.HashScriptCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs index b2cad2576d..5c8420b093 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/HashCmdError.hs @@ -1,26 +1,65 @@ +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.Types.Errors.HashCmdError ( HashCmdError (..) + , HttpRequestError (..) ) where import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.CLI.Read (ScriptDecodeError) +import Cardano.Ledger.SafeHash (extractHash) import Cardano.Prelude (Exception (displayException), IOException) +import Network.HTTP.Client (HttpException) + data HashCmdError - = HashReadFileError !FilePath !IOException + = HashMismatchedHashError + !(L.SafeHash L.StandardCrypto L.AnchorData) + -- ^ Expected hash + !(L.SafeHash L.StandardCrypto L.AnchorData) + -- ^ Actual hash + | HashReadFileError !FilePath !IOException | HashWriteFileError !(FileError ()) | HashReadScriptError !FilePath !(FileError ScriptDecodeError) + | HashInvalidURLError !String + | HashReadEnvVarError !IOException + | HashIpfsGatewayNotSetError + | HashUnsupportedURLSchemeError !String + | HashGetFileFromHttpError !HttpRequestError deriving Show instance Error HashCmdError where prettyError = \case + HashMismatchedHashError expectedHash actualHash -> + "Hashes do not match! \n" + <> "Expected: " + <> pretty (show (extractHash expectedHash)) + <> "\n Actual: " + <> pretty (show (extractHash actualHash)) HashReadFileError filepath exc -> "Cannot read " <> pretty filepath <> ": " <> pretty (displayException exc) HashWriteFileError fileErr -> prettyError fileErr HashReadScriptError filepath err -> "Cannot read script at " <> pretty filepath <> ": " <> prettyError err + HashInvalidURLError text -> "Cannot parse URI: " <> pretty text + HashUnsupportedURLSchemeError text -> "Unsupported URL scheme: " <> pretty text + HashReadEnvVarError exc -> "Cannot read environment variable: " <> pretty (displayException exc) + HashIpfsGatewayNotSetError -> "IPFS schema requires IPFS_GATEWAY_URI environment variable to be set." + HashGetFileFromHttpError err -> pretty $ displayException err + +data HttpRequestError + = BadStatusCodeHRE !Int !String + | HttpExceptionHRE !HttpException + | IOExceptionHRE !IOException + deriving Show + +instance Exception HttpRequestError where + displayException :: HttpRequestError -> String + displayException (BadStatusCodeHRE code description) = "Bad status code when downloading anchor data: " <> show code <> " (" <> description <> ")" + displayException (HttpExceptionHRE exc) = "HTTP(S) request error when downloading anchor data: " <> displayException exc + displayException (IOExceptionHRE exc) = "I/O error when downloading anchor data: " <> displayException exc diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index a42022da6e..e3a2f0eb8b 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -12536,8 +12536,11 @@ Usage: cardano-cli hash anchor-data ( --text TEXT | --file-binary FILEPATH | --file-text FILEPATH + | --url TEXT ) - [--out-file FILEPATH] + [ --expected-hash HASH + | --out-file FILEPATH + ] Compute the hash of some anchor data (to then pass it to other commands). diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli index 184ba93ce6..4fb88d13b3 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/hash_anchor-data.cli @@ -2,8 +2,11 @@ Usage: cardano-cli hash anchor-data ( --text TEXT | --file-binary FILEPATH | --file-text FILEPATH + | --url TEXT ) - [--out-file FILEPATH] + [ --expected-hash HASH + | --out-file FILEPATH + ] Compute the hash of some anchor data (to then pass it to other commands). @@ -11,5 +14,9 @@ Available options: --text TEXT Text to hash as UTF-8 --file-binary FILEPATH Binary file to hash --file-text FILEPATH Text file to hash + --url TEXT A URL to the file to hash (HTTP(S) and IPFS only) + --expected-hash HASH Expected hash for the anchor data for verification + purposes. If provided, the hash of the anchor data + will be compared to this value. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs index d73125d966..60d7b0238c 100644 --- a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs +++ b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs @@ -11,6 +11,7 @@ module Test.Cardano.CLI.Util , equivalence , execCardanoCLI , execDetailCardanoCLI + , execDetailConfigCardanoCLI , tryExecCardanoCLI , propertyOnce , withSnd @@ -82,7 +83,20 @@ execDetailCardanoCLI -- ^ Arguments to the CLI command -> m (IO.ExitCode, String, String) -- ^ Captured stdout -execDetailCardanoCLI = GHC.withFrozenCallStack $ execDetailFlex H.defaultExecConfig "cardano-cli" "CARDANO_CLI" +execDetailCardanoCLI params = GHC.withFrozenCallStack $ execDetailConfigCardanoCLI H.defaultExecConfig params + +-- | Execute cardano-cli via the command line, expecting it to fail, and accepting custom config. +-- +-- Waits for the process to finish and returns the exit code, stdout and stderr. +execDetailConfigCardanoCLI + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + => ExecConfig + -- ^ Configuration for the execution + -> [String] + -- ^ Arguments to the CLI command + -> m (IO.ExitCode, String, String) + -- ^ Captured stdout +execDetailConfigCardanoCLI cfg = GHC.withFrozenCallStack $ execDetailFlex cfg "cardano-cli" "CARDANO_CLI" procFlex' :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs new file mode 100644 index 0000000000..f9580f9c3f --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Test.Cli.Hash where + +import Cardano.Api (MonadIO) + +import Control.Concurrent (forkOS) +import Control.Exception.Lifted (bracket) +import Control.Monad (void) +import Control.Monad.Trans.Control (MonadBaseControl) +import qualified Data.ByteString.UTF8 as BSU8 +import Data.List (intercalate) +import Data.Monoid (Last (..)) +import Data.String (IsString (fromString)) +import Data.Text (unpack) +import qualified Data.Text as T +import GHC.IO.Exception (ExitCode (..)) +import Network.HTTP.Types.Status (status200, status404) +import Network.HTTP.Types.URI (renderQuery) +import Network.Socket (close) +import Network.Wai (Request (..), Response, ResponseReceived, pathInfo, responseFile, + responseLBS) +import Network.Wai.Handler.Warp (defaultSettings, openFreePort, runSettingsSocket) +import System.Directory (getCurrentDirectory) +import System.Environment (getEnvironment) +import System.FilePath (dropTrailingPathSeparator) +import System.FilePath.Posix (splitDirectories) + +import Test.Cardano.CLI.Util + +import Hedgehog as H +import qualified Hedgehog.Extras as H +import Hedgehog.Internal.Source (HasCallStack) + +exampleAnchorDataHash :: String +exampleAnchorDataHash = "de38a4f5b8b9d8372386cc923bad19d1a0662298cf355bbe947e5eedf127fa9c" + +exampleAnchorDataPath :: String +exampleAnchorDataPath = "test/cardano-cli-test/files/input/example_anchor_data.txt" + +exampleAchorDataIpfsHash :: String +exampleAchorDataIpfsHash = "QmbL5EBFJLf8DdPkWAskG3Euin9tHY8naqQ2JDoHnWHHXJ" + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/generate anchor data hash from file/"'@ +hprop_generate_anchor_data_hash_from_file :: Property +hprop_generate_anchor_data_hash_from_file = + propertyOnce $ do + result <- + execCardanoCLI + [ "hash" + , "anchor-data" + , "--file-binary" + , exampleAnchorDataPath + ] + result === exampleAnchorDataHash + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from file/"'@ +hprop_check_anchor_data_hash_from_file :: Property +hprop_check_anchor_data_hash_from_file = + propertyOnce $ do + void $ + execCardanoCLI + [ "hash" + , "anchor-data" + , "--file-binary" + , exampleAnchorDataPath + , "--expected-hash" + , exampleAnchorDataHash + ] + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from file fails/"'@ +hprop_check_anchor_data_hash_from_file_fails :: Property +hprop_check_anchor_data_hash_from_file_fails = + propertyOnce $ do + (ec, _, _) <- + execDetailCardanoCLI + [ "hash" + , "anchor-data" + , "--file-binary" + , exampleAnchorDataPath + , "--expected-hash" + , 'c' : drop 1 exampleAnchorDataHash + ] + ec === ExitFailure 1 + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/generate anchor data hash from file uri/"'@ +hprop_generate_anchor_data_hash_from_file_uri :: Property +hprop_generate_anchor_data_hash_from_file_uri = + propertyOnce $ do + cwd <- H.evalIO getCurrentDirectory + posixCwd <- toPOSIX cwd + result <- + execCardanoCLI + [ "hash" + , "anchor-data" + , "--url" + , "file://" ++ posixCwd ++ "/" ++ exampleAnchorDataPath + ] + result === exampleAnchorDataHash + where + toPOSIX :: FilePath -> PropertyT IO [Char] + toPOSIX path = + case map dropTrailingPathSeparator (splitDirectories path) of + letter : restOfPath -> do + fixedLetter <- case letter of + '/' : _ -> return "" + l : ':' : _ -> return $ l : ":/" + wrongLetter -> do + H.note_ ("Unexpected letter: " ++ wrongLetter) + H.failure + return $ fixedLetter ++ intercalate "/" (fixedLetter : restOfPath) + [] -> do + H.note_ ("Path doesn't split:" ++ path) + H.failure + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from http uri/"'@ +hprop_check_anchor_data_hash_from_http_uri :: Property +hprop_check_anchor_data_hash_from_http_uri = + propertyOnce $ do + let relativeUrl = ["example", "url", "file.txt"] + serveFileWhile + relativeUrl + exampleAnchorDataPath + ( \port -> do + void $ + execCardanoCLI + [ "hash" + , "anchor-data" + , "--url" + , "http://localhost:" ++ show port ++ "/" ++ intercalate "/" relativeUrl + , "--expected-hash" + , exampleAnchorDataHash + ] + ) + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from ipfs uri/"'@ +hprop_check_anchor_data_hash_from_ipfs_uri :: Property +hprop_check_anchor_data_hash_from_ipfs_uri = + propertyOnce $ do + let relativeUrl = ["ipfs", exampleAchorDataIpfsHash] + serveFileWhile + relativeUrl + exampleAnchorDataPath + ( \port -> do + env <- H.evalIO getEnvironment + result <- + execDetailConfigCardanoCLI + H.defaultExecConfig + { H.execConfigEnv = + Last $ + Just + ( ( "IPFS_GATEWAY_URI" + , "http://localhost:" ++ show port ++ "/" + ) + : env + ) + } + [ "hash" + , "anchor-data" + , "--url" + , "ipfs://" ++ exampleAchorDataIpfsHash + , "--expected-hash" + , exampleAnchorDataHash + ] + case result of + (ExitFailure _, _, stderr) -> do + H.note_ stderr + failure + (ExitSuccess, _, _) -> success + ) + +-- | Takes a relative url (as a list of segments), a file path, and an action, and it serves +-- the file in the url provided in a random free port that is passed as a parameter to the +-- action. After the action returns, it shuts down the server. It returns the result of the +-- action. It also ensures the server is shut down even if the action throws an exception. +serveFileWhile + :: (MonadBaseControl IO m, MonadTest m, MonadIO m, HasCallStack) + => [String] + -- ^ Relative URL where the file will be served. + -- Each element is a segment of the URL. + -> FilePath + -- ^ File path for the file to serve + -> (Int -> m a) + -- ^ Action to run while the file is being served. + -- It receives the port the server is listening on + -> m a +serveFileWhile relativeUrl filePath action = + bracket + -- Server setup (resource acquisition) + ( do + -- Get the port the server is listening on + (port, socket) <- H.evalIO openFreePort + -- Serve the file + let app :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived + app req respond = do + let path = T.unpack <$> pathInfo req + if path == relativeUrl + then respond $ responseFile status200 [("Content-Type", "text/plain")] filePath Nothing + else + respond $ + responseLBS status404 [("Content-Type", "text/plain")] $ + fromString ("404 - Url \"" ++ urlFromRequest req ++ "\" - Not Found") + + -- Run server asynchronously in a separate thread + void $ H.evalIO $ forkOS $ runSettingsSocket defaultSettings socket app + return (port, socket) + ) + -- Server teardown (resource release) + (\(_, socket) -> H.evalIO $ close socket) + -- Test action + (\(port, _) -> action port) + where + urlFromRequest :: Request -> String + urlFromRequest req = + "http://" + ++ maybe "localhost" BSU8.toString (requestHeaderHost req) + ++ "/" + ++ intercalate "/" (unpack <$> pathInfo req) + ++ BSU8.toString (renderQuery True (queryString req)) diff --git a/cardano-cli/test/cardano-cli-test/files/input/example_anchor_data.txt b/cardano-cli/test/cardano-cli-test/files/input/example_anchor_data.txt new file mode 100644 index 0000000000..5d83630efd --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/files/input/example_anchor_data.txt @@ -0,0 +1,2 @@ +This is just a random file with content that is used for +testing the hashing of anchor data files. \ No newline at end of file diff --git a/flake.lock b/flake.lock index e6a76a06bb..3bf375dbd3 100644 --- a/flake.lock +++ b/flake.lock @@ -173,11 +173,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1722472127, - "narHash": "sha256-nYv7VbYAgo45CtXBX5Kkskyqi6Oh4coLgVmuYa/Hmqw=", + "lastModified": 1726446873, + "narHash": "sha256-dWdiphXwkk4qQVFkQHuUysphOb0XO8EHJlk/8Km/7q0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "adb966c62bed389945cb5d964d9bf5a02bf64a2e", + "rev": "3126b966be7409ebfd61c88f85dbfb6ec2a51338", "type": "github" }, "original": { @@ -226,11 +226,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1722473442, - "narHash": "sha256-Yc0ntATTg9mqTj5MVONFvyntEWXSStZYlBSEyAFMS9I=", + "lastModified": 1726447863, + "narHash": "sha256-bI1GMzozXWQ/Ckukr8bXnH3QzWZ+vZC0o5RkblCXIyI=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "d501b2b44438a7cd329396240fc21fa4b42c6d42", + "rev": "d259dac293df908b6749653122cca88b5e459c30", "type": "github" }, "original": { @@ -815,11 +815,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1722384610, - "narHash": "sha256-cIJRuPF7y/wf9C6jMMXcC77RbjLJMlrjCZyyV9ln7kY=", + "lastModified": 1726445918, + "narHash": "sha256-M34goAxhRqzDaVXqUo8lLnjZpppJYpr26c+X1Lhj5hU=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "21c6eb2e51ba4ae8d3cdb8d2bfd7f2aa8ca2724d", + "rev": "8299f8d17eef21ec8365536ee9705ff66a3504f3", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index aad8fbc0b0..b61c56b660 100644 --- a/flake.nix +++ b/flake.nix @@ -67,7 +67,13 @@ inherit (inputs.haskellNix) config; }; inherit (nixpkgs) lib; - + macOS-security = + # make `/usr/bin/security` available in `PATH`, which is needed for stack + # on darwin which calls this binary to find certificates + # Without this, we get the following error when compiling darwin in Hydra: + # I/O error when downloading anchor data: security: createProcess: posix_spawnp: does not exist (No such file or directory) + nixpkgs.writeScriptBin "security" ''exec /usr/bin/security "$@"''; + isDarwin = (system == "x86_64-darwin") || (system == "aarch64-darwin"); gitRevFlag = if inputs.self ? rev then [("--ghc-option=-D__GIT_REV__=\\\"" + inputs.self.rev + "\\\"")] @@ -114,7 +120,7 @@ stylish-haskell = "0.14.6.0"; }; # and from nixpkgs or other inputs - shell.nativeBuildInputs = with nixpkgs; [gh jq yq-go actionlint shellcheck cabal-head]; + shell.nativeBuildInputs = with nixpkgs; [gh jq yq-go actionlint shellcheck cabal-head] ++ (lib.optional isDarwin macOS-security); # disable Hoogle until someone request it shell.withHoogle = false; # Skip cross compilers for the shell @@ -161,7 +167,11 @@ in '' ${exportCliPath} cp -r ${filteredProjectBase}/* .. - ''; + '' + (if isDarwin + then '' + export PATH=${macOS-security}/bin:$PATH + '' + else ''''); }) { packages.crypton-x509-system.postPatch = ''