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:
parent
b7c15f3b60
commit
958312885f
26 changed files with 209 additions and 156 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue