mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

webapp: Improve UI around remote that have no annex.uuid set, either because setup of them is incomplete, or because the remote git repository is not a git-annex repository.

Browse source 
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.
This commit is contained in:
Joey Hess 2013-11-07 18:02:00 -04:00
parent b7c15f3b60
commit 958312885f
26 changed files with 209 additions and 156 deletions
Download patch file Download diff file Expand all files Collapse all files

36
Assistant/WebApp/Configurators/Edit.hs
View file

@ -38,6 +38,8 @@ import Remote.Helper.Encryptable (extractCipher)
import Types.Crypto
import Utility.Gpg
import Annex.UUID
import Assistant.Ssh
import Config
import qualified Data.Text as T
import qualified Data.Map as M
@ -158,26 +160,26 @@ editRepositoryAForm ishere def = RepoConfig
Nothing -> aopt hiddenField "" Nothing
Just d -> aopt textField "Associated directory" (Just $ Just d)
getEditRepositoryR :: UUID -> Handler Html
getEditRepositoryR :: RepoId -> Handler Html
getEditRepositoryR = postEditRepositoryR
postEditRepositoryR :: UUID -> Handler Html
postEditRepositoryR :: RepoId -> Handler Html
postEditRepositoryR = editForm False
getEditNewRepositoryR :: UUID -> Handler Html
getEditNewRepositoryR = postEditNewRepositoryR
postEditNewRepositoryR :: UUID -> Handler Html
postEditNewRepositoryR = editForm True
postEditNewRepositoryR = editForm True . RepoUUID
getEditNewCloudRepositoryR :: UUID -> Handler Html
getEditNewCloudRepositoryR = postEditNewCloudRepositoryR
postEditNewCloudRepositoryR :: UUID -> Handler Html
postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid)
editForm :: Bool -> UUID -> Handler Html
editForm new uuid = page "Edit repository" (Just Configuration) $ do
editForm :: Bool -> RepoId -> Handler Html
editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
when (mremote == Nothing) $
whenM ((/=) uuid <$> liftAnnex getUUID) $
@ -196,7 +198,13 @@ editForm new uuid = page "Edit repository" (Just Configuration) $ do
config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
let repoInfo = getRepoInfo mremote config
let repoEncryption = getRepoEncryption mremote config
$(widgetFile "configurators/editrepository")
$(widgetFile "configurators/edit/repository")
editForm new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
mr <- liftAnnex (repoIdRemote r)
let repoInfo = getRepoInfo mr Nothing
g <- liftAnnex gitRepo
let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation . Remote.repo) mr
$(widgetFile "configurators/edit/nonannexremote")
{- Makes any directory associated with the repository. -}
checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex ()
@ -245,3 +253,17 @@ encrypted using gpg key:
^{gpgKeyDisplay k (M.lookup k knownkeys)}
|]
getRepoEncryption _ _ = return () -- local repo
getUpgradeRepositoryR :: RepoId -> Handler ()
getUpgradeRepositoryR (RepoUUID _) = redirect DashboardR
getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
where
go Nothing = redirect DashboardR
go (Just rmt) = do
liftIO fixSshKeyPair
liftAnnex $ setConfig
(remoteConfig (Remote.repo rmt) "ignore")
(Git.Config.boolConfig False)
liftAssistant $ syncRemote rmt
liftAnnex $ void Remote.remoteListRefresh
redirect DashboardR