avoid showing the connection nudge alert after creating git or gcrypt remote
This commit is contained in:
parent
a8bd7a607d
commit
1a4c3caa96
2 changed files with 16 additions and 7 deletions
|
@ -403,11 +403,14 @@ prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup
|
|||
rsynconly = onlyCapability origsshdata RsyncCapable
|
||||
|
||||
makeSshRepo :: SshData -> Handler Html
|
||||
makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $
|
||||
makeSshRemote sshdata
|
||||
makeSshRepo sshdata
|
||||
| onlyCapability sshdata RsyncCapable = setupCloudRemote TransferGroup Nothing go
|
||||
| otherwise = setupRemote EditNewRepositoryR TransferGroup Nothing go
|
||||
where
|
||||
go = makeSshRemote sshdata
|
||||
|
||||
makeGCryptRepo :: KeyId -> SshData -> Handler Html
|
||||
makeGCryptRepo keyid sshdata = setupCloudRemote TransferGroup Nothing $
|
||||
makeGCryptRepo keyid sshdata = setupRemote EditNewRepositoryR TransferGroup Nothing $
|
||||
makeGCryptRemote (sshRepoName sshdata) (genSshUrl sshdata) keyid
|
||||
|
||||
getAddRsyncNetR :: Handler Html
|
||||
|
|
|
@ -26,12 +26,18 @@ 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. -}
|
||||
- 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 defaultgroup mcost name = do
|
||||
r <- liftAnnex $ addRemote name
|
||||
setupCloudRemote = setupRemote EditNewCloudRepositoryR
|
||||
|
||||
setupRemote :: (UUID -> Route WebApp) -> StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
|
||||
setupRemote redirto defaultgroup mcost getname = do
|
||||
r <- liftAnnex $ addRemote getname
|
||||
liftAnnex $ do
|
||||
setStandardGroup (Remote.uuid r) defaultgroup
|
||||
maybe noop (Config.setRemoteCost (Remote.repo r)) mcost
|
||||
liftAssistant $ syncRemote r
|
||||
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|
||||
redirect $ redirto $ Remote.uuid r
|
||||
|
|
Loading…
Reference in a new issue