mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor

Browse source
This commit is contained in:
Joey Hess 2013-09-27 00:15:50 -04:00
parent 1550759220
commit 7665773593
5 changed files with 54 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Assistant/WebApp/Configurators/WebDAV.hs
View file

@ -14,13 +14,13 @@ import Creds
#ifdef WITH_WEBDAV
import qualified Remote.WebDAV as WebDAV
import Assistant.MakeRemote
import Assistant.Sync
import qualified Remote
import Types.Remote (RemoteConfig)
import Types.StandardGroups
import Logs.PreferredContent
import Logs.Remote
import Assistant.Gpg
import Assistant.WebApp.Utility
import Git.Remote
import qualified Data.Map as M
#endif
@ -70,7 +70,7 @@ postAddBoxComR = boxConfigurator $ do
runFormPost $ renderBootstrap $ boxComAForm defcreds
case result of
FormSuccess input -> liftH $
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) setgroup $ M.fromList
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList
[ configureEncryption $ enableEncryption input
, ("embedcreds", if embedCreds input then "yes" else "no")
, ("type", "webdav")
@ -81,9 +81,6 @@ postAddBoxComR = boxConfigurator $ do
, ("chunksize", "10mb")
]
_ -> $(widgetFile "configurators/addbox.com")
where
setgroup r = liftAnnex $
setStandardGroup (Remote.uuid r) TransferGroup
#else
postAddBoxComR = error "WebDAV not supported by this build"
#endif
@ -101,7 +98,7 @@ postEnableWebDAVR uuid = do
getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid)
case mcreds of
Just creds -> webDAVConfigurator $ liftH $
makeWebDavRemote enableSpecialRemote name creds (const noop) M.empty
makeWebDavRemote enableSpecialRemote name creds M.empty
Nothing
| "box.com/" `isInfixOf` url ->
boxConfigurator $ showform name url
@ -116,7 +113,7 @@ postEnableWebDAVR uuid = do
runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds
case result of
FormSuccess input -> liftH $
makeWebDavRemote enableSpecialRemote name (toCredPair input) (const noop) M.empty
makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty
_ -> do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid
@ -126,13 +123,10 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build"
#endif
#ifdef WITH_WEBDAV
makeWebDavRemote :: SpecialRemoteMaker -> String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
makeWebDavRemote maker name creds setup config = do
makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler ()
makeWebDavRemote maker name creds config = do
liftIO $ WebDAV.setCredsEnv creds
r <- liftAnnex $ addRemote $ maker name WebDAV.remote config
setup r
liftAssistant $ syncRemote r
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
setupCloudRemote TransferGroup $ maker name WebDAV.remote config
{- Only returns creds previously used for the same hostname. -}
previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair)