From a9a015215238d9367ef8d74085ecc2187453b9a6 Mon Sep 17 00:00:00 2001
From: Pablo Lamela <pablo.lamela@iohk.io>
Date: Thu, 12 Sep 2024 04:25:29 +0200
Subject: [PATCH] Add test for `hash anchor-data` with HTTP url

---
 cardano-cli/cardano-cli.cabal                 |  6 ++
 .../test/cardano-cli-test/Test/Cli/Hash.hs    | 74 +++++++++++++++++++
 2 files changed, 80 insertions(+)

diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
index 666bdabd23..38d0440021 100644
--- a/cardano-cli/cardano-cli.cabal
+++ b/cardano-cli/cardano-cli.cabal
@@ -331,6 +331,10 @@ test-suite cardano-cli-test
     filepath,
     hedgehog,
     hedgehog-extras ^>=0.6.1.0,
+    http-types,
+    lifted-base,
+    monad-control,
+    network,
     parsec,
     regex-tdfa,
     tasty,
@@ -338,6 +342,8 @@ test-suite cardano-cli-test
     text,
     time,
     transformers,
+    wai,
+    warp,
 
   build-tool-depends: tasty-discover:tasty-discover
   other-modules:
diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs
index e09bac9931..b769f2550a 100644
--- a/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs
+++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs
@@ -1,8 +1,21 @@
+{-# 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           Data.List (intercalate)
+import qualified Data.Text as T
 import           GHC.IO.Exception (ExitCode (ExitFailure))
+import           Network.HTTP.Types.Status (status200, status404)
+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.FilePath (dropTrailingPathSeparator)
 import           System.FilePath.Posix (splitDirectories)
@@ -11,6 +24,7 @@ import           Test.Cardano.CLI.Util
 
 import           Hedgehog as H
 import qualified Hedgehog.Extras as H
+import           Hedgehog.Internal.Source (HasCallStack)
 
 exampleAnchorDataHash :: String
 exampleAnchorDataHash = "de38a4f5b8b9d8372386cc923bad19d1a0662298cf355bbe947e5eedf127fa9c"
@@ -93,3 +107,63 @@ hprop_generate_anchor_data_hash_from_file_uri =
       [] -> 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 ->
+          void $
+            execCardanoCLI
+              [ "hash"
+              , "anchor-data"
+              , "--url"
+              , "http://localhost:" ++ show port ++ "/" ++ intercalate "/" relativeUrl
+              , "--expected-hash"
+              , exampleAnchorDataHash
+              ]
+      )
+
+-- | 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
+                -- Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
+                then respond $ responseFile status200 [("Content-Type", "text/plain")] filePath Nothing
+                else respond $ responseLBS status404 [("Content-Type", "text/plain")] "404 - 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)