diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-22 10:45:42 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-22 10:45:42 -0400 |
commit | f333320af9d711c33b56dcd8dd1df9d9d1b270c3 (patch) | |
tree | fdf30c1c90573a2e9eb9b711081b3a011a40e41f | |
parent | 3923667ebdb24680dbb415bd688a8c0326df2212 (diff) | |
download | keysafe-f333320af9d711c33b56dcd8dd1df9d9d1b270c3.tar.gz |
cleanup
-rw-r--r-- | Servers.hs | 4 | ||||
-rw-r--r-- | Storage.hs | 9 | ||||
-rw-r--r-- | keysafe.hs | 6 |
3 files changed, 9 insertions, 10 deletions
@@ -13,8 +13,8 @@ serverUrls srv = map go (serverAddress srv) where go (ServerAddress addr port) = BaseUrl Http addr port "" -networkServers :: IO [Server] -networkServers = return +networkServers :: [Server] +networkServers = [ Server (ServerName "keysafe.joeyh.name") [ServerAddress "vzgrspuxbtnlrtup.onion" 4242] -- Purism server is not yet deployed, but planned. @@ -26,10 +26,9 @@ import Control.Concurrent.Async import qualified Data.Set as S import Network.Wai.Handler.Warp (Port) -allStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations -allStorageLocations d = do - servers <- networkServers - return $ StorageLocations $ map (networkStorage d) servers +networkStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations +networkStorageLocations d = StorageLocations $ + map (networkStorage d) networkServers localStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations localStorageLocations d = StorageLocations $ @@ -122,12 +121,12 @@ retrieveShares (StorageLocations locs) sis updateprogress = do -- | Returns descriptions of any failures. uploadQueued :: Maybe LocalStorageDirectory -> IO [String] uploadQueued d = do - StorageLocations locs <- allStorageLocations d results <- forM locs $ \loc -> case uploadQueue loc of Nothing -> return [] Just q -> moveShares q loc return $ processresults (concat results) [] where + StorageLocations locs = networkStorageLocations d processresults [] c = nub c processresults (StoreSuccess:rs) c = processresults rs c processresults (StoreFailure e:rs) c = processresults rs (e:c) @@ -44,9 +44,9 @@ main = do "Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!" return (mkt testModeTunables, [mkt testModeTunables]) else return (mkt defaultTunables, map (mkt . snd) knownTunings) - storagelocations <- if CmdLine.localstorage cmdline - then pure $ localStorageLocations (CmdLine.localstoragedirectory cmdline) - else allStorageLocations (CmdLine.localstoragedirectory cmdline) + let storagelocations = if CmdLine.localstorage cmdline + then localStorageLocations (CmdLine.localstoragedirectory cmdline) + else networkStorageLocations (CmdLine.localstoragedirectory cmdline) dispatch cmdline ui storagelocations tunables possibletunables dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO () |