get rid of hardcoded "name" lookups
Support "sameas-name" being set instead. In RenameRemote, rename which ever of the two is set.
This commit is contained in:
parent
92ff30df70
commit
d1130ea04a
15 changed files with 45 additions and 14 deletions
|
@ -24,6 +24,7 @@ import Types.StandardGroups
|
|||
import Creds
|
||||
import Assistant.Gpg
|
||||
import Git.Types (RemoteName)
|
||||
import Annex.SpecialRemote.Config
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
@ -195,7 +196,7 @@ enableAWSRemote remotetype uuid = do
|
|||
case result of
|
||||
FormSuccess creds -> liftH $ do
|
||||
m <- liftAnnex readRemoteLog
|
||||
let name = fromJust $ M.lookup "name" $
|
||||
let name = fromJust $ lookupName $
|
||||
fromJust $ M.lookup uuid m
|
||||
makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty
|
||||
_ -> do
|
||||
|
|
|
@ -24,6 +24,7 @@ import Assistant.Gpg
|
|||
import Types.Remote (RemoteConfig)
|
||||
import qualified Annex.Url as Url
|
||||
import Creds
|
||||
import Annex.SpecialRemote.Config
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
@ -169,7 +170,7 @@ enableIARemote uuid = do
|
|||
case result of
|
||||
FormSuccess creds -> liftH $ do
|
||||
m <- liftAnnex readRemoteLog
|
||||
let name = fromJust $ M.lookup "name" $
|
||||
let name = fromJust $ lookupName $
|
||||
fromJust $ M.lookup uuid m
|
||||
AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty
|
||||
_ -> do
|
||||
|
|
|
@ -27,6 +27,7 @@ import qualified Git.Command
|
|||
import qualified Annex.Branch
|
||||
import Annex.UUID
|
||||
import Logs.UUID
|
||||
import Annex.SpecialRemote.Config
|
||||
import Assistant.RemoteControl
|
||||
import Types.Creds
|
||||
import Assistant.CredPairCache
|
||||
|
@ -208,7 +209,7 @@ postEnableSshGitRemoteR = enableSshRemote getsshinput enableRsyncNet enablesshgi
|
|||
enableSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html
|
||||
enableSshRemote getsshdata rsyncnetsetup genericsetup u = do
|
||||
m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
|
||||
case (unmangle <$> getsshdata m, M.lookup "name" m) of
|
||||
case (unmangle <$> getsshdata m, lookupName m) of
|
||||
(Just sshdata, Just reponame) -> sshConfigurator $ do
|
||||
((result, form), enctype) <- liftH $
|
||||
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
|
||||
|
@ -546,7 +547,9 @@ makeSshRepo rs sshdata
|
|||
let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m)
|
||||
let c' = M.insert "location" (genSshUrl sshdata) $
|
||||
M.insert "type" "git" $
|
||||
M.insert "name" (fromMaybe (Remote.name r) (M.lookup "name" c)) c
|
||||
case M.lookup nameKey c of
|
||||
Just _ -> c
|
||||
Nothing -> M.insert nameKey (Remote.name r) c
|
||||
configSet (Remote.uuid r) c'
|
||||
|
||||
makeSshRepoConnection :: RepoStatus -> Annex RemoteName -> (Remote -> Annex ()) -> Handler Html
|
||||
|
|
|
@ -21,6 +21,7 @@ import Logs.Remote
|
|||
import Git.Types (RemoteName)
|
||||
import Assistant.Gpg
|
||||
import Types.GitConfig
|
||||
import Annex.SpecialRemote.Config
|
||||
|
||||
import qualified Data.Map as M
|
||||
#endif
|
||||
|
@ -56,7 +57,7 @@ postEnableWebDAVR :: UUID -> Handler Html
|
|||
postEnableWebDAVR uuid = do
|
||||
m <- liftAnnex readRemoteLog
|
||||
let c = fromJust $ M.lookup uuid m
|
||||
let name = fromJust $ M.lookup "name" c
|
||||
let name = fromJust $ lookupName c
|
||||
let url = fromJust $ M.lookup "url" c
|
||||
mcreds <- liftAnnex $ do
|
||||
dummycfg <- liftIO dummyRemoteGitConfig
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue