From fa28b51206c2877c117521a94efa9e65fca71ae5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 15 Jan 2020 13:47:31 -0400 Subject: [PATCH] fix build of webapp --- Assistant/WebApp/Configurators/AWS.hs | 8 +++++- Assistant/WebApp/Configurators/Edit.hs | 35 ++++++++++++++++-------- Assistant/WebApp/Configurators/WebDAV.hs | 6 ++-- 3 files changed, 35 insertions(+), 14 deletions(-) diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index 8e99b1b048..fd0a4b6de0 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -168,7 +168,13 @@ getEnableS3R :: UUID -> Handler Html #ifdef WITH_S3 getEnableS3R uuid = do m <- liftAnnex readRemoteLog - if maybe False S3.configIA (M.lookup uuid m) + isia <- case M.lookup uuid m of + Just c -> liftAnnex $ do + pc <- either mempty id . parseRemoteConfig c + <$> Remote.configParser S3.remote + return $ S3.configIA pc + Nothing -> return False + if isia then redirect $ EnableIAR uuid else postEnableS3R uuid #else diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index 5c448b3f45..cbb9ccb966 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -37,7 +37,7 @@ import qualified Git.Command import qualified Git.Config import qualified Annex import Git.Remote -import Remote.Helper.Encryptable (extractCipher) +import Remote.Helper.Encryptable (extractCipher, parseEncryptionConfig) import Types.Crypto import Utility.Gpg import Annex.UUID @@ -219,13 +219,21 @@ editForm new (RepoUUID uuid) redirect DashboardR _ -> do let istransfer = repoGroup curr == RepoGroupStandard TransferGroup - config <- liftAnnex $ M.lookup uuid <$> readRemoteLog + config <- liftAnnex $ fromMaybe mempty + . M.lookup uuid + <$> readRemoteLog let repoInfo = getRepoInfo mremote config - let repoEncryption = getRepoEncryption mremote config + let repoEncryption = getRepoEncryption mremote (Just config) $(widgetFile "configurators/edit/repository") editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do mr <- liftAnnex (repoIdRemote r) - let repoInfo = getRepoInfo mr Nothing + let repoInfo = case mr of + Just rmt -> do + config <- liftAnnex $ fromMaybe mempty + . M.lookup (Remote.uuid rmt) + <$> readRemoteLog + getRepoInfo mr config + Nothing -> getRepoInfo Nothing mempty g <- liftAnnex gitRepo mrepo <- liftAnnex $ maybe (pure Nothing) (Just <$$> Remote.getRepo) mr let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation) mrepo @@ -244,17 +252,21 @@ checkAssociatedDirectory cfg (Just r) = do Nothing -> noop _ -> noop -getRepoInfo :: Maybe Remote.Remote -> Maybe Remote.RemoteConfig -> Widget -getRepoInfo (Just r) (Just c) = case fromProposedAccepted <$> M.lookup typeField c of - Just "S3" +getRepoInfo :: Maybe Remote.Remote -> Remote.RemoteConfig -> Widget +getRepoInfo (Just r) c = case fromProposedAccepted <$> M.lookup typeField c of + Just "S3" -> do #ifdef WITH_S3 - | S3.configIA c -> IA.getRepoInfo c + pc <- liftAnnex $ either mempty id . parseRemoteConfig c + <$> Remote.configParser S3.remote + if S3.configIA pc + then IA.getRepoInfo c + else AWS.getRepoInfo c +#else + AWS.getRepoInfo c #endif - | otherwise -> AWS.getRepoInfo c Just t | t /= "git" -> [whamlet|#{t} remote|] _ -> getGitRepoInfo =<< liftAnnex (Remote.getRepo r) -getRepoInfo (Just r) _ = getRepoInfo (Just r) (Just $ Remote.config r) getRepoInfo _ _ = [whamlet|git repository|] getGitRepoInfo :: Git.Repo -> Widget @@ -263,7 +275,7 @@ getGitRepoInfo r = do [whamlet|git repository located at #{loc}|] getRepoEncryption :: Maybe Remote.Remote -> Maybe Remote.RemoteConfig -> Widget -getRepoEncryption (Just _) (Just c) = case extractCipher c of +getRepoEncryption (Just _) (Just c) = case extractCipher pc of Nothing -> [whamlet|not encrypted|] (Just (SharedCipher _)) -> @@ -271,6 +283,7 @@ getRepoEncryption (Just _) (Just c) = case extractCipher c of (Just (EncryptedCipher _ _ ks)) -> desckeys ks (Just (SharedPubKeyCipher _ ks)) -> desckeys ks where + pc = either mempty id $ parseEncryptionConfig c desckeys (KeyIds { keyIds = ks }) = do cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig knownkeys <- liftIO (secretKeys cmd) diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index 97732752bd..2cdcdc0f2c 100644 --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -15,7 +15,7 @@ import Creds import qualified Remote.WebDAV as WebDAV import Assistant.WebApp.MakeRemote import qualified Remote -import Types.Remote (RemoteConfig) +import Types.Remote (RemoteConfig, configParser) import Types.StandardGroups import Logs.Remote import Git.Types (RemoteName) @@ -62,7 +62,9 @@ postEnableWebDAVR uuid = do let url = fromProposedAccepted $ fromJust $ M.lookup (Accepted "url") c mcreds <- liftAnnex $ do dummycfg <- liftIO dummyRemoteGitConfig - getRemoteCredPairFor "webdav" c dummycfg (WebDAV.davCreds uuid) + pc <- either mempty id . parseRemoteConfig c + <$> configParser WebDAV.remote + getRemoteCredPairFor "webdav" pc dummycfg (WebDAV.davCreds uuid) case mcreds of Just creds -> webDAVConfigurator $ liftH $ makeWebDavRemote enableSpecialRemote name creds M.empty