67e46229a5
This is groundwork for letting a repo be instantiated the first time it's actually used, instead of at startup. The only behavior change is that some old special cases for xmpp remotes were removed. Where before git-annex silently did nothing with those no-longer supported remotes, it may now fail in some way. The additional IO action should have no performance impact as long as it's simply return. This commit was sponsored by Boyd Stephen Smith Jr. on Patreon
46 lines
1.4 KiB
Haskell
46 lines
1.4 KiB
Haskell
{- git-annex assistant webapp making remotes
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.WebApp.MakeRemote (
|
|
module Assistant.MakeRemote,
|
|
module Assistant.WebApp.MakeRemote
|
|
) where
|
|
|
|
import Assistant.Common
|
|
import Assistant.WebApp.Types
|
|
import Assistant.Sync
|
|
import qualified Remote
|
|
import qualified Types.Remote as Remote
|
|
import qualified Config
|
|
import Config.Cost
|
|
import Types.StandardGroups
|
|
import Git.Types (RemoteName)
|
|
import Logs.PreferredContent
|
|
import Assistant.MakeRemote
|
|
|
|
import Utility.Yesod
|
|
|
|
{- Runs an action that creates or enables a cloud remote,
|
|
- and finishes setting it up, then starts syncing with it,
|
|
- and finishes by displaying the page to edit it.
|
|
-
|
|
- This includes displaying the connectionNeeded nudge if appropariate.
|
|
-}
|
|
setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
|
|
setupCloudRemote = setupRemote postsetup . Just
|
|
where
|
|
postsetup = redirect . EditNewCloudRepositoryR . Remote.uuid
|
|
|
|
setupRemote :: (Remote -> Handler a) -> Maybe StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
|
|
setupRemote postsetup mgroup mcost getname = do
|
|
r <- liftAnnex $ addRemote getname
|
|
repo <- liftAnnex $ Remote.getRepo r
|
|
liftAnnex $ do
|
|
maybe noop (defaultStandardGroup (Remote.uuid r)) mgroup
|
|
maybe noop (Config.setRemoteCost repo) mcost
|
|
liftAssistant $ syncRemote r
|
|
postsetup r
|