diff options
Diffstat (limited to 'Storage')
| -rw-r--r-- | Storage/Local.hs | 23 | ||||
| -rw-r--r-- | Storage/Network.hs | 13 |
2 files changed, 25 insertions, 11 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 diff --git a/Storage/Network.hs b/Storage/Network.hs index 9d54a1c..41d1ff1 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -33,12 +33,13 @@ networkStorage storagelevel localdir server = Storage where ServerName name = serverName server -networkStorageOverride :: Maybe LocalStorageDirectory -> HostName -> Port -> Storage -networkStorageOverride lsd h p = networkStorage LocallyPreferred lsd $ Server - { serverName = ServerName h - , serverAddress = [ServerAddress h p] - , serverDesc = h - } +networkStorageOverride :: Maybe LocalStorageDirectory -> HostName -> Port -> IO (Maybe Storage) +networkStorageOverride lsd h p = return $ Just $ + networkStorage LocallyPreferred lsd $ Server + { serverName = ServerName h + , serverAddress = [ServerAddress h p] + , serverDesc = h + } store :: Server -> StorableObjectIdent -> Share -> IO StoreResult store srv i (Share _n o) = |