diff options
Diffstat (limited to 'Storage/Local.hs')
| -rw-r--r-- | Storage/Local.hs | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/Storage/Local.hs b/Storage/Local.hs index a79cc43..cac12b3 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -14,6 +14,7 @@ module Storage.Local import Types import Types.Storage +import Output import Serialization () import Utility.UserInfo import Utility.Exception @@ -50,8 +51,17 @@ localStorage storagelevel getsharedir n = Storage where section = Section n -localStorageOverride :: FilePath -> Storage -localStorageOverride d = localStorage LocallyPreferred (\_ -> pure d) "" +localStorageOverride :: FilePath -> IO (Maybe Storage) +localStorageOverride d = onError' accesserror $ do + -- Check that the directory can be written to. + createDirectoryIfMissing True d + writeFile (d </> "test.keysafe") "test" + removeFile (d </> "test.keysafe") + return $ Just $ localStorage LocallyPreferred (\_ -> pure d) "" + where + accesserror e = do + warn $ "Unable to access local storage directory " ++ d ++ " (" ++ show e ++ ")" + return Nothing store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult store section getsharedir i s = onError (StoreFailure . show) $ do @@ -141,11 +151,14 @@ move section getsharedir storage = do _ -> return StoreAlreadyExists onError :: (IOException -> a) -> IO a -> IO a -onError f a = do +onError f = onError' (pure . f) + +onError' :: (IOException -> IO a) -> IO a -> IO a +onError' f a = do v <- try a - return $ case v of + case v of Left e -> f e - Right r -> r + Right r -> return r storageDir :: Maybe LocalStorageDirectory -> GetShareDir storageDir Nothing (Section section) = do |