diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-30 00:55:59 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-30 00:55:59 -0400 |
commit | 3026baf7ba4941029f3fb50888b3fd3290f720d1 (patch) | |
tree | df34479c82189dde4d65453ee08a8195fb1bca59 /Remote | |
parent | df31307f2ce1b037b68f16f9cb0187cf1e3a7b6d (diff) |
avoid unnecessary Maybe
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 2 | ||||
-rw-r--r-- | Remote/Directory.hs | 4 | ||||
-rw-r--r-- | Remote/Git.hs | 4 | ||||
-rw-r--r-- | Remote/Glacier.hs | 72 | ||||
-rw-r--r-- | Remote/Helper/Chunked.hs | 5 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 7 | ||||
-rw-r--r-- | Remote/Hook.hs | 4 | ||||
-rw-r--r-- | Remote/List.hs | 2 | ||||
-rw-r--r-- | Remote/Rsync.hs | 8 | ||||
-rw-r--r-- | Remote/S3.hs | 59 | ||||
-rw-r--r-- | Remote/Web.hs | 6 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 61 |
12 files changed, 109 insertions, 125 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 62db01a7b..116a43321 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -38,7 +38,7 @@ remote = RemoteType { setup = bupSetup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote gen r u c = do buprepo <- getRemoteConfig r "buprepo" (error "missing buprepo") cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 737ae6312..c202ddb1d 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -33,7 +33,7 @@ remote = RemoteType { setup = directorySetup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote gen r u c = do dir <- getRemoteConfig r "directory" (error "missing directory") cst <- remoteCost r cheapRemoteCost @@ -52,7 +52,7 @@ gen r u c = do hasKey = checkPresent dir chunksize, hasKeyCheap = True, whereisKey = Nothing, - config = Nothing, + config = M.empty, repo = r, localpath = Just dir, readonly = False, diff --git a/Remote/Git.hs b/Remote/Git.hs index 24dd9bf80..0933a1cae 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -83,7 +83,7 @@ configRead r = do repoCheap :: Git.Repo -> Bool repoCheap = not . Git.repoIsUrl -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote gen r u _ = new <$> remoteCost r defcst where defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost @@ -98,7 +98,7 @@ gen r u _ = new <$> remoteCost r defcst , hasKey = inAnnex r , hasKeyCheap = repoCheap r , whereisKey = Nothing - , config = Nothing + , config = M.empty , localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r then Just $ Git.repoPath r else Nothing diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index a4d658d1b..edb9225aa 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -36,34 +36,31 @@ remote = RemoteType { setup = glacierSetup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote -gen r u c = do - cst <- remoteCost r veryExpensiveRemoteCost - return $ gen' r u c cst -gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote -gen' r u c cst = - encryptableRemote c +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote +gen r u c = new <$> remoteCost r veryExpensiveRemoteCost + where + new cst = encryptableRemote c (storeEncrypted this) (retrieveEncrypted this) this - where - this = Remote { - uuid = u, - cost = cst, - name = Git.repoDescribe r, - storeKey = store this, - retrieveKeyFile = retrieve this, - retrieveKeyFileCheap = retrieveCheap this, - removeKey = remove this, - hasKey = checkPresent this, - hasKeyCheap = False, - whereisKey = Nothing, - config = c, - repo = r, - localpath = Nothing, - readonly = False, - remotetype = remote - } + where + this = Remote { + uuid = u, + cost = cst, + name = Git.repoDescribe r, + storeKey = store this, + retrieveKeyFile = retrieve this, + retrieveKeyFileCheap = retrieveCheap this, + removeKey = remove this, + hasKey = checkPresent this, + hasKeyCheap = False, + whereisKey = Nothing, + config = c, + repo = r, + localpath = Nothing, + readonly = False, + remotetype = remote + } glacierSetup :: UUID -> RemoteConfig -> Annex RemoteConfig glacierSetup u c = do @@ -115,13 +112,13 @@ retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate -> storeHelper :: Remote -> Key -> (Handle -> IO ()) -> Annex Bool storeHelper r k feeder = go =<< glacierEnv c u where - c = fromJust $ config r + c = config r u = uuid r params = glacierParams c [ Param "archive" , Param "upload" , Param "--name", Param $ archive r k - , Param $ remoteVault r + , Param $ getVault $ config r , Param "-" ] go Nothing = return False @@ -135,13 +132,13 @@ storeHelper r k feeder = go =<< glacierEnv c u retrieveHelper :: Remote -> Key -> (Handle -> IO ()) -> Annex Bool retrieveHelper r k reader = go =<< glacierEnv c u where - c = fromJust $ config r + c = config r u = uuid r params = glacierParams c [ Param "archive" , Param "retrieve" , Param "-o-" - , Param $ remoteVault r + , Param $ getVault $ config r , Param $ archive r k ] go Nothing = return False @@ -163,14 +160,14 @@ remove :: Remote -> Key -> Annex Bool remove r k = glacierAction r [ Param "archive" , Param "delete" - , Param $ remoteVault r + , Param $ getVault $ config r , Param $ archive r k ] checkPresent :: Remote -> Key -> Annex (Either String Bool) checkPresent r k = do showAction $ "checking " ++ name r - go =<< glacierEnv (fromJust $ config r) (uuid r) + go =<< glacierEnv (config r) (uuid r) where go Nothing = return $ Left "cannot check glacier" go (Just e) = do @@ -190,7 +187,7 @@ checkPresent r k = do params = [ Param "archive" , Param "checkpresent" - , Param $ remoteVault r + , Param $ getVault $ config r , Param "--quiet" , Param $ archive r k ] @@ -205,7 +202,7 @@ checkPresent r k = do return $ Right False glacierAction :: Remote -> [CommandParam] -> Annex Bool -glacierAction r params = runGlacier (fromJust $ config r) (uuid r) params +glacierAction r params = runGlacier (config r) (uuid r) params runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool runGlacier c u params = go =<< glacierEnv c u @@ -231,16 +228,13 @@ glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds creds = AWS.creds u (uk, pk) = credPairEnvironment creds -remoteVault :: Remote -> Vault -remoteVault = getVault . fromJust . config - getVault :: RemoteConfig -> Vault getVault = fromJust . M.lookup "vault" archive :: Remote -> Key -> Archive archive r k = fileprefix ++ key2file k where - fileprefix = M.findWithDefault "" "fileprefix" $ fromJust $ config r + fileprefix = M.findWithDefault "" "fileprefix" $ config r -- glacier vault create will succeed even if the vault already exists. genVault :: RemoteConfig -> UUID -> Annex () @@ -260,11 +254,11 @@ genVault c u = unlessM (runGlacier c u params) $ - keys when the remote is encrypted. -} jobList :: Remote -> [Key] -> Annex ([Key], [Key]) -jobList r keys = go =<< glacierEnv (fromJust $ config r) (uuid r) +jobList r keys = go =<< glacierEnv (config r) (uuid r) where params = [ Param "job", Param "list" ] nada = ([], []) - myvault = remoteVault r + myvault = getVault $ config r go Nothing = return nada go (Just e) = do diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 4f04a1c38..04bde4c29 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -20,9 +20,8 @@ import qualified Control.Exception as E type ChunkSize = Maybe Int64 {- Gets a remote's configured chunk size. -} -chunkSize :: Maybe RemoteConfig -> ChunkSize -chunkSize Nothing = Nothing -chunkSize (Just m) = +chunkSize :: RemoteConfig -> ChunkSize +chunkSize m = case M.lookup "chunksize" m of Nothing -> Nothing Just v -> case readSize dataUnits v of diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 05aca9a41..d322a5cf8 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -44,7 +44,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of - Two additional functions must be provided by the remote, - to support storing and retrieving encrypted content. -} encryptableRemote - :: Maybe RemoteConfig + :: RemoteConfig -> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool) -> ((Cipher, Key) -> Key -> FilePath -> Annex Bool) -> Remote @@ -103,9 +103,8 @@ embedCreds c | otherwise = False {- Gets encryption Cipher, and encrypted version of Key. -} -cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key)) -cipherKey Nothing _ = return Nothing -cipherKey (Just c) k = maybe Nothing make <$> remoteCipher c +cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key)) +cipherKey c k = maybe Nothing make <$> remoteCipher c where make ciphertext = Just (ciphertext, encryptKey ciphertext k) diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 7173a5b80..e6e1231a8 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -29,7 +29,7 @@ remote = RemoteType { setup = hookSetup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote gen r u c = do hooktype <- getRemoteConfig r "hooktype" (error "missing hooktype") cst <- remoteCost r expensiveRemoteCost @@ -47,7 +47,7 @@ gen r u c = do hasKey = checkPresent r hooktype, hasKeyCheap = False, whereisKey = Nothing, - config = Nothing, + config = M.empty, localpath = Nothing, repo = r, readonly = False, diff --git a/Remote/List.hs b/Remote/List.hs index 3179456eb..4622f1e99 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -81,7 +81,7 @@ remoteListRefresh = do remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote remoteGen m t r = do u <- getRepoUUID r - addHooks =<< generate t r u (M.lookup u m) + addHooks =<< generate t r u (fromMaybe M.empty $ M.lookup u m) {- Updates a local git Remote, re-reading its git config. -} updateRemote :: Remote -> Annex Remote diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index a3ad21f73..2ad5482ec 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -38,7 +38,7 @@ remote = RemoteType { setup = rsyncSetup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote gen r u c = do o <- genRsyncOpts r c cst <- remoteCost r expensiveRemoteCost @@ -56,7 +56,7 @@ gen r u c = do , hasKey = checkPresent r o , hasKeyCheap = False , whereisKey = Nothing - , config = Nothing + , config = M.empty , repo = r , localpath = if rsyncUrlIsPath $ rsyncUrl o then Just $ rsyncUrl o @@ -65,12 +65,12 @@ gen r u c = do , remotetype = remote } -genRsyncOpts :: Git.Repo -> Maybe RemoteConfig -> Annex RsyncOpts +genRsyncOpts :: Git.Repo -> RemoteConfig -> Annex RsyncOpts genRsyncOpts r c = do url <- getRemoteConfig r "rsyncurl" (error "missing rsyncurl") opts <- map Param . filter safe . words <$> getRemoteConfig r "rsync-options" "" - let escape = maybe True (\m -> M.lookup "shellescape" m /= Just "no") c + let escape = M.lookup "shellescape" c /= Just "no" return $ RsyncOpts url opts escape where safe o diff --git a/Remote/S3.hs b/Remote/S3.hs index ba5fb949b..512b3f778 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -36,34 +36,31 @@ remote = RemoteType { setup = s3Setup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote -gen r u c = do - cst <- remoteCost r expensiveRemoteCost - return $ gen' r u c cst -gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote -gen' r u c cst = - encryptableRemote c +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote +gen r u c = new <$> remoteCost r expensiveRemoteCost + where + new cst = encryptableRemote c (storeEncrypted this) (retrieveEncrypted this) this - where - this = Remote { - uuid = u, - cost = cst, - name = Git.repoDescribe r, - storeKey = store this, - retrieveKeyFile = retrieve this, - retrieveKeyFileCheap = retrieveCheap this, - removeKey = remove this, - hasKey = checkPresent this, - hasKeyCheap = False, - whereisKey = Nothing, - config = c, - repo = r, - localpath = Nothing, - readonly = False, - remotetype = remote - } + where + this = Remote { + uuid = u, + cost = cst, + name = Git.repoDescribe r, + storeKey = store this, + retrieveKeyFile = retrieve this, + retrieveKeyFileCheap = retrieveCheap this, + removeKey = remove this, + hasKey = checkPresent this, + hasKeyCheap = False, + whereisKey = Nothing, + config = c, + repo = r, + localpath = Nothing, + readonly = False, + remotetype = remote + } s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig s3Setup u c = handlehost $ M.lookup "host" c @@ -143,13 +140,13 @@ storeHelper (conn, bucket) r k p file = do sendObject conn object where storageclass = - case fromJust $ M.lookup "storageclass" $ fromJust $ config r of + case fromJust $ M.lookup "storageclass" $ config r of "REDUCED_REDUNDANCY" -> REDUCED_REDUNDANCY _ -> STANDARD getsize = liftIO $ fromIntegral . fileSize <$> getFileStatus file - xheaders = filter isxheader $ M.assocs $ fromJust $ config r + xheaders = filter isxheader $ M.assocs $ config r isxheader (h, _) = "x-amz-" `isPrefixOf` h retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool @@ -207,10 +204,8 @@ s3Bool (Left e) = s3Warning e s3Action :: Remote -> a -> ((AWSConnection, String) -> Annex a) -> Annex a s3Action r noconn action = do - when (isNothing $ config r) $ - error $ "Missing configuration for special remote " ++ name r - let bucket = M.lookup "bucket" $ fromJust $ config r - conn <- s3Connection (fromJust $ config r) (uuid r) + let bucket = M.lookup "bucket" $ config r + conn <- s3Connection (config r) (uuid r) case (bucket, conn) of (Just b, Just c) -> action (c, b) _ -> return noconn @@ -222,7 +217,7 @@ bucketFile r = munge . key2file Just "ia" -> iaMunge $ fileprefix ++ s _ -> fileprefix ++ s fileprefix = M.findWithDefault "" "fileprefix" c - c = fromJust $ config r + c = config r bucketKey :: Remote -> String -> Key -> S3Object bucketKey r bucket k = S3Object bucket (bucketFile r k) "" [] L.empty diff --git a/Remote/Web.hs b/Remote/Web.hs index e51a73901..f1eee7feb 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -17,6 +17,8 @@ import Logs.Web import qualified Utility.Url as Url import Types.Key +import qualified Data.Map as M + remote :: RemoteType remote = RemoteType { typename = "web", @@ -33,7 +35,7 @@ list = do r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown return [r] -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote gen r _ _ = return Remote { uuid = webUUID, @@ -46,7 +48,7 @@ gen r _ _ = hasKey = checkKey, hasKeyCheap = False, whereisKey = Just getUrls, - config = Nothing, + config = M.empty, localpath = Nothing, repo = r, readonly = True, diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index a5bba716b..d6fc35f2e 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -45,34 +45,31 @@ remote = RemoteType { setup = webdavSetup } -gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote -gen r u c = do - cst <- remoteCost r expensiveRemoteCost - return $ gen' r u c cst -gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote -gen' r u c cst = - encryptableRemote c +gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote +gen r u c = new <$> remoteCost r expensiveRemoteCost + where + new cst = encryptableRemote c (storeEncrypted this) (retrieveEncrypted this) this - where - this = Remote { - uuid = u, - cost = cst, - name = Git.repoDescribe r, - storeKey = store this, - retrieveKeyFile = retrieve this, - retrieveKeyFileCheap = retrieveCheap this, - removeKey = remove this, - hasKey = checkPresent this, - hasKeyCheap = False, - whereisKey = Nothing, - config = c, - repo = r, - localpath = Nothing, - readonly = False, - remotetype = remote - } + where + this = Remote { + uuid = u, + cost = cst, + name = Git.repoDescribe r, + storeKey = store this, + retrieveKeyFile = retrieve this, + retrieveKeyFileCheap = retrieveCheap this, + removeKey = remove this, + hasKey = checkPresent this, + hasKeyCheap = False, + whereisKey = Nothing, + config = c, + repo = r, + localpath = Nothing, + readonly = False, + remotetype = remote + } webdavSetup :: UUID -> RemoteConfig -> Annex RemoteConfig webdavSetup u c = do @@ -201,14 +198,12 @@ withStoredFiles r k baseurl user pass onerr a keyurl = davLocation baseurl k ++ keyFile k davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a -davAction r unconfigured action = case config r of - Nothing -> return unconfigured - Just c -> do - mcreds <- getCreds c (uuid r) - case (mcreds, M.lookup "url" c) of - (Just (user, pass), Just url) -> - action (url, toDavUser user, toDavPass pass) - _ -> return unconfigured +davAction r unconfigured action = do + mcreds <- getCreds (config r) (uuid r) + case (mcreds, M.lookup "url" $ config r) of + (Just (user, pass), Just url) -> + action (url, toDavUser user, toDavPass pass) + _ -> return unconfigured toDavUser :: String -> DavUser toDavUser = B8.fromString |