webapp: Now automatically fills in any creds used by an existing remote when creating a new remote of the same type. Done for Internet Archive, S3, Glacier, and Box.com remotes.

This commit is contained in:
Joey Hess 2013-04-27 15:16:06 -04:00
parent 8626e67e97
commit c3498042fd
6 changed files with 122 additions and 50 deletions

View file

@ -1,6 +1,6 @@
{- git-annex assistant webapp configurators for WebDAV remotes
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -24,6 +24,7 @@ import Logs.Remote
import qualified Data.Map as M
#endif
import qualified Data.Text as T
import Network.URI
webDAVConfigurator :: Widget -> Handler RepHtml
webDAVConfigurator = page "Add a WebDAV repository" (Just Configuration)
@ -42,18 +43,18 @@ data WebDAVInput = WebDAVInput
toCredPair :: WebDAVInput -> CredPair
toCredPair input = (T.unpack $ user input, T.unpack $ password input)
boxComAForm :: AForm WebApp WebApp WebDAVInput
boxComAForm = WebDAVInput
<$> areq textField "Username or Email" Nothing
<*> areq passwordField "Box.com Password" Nothing
boxComAForm :: Maybe CredPair -> AForm WebApp WebApp WebDAVInput
boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds)
<*> areq checkBoxField "Share this account with other devices and friends?" (Just True)
<*> areq textField "Directory" (Just "annex")
<*> enableEncryptionField
webDAVCredsAForm :: AForm WebApp WebApp WebDAVInput
webDAVCredsAForm = WebDAVInput
<$> areq textField "Username or Email" Nothing
<*> areq passwordField "Password" Nothing
webDAVCredsAForm :: Maybe CredPair -> AForm WebApp WebApp WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds)
<*> pure False
<*> pure T.empty
<*> pure NoEncryption -- not used!
@ -63,8 +64,9 @@ getAddBoxComR = postAddBoxComR
postAddBoxComR :: Handler RepHtml
#ifdef WITH_WEBDAV
postAddBoxComR = boxConfigurator $ do
defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
((result, form), enctype) <- lift $
runFormPost $ renderBootstrap boxComAForm
runFormPost $ renderBootstrap $ boxComAForm defcreds
case result of
FormSuccess input -> lift $
makeWebDavRemote "box.com" (toCredPair input) setgroup $ M.fromList
@ -106,8 +108,11 @@ postEnableWebDAVR uuid = do
webDAVConfigurator $ showform name url
where
showform name url = do
defcreds <- liftAnnex $
maybe (pure Nothing) previouslyUsedWebDAVCreds $
urlHost url
((result, form), enctype) <- lift $
runFormPost $ renderBootstrap webDAVCredsAForm
runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds
case result of
FormSuccess input -> lift $
makeWebDavRemote name (toCredPair input) (const noop) M.empty
@ -131,3 +136,15 @@ makeWebDavRemote name creds setup config = do
liftAssistant $ syncRemote r
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
#endif
{- Only returns creds previously used for the same hostname. -}
previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair)
previouslyUsedWebDAVCreds hostname =
previouslyUsedCredPair WebDAV.davCreds WebDAV.remote samehost
where
samehost url = case urlHost =<< WebDAV.configUrl url of
Nothing -> False
Just h -> h == hostname
urlHost :: String -> Maybe String
urlHost url = uriRegName <$> (uriAuthority =<< parseURI url)