webapp: Differentiate between creating a new S3/Glacier/WebDav remote, and initializing an existing remote. When creating a new remote, avoid conflicts with other existing (or deleted) remotes with the same name.
This commit is contained in:
parent
e344da5ea2
commit
9fc1448947
6 changed files with 65 additions and 41 deletions
|
@ -124,7 +124,7 @@ postAddS3R = awsConfigurator $ do
|
|||
case result of
|
||||
FormSuccess input -> liftH $ do
|
||||
let name = T.unpack $ repoName input
|
||||
makeAWSRemote S3.remote (extractCreds input) name setgroup $ M.fromList
|
||||
makeAWSRemote initSpecialRemote S3.remote (extractCreds input) name setgroup $ M.fromList
|
||||
[ configureEncryption $ enableEncryption input
|
||||
, ("type", "S3")
|
||||
, ("datacenter", T.unpack $ datacenter input)
|
||||
|
@ -150,7 +150,7 @@ postAddGlacierR = glacierConfigurator $ do
|
|||
case result of
|
||||
FormSuccess input -> liftH $ do
|
||||
let name = T.unpack $ repoName input
|
||||
makeAWSRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList
|
||||
makeAWSRemote initSpecialRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList
|
||||
[ configureEncryption $ enableEncryption input
|
||||
, ("type", "glacier")
|
||||
, ("datacenter", T.unpack $ datacenter input)
|
||||
|
@ -198,7 +198,7 @@ enableAWSRemote remotetype uuid = do
|
|||
m <- liftAnnex readRemoteLog
|
||||
let name = fromJust $ M.lookup "name" $
|
||||
fromJust $ M.lookup uuid m
|
||||
makeAWSRemote remotetype creds name (const noop) M.empty
|
||||
makeAWSRemote enableSpecialRemote remotetype creds name (const noop) M.empty
|
||||
_ -> do
|
||||
description <- liftAnnex $
|
||||
T.pack <$> Remote.prettyUUID uuid
|
||||
|
@ -207,13 +207,11 @@ enableAWSRemote remotetype uuid = do
|
|||
enableAWSRemote _ _ = error "S3 not supported by this build"
|
||||
#endif
|
||||
|
||||
makeAWSRemote :: RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
|
||||
makeAWSRemote remotetype (AWSCreds ak sk) name setup config = do
|
||||
remotename <- liftAnnex $ fromRepo $ uniqueRemoteName name 0
|
||||
makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
|
||||
makeAWSRemote maker remotetype (AWSCreds ak sk) name setup config = do
|
||||
liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
|
||||
r <- liftAnnex $ addRemote $ do
|
||||
makeSpecialRemote hostname remotetype config
|
||||
return remotename
|
||||
maker hostname remotetype config
|
||||
setup r
|
||||
liftAssistant $ syncRemote r
|
||||
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|
||||
|
|
|
@ -130,7 +130,7 @@ postAddIAR = iaConfigurator $ do
|
|||
case result of
|
||||
FormSuccess input -> liftH $ do
|
||||
let name = escapeBucket $ T.unpack $ itemName input
|
||||
AWS.makeAWSRemote S3.remote (extractCreds input) name setgroup $
|
||||
AWS.makeAWSRemote initSpecialRemote S3.remote (extractCreds input) name setgroup $
|
||||
M.fromList $ catMaybes
|
||||
[ Just $ configureEncryption NoEncryption
|
||||
, Just ("type", "S3")
|
||||
|
@ -174,7 +174,7 @@ enableIARemote uuid = do
|
|||
m <- liftAnnex readRemoteLog
|
||||
let name = fromJust $ M.lookup "name" $
|
||||
fromJust $ M.lookup uuid m
|
||||
AWS.makeAWSRemote S3.remote creds name (const noop) M.empty
|
||||
AWS.makeAWSRemote enableSpecialRemote S3.remote creds name (const noop) M.empty
|
||||
_ -> do
|
||||
description <- liftAnnex $
|
||||
T.pack <$> Remote.prettyUUID uuid
|
||||
|
|
|
@ -69,7 +69,7 @@ postAddBoxComR = boxConfigurator $ do
|
|||
runFormPost $ renderBootstrap $ boxComAForm defcreds
|
||||
case result of
|
||||
FormSuccess input -> liftH $
|
||||
makeWebDavRemote "box.com" (toCredPair input) setgroup $ M.fromList
|
||||
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) setgroup $ M.fromList
|
||||
[ configureEncryption $ enableEncryption input
|
||||
, ("embedcreds", if embedCreds input then "yes" else "no")
|
||||
, ("type", "webdav")
|
||||
|
@ -100,7 +100,7 @@ postEnableWebDAVR uuid = do
|
|||
getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid)
|
||||
case mcreds of
|
||||
Just creds -> webDAVConfigurator $ liftH $
|
||||
makeWebDavRemote name creds (const noop) M.empty
|
||||
makeWebDavRemote enableSpecialRemote name creds (const noop) M.empty
|
||||
Nothing
|
||||
| "box.com/" `isInfixOf` url ->
|
||||
boxConfigurator $ showform name url
|
||||
|
@ -115,7 +115,7 @@ postEnableWebDAVR uuid = do
|
|||
runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds
|
||||
case result of
|
||||
FormSuccess input -> liftH $
|
||||
makeWebDavRemote name (toCredPair input) (const noop) M.empty
|
||||
makeWebDavRemote enableSpecialRemote name (toCredPair input) (const noop) M.empty
|
||||
_ -> do
|
||||
description <- liftAnnex $
|
||||
T.pack <$> Remote.prettyUUID uuid
|
||||
|
@ -125,13 +125,10 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build"
|
|||
#endif
|
||||
|
||||
#ifdef WITH_WEBDAV
|
||||
makeWebDavRemote :: String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
|
||||
makeWebDavRemote name creds setup config = do
|
||||
remotename <- liftAnnex $ fromRepo $ uniqueRemoteName name 0
|
||||
makeWebDavRemote :: SpecialRemoteMaker -> String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
|
||||
makeWebDavRemote maker name creds setup config = do
|
||||
liftIO $ WebDAV.setCredsEnv creds
|
||||
r <- liftAnnex $ addRemote $ do
|
||||
makeSpecialRemote name WebDAV.remote config
|
||||
return remotename
|
||||
r <- liftAnnex $ addRemote $ maker name WebDAV.remote config
|
||||
setup r
|
||||
liftAssistant $ syncRemote r
|
||||
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue