summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-30 00:55:59 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-30 00:55:59 -0400
commit3026baf7ba4941029f3fb50888b3fd3290f720d1 (patch)
treedf34479c82189dde4d65453ee08a8195fb1bca59 /Remote
parentdf31307f2ce1b037b68f16f9cb0187cf1e3a7b6d (diff)
avoid unnecessary Maybe
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs2
-rw-r--r--Remote/Directory.hs4
-rw-r--r--Remote/Git.hs4
-rw-r--r--Remote/Glacier.hs72
-rw-r--r--Remote/Helper/Chunked.hs5
-rw-r--r--Remote/Helper/Encryptable.hs7
-rw-r--r--Remote/Hook.hs4
-rw-r--r--Remote/List.hs2
-rw-r--r--Remote/Rsync.hs8
-rw-r--r--Remote/S3.hs59
-rw-r--r--Remote/Web.hs6
-rw-r--r--Remote/WebDAV.hs61
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