summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Servers.hs4
-rw-r--r--Storage.hs9
-rw-r--r--keysafe.hs6
3 files changed, 9 insertions, 10 deletions
diff --git a/Servers.hs b/Servers.hs
index 8b99fe0..bb552b7 100644
--- a/Servers.hs
+++ b/Servers.hs
@@ -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.
diff --git a/Storage.hs b/Storage.hs
index 3e2c418..ef042ba 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -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)
diff --git a/keysafe.hs b/keysafe.hs
index 83a010a..be5850b 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -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 ()