cache remote.log

Unlikely to speed up any of the existing uses much, but I want to use it
in a message that might be displayed many times.
This commit is contained in:
Joey Hess 2020-09-22 13:52:26 -04:00
parent ebdce707da
commit 5cfcf1f05f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
19 changed files with 62 additions and 29 deletions

View file

@ -154,7 +154,7 @@ postAddGlacierR = glacierConfigurator $ do
getEnableS3R :: UUID -> Handler Html
getEnableS3R uuid = do
m <- liftAnnex readRemoteLog
m <- liftAnnex remoteConfigMap
isia <- case M.lookup uuid m of
Just c -> liftAnnex $ do
pc <- parsedRemoteConfig S3.remote c
@ -180,7 +180,7 @@ enableAWSRemote remotetype uuid = do
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ awsCredsAForm defcreds
case result of
FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog
m <- liftAnnex remoteConfigMap
let name = fromJust $ lookupName $
fromJust $ M.lookup uuid m
makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty

View file

@ -59,7 +59,7 @@ getFinishDeleteRepositoryR uuid = deletionPage $ do
reponame <- liftAnnex $ Remote.prettyUUID uuid
{- If it's not listed in the remote log, it must be a git repo. -}
gitrepo <- liftAnnex $ M.notMember uuid <$> readRemoteLog
gitrepo <- liftAnnex $ M.notMember uuid <$> remoteConfigMap
$(widgetFile "configurators/delete/finished")
getDeleteCurrentRepositoryR :: Handler Html

View file

@ -71,7 +71,7 @@ getRepoConfig uuid mremote = do
void uuidDescMapLoad
groups <- lookupGroups uuid
remoteconfig <- M.lookup uuid <$> readRemoteLog
remoteconfig <- M.lookup uuid <$> remoteConfigMap
let (repogroup, associateddirectory) = case getStandardGroup groups of
Nothing -> (RepoGroupCustom $ unwords $ map fromGroup $ S.toList groups, Nothing)
Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g)
@ -122,7 +122,7 @@ setRepoConfig uuid mremote oldc newc = do
| T.null t -> noop
| otherwise -> liftAnnex $ do
let dir = takeBaseName $ T.unpack t
m <- readRemoteLog
m <- remoteConfigMap
case M.lookup uuid m of
Nothing -> noop
Just remoteconfig -> configSet uuid $
@ -220,7 +220,7 @@ editForm new (RepoUUID uuid)
let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
config <- liftAnnex $ fromMaybe mempty
. M.lookup uuid
<$> readRemoteLog
<$> remoteConfigMap
let repoInfo = getRepoInfo mremote config
let repoEncryption = getRepoEncryption mremote (Just config)
$(widgetFile "configurators/edit/repository")
@ -230,7 +230,7 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
Just rmt -> do
config <- liftAnnex $ fromMaybe mempty
. M.lookup (Remote.uuid rmt)
<$> readRemoteLog
<$> remoteConfigMap
getRepoInfo mr config
Nothing -> getRepoInfo Nothing mempty
g <- liftAnnex gitRepo
@ -242,7 +242,7 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex ()
checkAssociatedDirectory _ Nothing = noop
checkAssociatedDirectory cfg (Just r) = do
repoconfig <- M.lookup (Remote.uuid r) <$> readRemoteLog
repoconfig <- M.lookup (Remote.uuid r) <$> remoteConfigMap
case repoGroup cfg of
RepoGroupStandard gr -> case associatedDirectory repoconfig gr of
Just d -> do

View file

@ -158,7 +158,7 @@ enableIARemote uuid = do
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaCredsAForm defcreds
case result of
FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog
m <- liftAnnex remoteConfigMap
let name = fromJust $ lookupName $
fromJust $ M.lookup uuid m
AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty

View file

@ -209,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
m <- fromMaybe M.empty . M.lookup u <$> liftAnnex remoteConfigMap
case (unmangle <$> getsshdata m, lookupName m) of
(Just sshdata, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- liftH $
@ -424,7 +424,7 @@ getConfirmSshR sshdata u
-- Not a UUID we know, so prompt about combining.
$(widgetFile "configurators/ssh/combine")
handleexisting (Just _) = prepSsh False sshdata $ \sshdata' -> do
m <- liftAnnex readRemoteLog
m <- liftAnnex remoteConfigMap
case fromProposedAccepted <$> (M.lookup typeField =<< M.lookup u m) of
Just "gcrypt" -> combineExistingGCrypt sshdata' u
_ -> makeSshRepo ExistingRepo sshdata'
@ -545,7 +545,7 @@ makeSshRepo rs sshdata
-- Record the location of the ssh remote in the remote log, so it
-- can easily be enabled elsewhere using the webapp.
setup r = do
m <- readRemoteLog
m <- remoteConfigMap
let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m)
let c' = M.insert (Proposed "location") (Proposed (genSshUrl sshdata)) $
M.insert typeField (Proposed "git") $

View file

@ -53,7 +53,7 @@ getEnableWebDAVR :: UUID -> Handler Html
getEnableWebDAVR = postEnableWebDAVR
postEnableWebDAVR :: UUID -> Handler Html
postEnableWebDAVR uuid = do
m <- liftAnnex readRemoteLog
m <- liftAnnex remoteConfigMap
let c = fromJust $ M.lookup uuid m
let name = fromJust $ lookupName c
let url = fromProposedAccepted $ fromJust $ M.lookup (Accepted "url") c