custom storage upload directory via IHP_STORAGE_DIR env var

IHP/FileStorage/Config.hs

@@ -94,7 +94,9 @@ initMinioStorage server bucket = do
 -- >     initStaticDirStorage
 --
 initStaticDirStorage :: State.StateT TMap.TMap IO ()
-initStaticDirStorage = option StaticDirStorage
+initStaticDirStorage = do
+    directory <- EnvVar.envOrDefault "IHP_STORAGE_DIR" "static/"
+    option StaticDirStorage { directory }
 
 -- | The Filebase access key and secret key have to be provided using the @FILEBASE_KEY@ and @FILEBASE_SECRET@ env vars.
 --

IHP/FileStorage/ControllerFunctions.hs

@@ -96,16 +96,15 @@ storeFileWithOptions fileInfo options = do
 
     let fileName = options.fileName |> fromMaybe objectId
 
-    let directory = options.directory
-    let objectPath = directory <> "/" <> UUID.toText fileName
+    let objectPath = options.directory <> "/" <> UUID.toText fileName
     let preprocess = options.preprocess
 
     fileInfo <- preprocess fileInfo
 
     url <- case storage of
-        StaticDirStorage -> do
-            let destPath :: Text = "static/" <> objectPath
-            Directory.createDirectoryIfMissing True (cs $ "static/" <> directory)
+        StaticDirStorage { directory } -> do
+            let destPath :: Text = directory <> objectPath
+            Directory.createDirectoryIfMissing True (cs $ directory <> options.directory)
 
             fileInfo
                 |> (.fileContent)
@@ -225,7 +224,7 @@ createTemporaryDownloadUrlFromPathWithExpiredAt :: (?context :: context, ConfigP
 createTemporaryDownloadUrlFromPathWithExpiredAt validInSeconds objectPath = do
     publicUrlExpiredAt <- addUTCTime (fromIntegral validInSeconds) <$> getCurrentTime
     case storage of
-        StaticDirStorage -> do
+        StaticDirStorage {} -> do
             let frameworkConfig = ?context.frameworkConfig
             let urlSchemes = ["http://", "https://"]
 
@@ -398,8 +397,8 @@ uploadToStorage field record = uploadToStorageWithOptions def field record
 removeFileFromStorage :: (?context :: context, ConfigProvider context) => StoredFile -> IO (Either MinioErr ())
 removeFileFromStorage StoredFile { path, url } = do
     case storage of
-        StaticDirStorage -> do
-            let fullPath :: String = cs $ "static/" <> path
+        StaticDirStorage { directory } -> do
+            let fullPath :: String = cs $ directory <> path
             Directory.removeFile fullPath
             pure $ Right ()
         S3Storage { connectInfo, bucket} -> do
@@ -415,5 +414,5 @@ storage = ?context.frameworkConfig.appConfig
 -- | Returns the prefix for the storage. This is either @static/@ or an empty string depending on the storage.
 storagePrefix :: (?context :: ControllerContext) => Text
 storagePrefix = case storage of
-    StaticDirStorage -> "static/"
+    StaticDirStorage { directory } -> directory
     _ -> ""

IHP/FileStorage/Types.hs

@@ -14,7 +14,7 @@ import qualified Network.Minio as Minio
 import qualified Network.Wai.Parse as Wai
 
 data FileStorage
-    = StaticDirStorage -- ^ Stores files publicly visible inside the project's @static@ directory
+    = StaticDirStorage { directory :: !Text } -- ^ Stores files publicly visible inside the project's @static@ directory
     | S3Storage { connectInfo :: Minio.ConnectInfo, bucket :: Text, baseUrl :: Text } -- ^ Stores files inside a S3 compatible cloud storage
 
 -- | Result of a 'storeFile' operation