958312885f
Complicated by such repositories potentially being repos that should have an annex.uuid, but it failed to be gotten, perhaps due to the past ssh repo setup bugs. This is handled now by an Upgrade Repository button.
36 lines
1 KiB
Haskell
36 lines
1 KiB
Haskell
{- git-annex assistant webapp making remotes
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- 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 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. -}
|
|
setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
|
|
setupCloudRemote defaultgroup mcost maker = do
|
|
r <- liftAnnex $ addRemote maker
|
|
liftAnnex $ do
|
|
setStandardGroup (Remote.uuid r) defaultgroup
|
|
maybe noop (Config.setRemoteCost r) mcost
|
|
liftAssistant $ syncRemote r
|
|
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|