MakeRemote.hs

{- 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 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