fix UI when enabling existing gcrypt repo

avoid editing repo for same reasons as in
52601eb606

avoid stomping on its description, even though no description exists until
after syncing is complete
This commit is contained in:
Joey Hess 2014-05-30 14:49:25 -04:00
parent c92d43fb7b
commit 4f7f61e46e
2 changed files with 13 additions and 8 deletions

View file

@ -90,19 +90,23 @@ enableSpecialRemote name remotetype mcreds config = do
r <- Command.InitRemote.findExisting name
case r of
Nothing -> error $ "Cannot find a special remote named " ++ name
Just (u, c) -> setupSpecialRemote name remotetype config mcreds (Just u, c)
Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, c)
setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName
setupSpecialRemote name remotetype config mcreds (mu, c) = do
setupSpecialRemote = setupSpecialRemote' True
setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName
setupSpecialRemote' setdesc name remotetype config mcreds (mu, c) = do
{- Currently, only 'weak' ciphers can be generated from the
- assistant, because otherwise GnuPG may block once the entropy
- pool is drained, and as of now there's no way to tell the user
- to perform IO actions to refill the pool. -}
(c', u) <- R.setup remotetype mu mcreds $
M.insert "highRandomQuality" "false" $ M.union config c
whenM (isNothing . M.lookup u <$> uuidMap) $
describeUUID u name
configSet u c'
when setdesc $
whenM (isNothing . M.lookup u <$> uuidMap) $
describeUUID u name
return name
{- Returns the name of the git remote it created. If there's already a

View file

@ -475,10 +475,11 @@ checkExistingGCrypt sshdata nope = checkGCryptRepoEncryption repourl nope nope $
{- Enables an existing gcrypt special remote. -}
enableGCrypt :: SshData -> RemoteName -> Handler Html
enableGCrypt sshdata reponame =
setupCloudRemote TransferGroup Nothing $
enableSpecialRemote reponame GCrypt.remote Nothing $ M.fromList
[("gitrepo", genSshUrl sshdata)]
enableGCrypt sshdata reponame = setupRemote postsetup Nothing Nothing mk
where
mk = enableSpecialRemote reponame GCrypt.remote Nothing $
M.fromList [("gitrepo", genSshUrl sshdata)]
postsetup _ = redirect DashboardR
{- Combining with a gcrypt repository that may not be
- known in remote.log, so probe the gcrypt repo. -}