diff options
Diffstat (limited to 'Storage/Local.hs')
-rw-r--r-- | Storage/Local.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/Storage/Local.hs b/Storage/Local.hs index d0a1d15..38fc5b7 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -3,7 +3,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Storage.Local (localStorage, userStorageDir, testStorageDir, uploadQueue) where +module Storage.Local (localStorage, storageDir, testStorageDir, uploadQueue) where import Types import Types.Storage @@ -38,8 +38,8 @@ localStorage getsharedir n = Storage where section = Section n -uploadQueue :: Server -> Storage -uploadQueue s = localStorage userStorageDir ("uploadqueue" </> serverName s) +uploadQueue :: Maybe LocalStorageDirectory -> Server -> Storage +uploadQueue d s = localStorage (storageDir d) ("uploadqueue" </> serverName s) store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult store section getsharedir i s = onError (StoreFailure . show) $ do @@ -117,13 +117,15 @@ onError f a = do Left e -> f e Right r -> r -userStorageDir :: GetShareDir -userStorageDir (Section section) = do +storageDir :: Maybe LocalStorageDirectory -> GetShareDir +storageDir Nothing (Section section) = do u <- getUserEntryForID =<< getEffectiveUserID return $ homeDirectory u </> dotdir </> section +storageDir (Just (LocalStorageDirectory d)) (Section section) = + pure $ d </> section testStorageDir :: FilePath -> GetShareDir -testStorageDir tmpdir (Section section) = pure $ tmpdir </> section +testStorageDir tmpdir = storageDir (Just (LocalStorageDirectory tmpdir)) -- | The takeFileName ensures that, if the StorableObjectIdent somehow -- contains a path (eg starts with "../" or "/"), it is not allowed |