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.

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

View file

@ -23,7 +23,7 @@ import Types.Remote (RemoteConfig)
import Types.StandardGroups
import Creds
import Assistant.Gpg
import Git.Remote
import Git.Types (RemoteName)
import qualified Data.Text as T
import qualified Data.Map as M

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

View file

@ -200,7 +200,7 @@ getCombineRepositoryR :: FilePath -> UUID -> Handler Html
getCombineRepositoryR newrepopath newrepouuid = do
r <- combineRepos newrepopath remotename
liftAssistant $ syncRemote r
redirect $ EditRepositoryR newrepouuid
redirect $ EditRepositoryR $ RepoUUID newrepouuid
where
remotename = takeFileName newrepopath

View file

@ -20,7 +20,7 @@ import Types.StandardGroups
import Utility.UserInfo
import Utility.Gpg
import Types.Remote (RemoteConfig)
import Git.Remote
import Git.Types (RemoteName)
import qualified Remote.GCrypt as GCrypt
import Annex.UUID
import Logs.UUID

View file

@ -18,7 +18,7 @@ import qualified Remote
import Types.Remote (RemoteConfig)
import Types.StandardGroups
import Logs.Remote
import Git.Remote
import Git.Types (RemoteName)
import qualified Data.Map as M
#endif