Save only the relative path of the filename for StaticDirStorage

IHP/FileStorage/ControllerFunctions.hs

@@ -112,7 +112,7 @@ storeFileWithOptions fileInfo options = do
                 |> LBS.writeFile (cs destPath)
 
             let frameworkConfig = ?context.frameworkConfig
-            pure $ frameworkConfig.baseUrl <> "/" <> objectPath
+            pure $ objectPath
         S3Storage { connectInfo, bucket, baseUrl } -> do
             let payload = fileInfo
                     |> (.fileContent)
@@ -226,7 +226,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, so add the baseUrl.
+                    else frameworkConfig.baseUrl <> "/" <> objectPath
 
             pure TemporaryDownloadUrl { url = cs url, expiredAt = publicUrlExpiredAt }
         S3Storage { connectInfo, bucket} -> do
@@ -409,4 +415,4 @@ storage = ?context.frameworkConfig.appConfig
 storagePrefix :: (?context :: ControllerContext) => Text
 storagePrefix = case storage of
     StaticDirStorage -> "static/"
-    _ -> ""
+    _ -> ""

Test/FileStorage/ControllerFunctionsSpec.hs

@@ -0,0 +1,60 @@
+module Test.FileStorage.ControllerFunctionsSpec where
+
+import Test.Hspec
+import IHP.Prelude
+import IHP.FileStorage.ControllerFunctions
+import IHP.Controller.Context
+import IHP.FrameworkConfig
+import IHP.ModelSupport
+import IHP.FileStorage.Types
+import System.IO.Temp (withSystemTempDirectory)
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as Text
+import Data.Default (def)
+import Data.Time.Clock (getCurrentTime, addUTCTime)
+import Network.Wai as Wai (defaultRequest)
+import Network.Wai.Parse (FileInfo(..))
+import IHP.Controller.RequestContext
+
+tests :: Spec
+tests = describe "IHP.FileStorage.ControllerFunctions" $ do
+    describe "storeFileWithOptions" $ do
+        it "returns the objectPath without the baseUrl" $ do
+            withSystemTempDirectory "ihp-test" $ \tempDir -> do
+                context <- createControllerContext
+                let ?context = context
+
+                let fileInfo = FileInfo
+                        { fileName = "test.txt"
+                        , fileContentType = "text/plain"
+                        , fileContent = "Hello, world!"
+                        }
+
+                result <- storeFile fileInfo "Test.FileStorage.ControllerFunctionsSpec"
+
+                result.url `shouldBe` "Test.FileStorage.ControllerFunctionsSpec/test.txt"
+
+    describe "createTemporaryDownloadUrlFromPathWithExpiredAt" $ do
+        it "returns baseUrl concatenated with objectPath when objectPath does not start with http:// or https://" $ do
+            context <- createControllerContext
+            let ?context = context
+            let objectPath = "static/test.txt"
+            temporaryDownloadUrl <- createTemporaryDownloadUrlFromPath objectPath
+
+            temporaryDownloadUrl.url `shouldBe` "http://localhost:8000/static/test.txt"
+
+        it "returns '/' concatenated with objectPath when objectPath starts with 'http://' or 'https://'" $ do
+            context <- createControllerContext
+            let ?context = context
+            let objectPath = "https://example.com/static/test.txt"
+            temporaryDownloadUrl <- createTemporaryDownloadUrlFromPath objectPath
+
+            temporaryDownloadUrl.url `shouldBe` "https://example.com/static/test.txt"
+
+createControllerContext = do
+    let
+        requestBody = FormBody { params = [], files = [] }
+        request = Wai.defaultRequest
+        requestContext = RequestContext { request, respond = error "respond", requestBody, frameworkConfig = error "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