Save only the relative path of the filename for StaticDirStorage (#…

…1990)

* Save only the relative path of the filename for `StaticDirStorage`

fixes #1989

* Adapt createTemporaryDownloadUrlFromPathWithExpiredAt

* Change slash logic

* Start adding tests

* Use newControllerContext

* Start fix tests

* More fixes

* Copy from another test

* Add withFrameworkConfig

* Fix compile

* Fix tests

* Fix logic

* Ignore test folders

* Fix tests

* Re-enable all tests

* Remove line break

* Import cleanups

* More line breaks

* Line breaks

* Fix typo

* Prefix objectPath with slash

.gitignore

@@ -22,3 +22,6 @@ devenv.local.nix
 result*
 
 .idea
+
+# Test folders
+static/Test.FileStorage.ControllerFunctionsSpec

IHP/FileStorage/ControllerFunctions.hs

@@ -112,7 +112,8 @@ storeFileWithOptions fileInfo options = do
                 |> LBS.writeFile (cs destPath)
 
             let frameworkConfig = ?context.frameworkConfig
-            pure $ frameworkConfig.baseUrl <> "/" <> objectPath
+            -- Prefix with a slash so it can be used in URLs, even if the baseUrl is empty.
+            pure $ "/" <> objectPath
         S3Storage { connectInfo, bucket, baseUrl } -> do
             let payload = fileInfo
                     |> (.fileContent)
@@ -226,7 +227,13 @@ createTemporaryDownloadUrlFromPathWithExpiredAt validInSeconds objectPath = do
     case storage of
         StaticDirStorage -> do
             let frameworkConfig = ?context.frameworkConfig
-            let url = frameworkConfig.baseUrl <> "/" <> objectPath
+            let urlSchemes = ["http://", "https://"]
+
+            let url = if any (`isPrefixOf` objectPath) urlSchemes
+                    -- BC, before we saved only the relative path of a file, we saved the full URL. So use it as is.
+                    then objectPath
+                    -- We have the relative path (prefixed with slash), so add the baseUrl.
+                    else frameworkConfig.baseUrl <> objectPath
 
             pure TemporaryDownloadUrl { url = cs url, expiredAt = publicUrlExpiredAt }
         S3Storage { connectInfo, bucket} -> do
@@ -409,4 +416,4 @@ storage = ?context.frameworkConfig.appConfig
 storagePrefix :: (?context :: ControllerContext) => Text
 storagePrefix = case storage of
     StaticDirStorage -> "static/"
-    _ -> ""
+    _ -> ""

Test/FileStorage/ControllerFunctionsSpec.hs

@@ -0,0 +1,70 @@
+module Test.FileStorage.ControllerFunctionsSpec where
+
+import Test.Hspec
+import IHP.Prelude
+import IHP.FileStorage.ControllerFunctions
+import IHP.Controller.Context
+import IHP.FrameworkConfig
+import Network.Wai as Wai (defaultRequest)
+import Network.Wai.Parse (FileInfo(..))
+import IHP.Controller.RequestContext
+import IHP.FileStorage.Types
+import IHP.FileStorage.Config
+
+tests :: Spec
+tests = describe "IHP.FileStorage.ControllerFunctions" $ do
+
+    let config :: ConfigBuilder
+        config = do
+            initStaticDirStorage
+
+    let withFrameworkConfig = IHP.FrameworkConfig.withFrameworkConfig config
+
+    describe "storeFileWithOptions" $ do
+        it "returns the objectPath without the baseUrl" $ do
+            withFrameworkConfig \frameworkConfig -> do
+                context <- createControllerContext frameworkConfig
+                let ?context = context
+
+                let fileInfo = FileInfo
+                        { fileName = "test.txt"
+                        , fileContentType = "text/plain"
+                        , fileContent = "Hello, world!"
+                        }
+
+                -- We pass the UUID that will be used as the filename, so we can easily assert the objectPath.
+                let options :: StoreFileOptions = def
+                        { fileName = Just "4c55dac2-e411-45ac-aa10-b957b01221df"
+                        , directory = "Test.FileStorage.ControllerFunctionsSpec"
+                        }
+
+                result <- storeFileWithOptions fileInfo options
+
+                result.url `shouldBe` ("/Test.FileStorage.ControllerFunctionsSpec/4c55dac2-e411-45ac-aa10-b957b01221df")
+
+    describe "createTemporaryDownloadUrlFromPath" $ do
+        it "returns baseUrl concatenated with objectPath when objectPath does not start with http:// or https://" $ do
+            withFrameworkConfig \frameworkConfig -> do
+                context <- createControllerContext frameworkConfig
+                let ?context = context
+                let objectPath = "/static/test.txt"
+                temporaryDownloadUrl <- createTemporaryDownloadUrlFromPath objectPath
+
+                temporaryDownloadUrl.url `shouldBe` "http://localhost:8000/static/test.txt"
+
+        it "returns the objectPath when objectPath starts with 'http://' or 'https://'" $ do
+            withFrameworkConfig \frameworkConfig -> do
+                context <- createControllerContext frameworkConfig
+                let ?context = context
+                let objectPath = "https://example.com/static/test.txt"
+                temporaryDownloadUrl <- createTemporaryDownloadUrlFromPath objectPath
+
+                temporaryDownloadUrl.url `shouldBe` "https://example.com/static/test.txt"
+
+createControllerContext frameworkConfig = do
+    let
+        requestBody = FormBody { params = [], files = [] }
+        request = Wai.defaultRequest
+        requestContext = RequestContext { request, respond = error "respond", requestBody, frameworkConfig = frameworkConfig }
+    let ?requestContext = requestContext
+    newControllerContext

Test/Main.hs

@@ -44,6 +44,7 @@ import qualified Test.RouterSupportSpec
 import qualified Test.ViewSupportSpec
 import qualified Test.ServerSideComponent.HtmlParserSpec
 import qualified Test.ServerSideComponent.HtmlDiffSpec
+import qualified Test.FileStorage.ControllerFunctionsSpec
 import qualified Test.FileStorage.MimeTypesSpec
 import qualified Test.DataSync.DynamicQueryCompiler
 import qualified Test.IDE.CodeGeneration.MigrationGenerator
@@ -78,6 +79,7 @@ main = hspec do
     Test.ViewSupportSpec.tests
     Test.ServerSideComponent.HtmlParserSpec.tests
     Test.ServerSideComponent.HtmlDiffSpec.tests
+    Test.FileStorage.ControllerFunctionsSpec.tests
     Test.FileStorage.MimeTypesSpec.tests
     Test.DataSync.DynamicQueryCompiler.tests
     Test.IDE.SchemaDesigner.SchemaOperationsSpec.tests