mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fix build of webapp

Browse source
This commit is contained in:
Joey Hess 2020-01-15 13:47:31 -04:00
parent b7e37334fe
commit fa28b51206
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 35 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Assistant/WebApp/Configurators/AWS.hs
View file

@ -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

35
Assistant/WebApp/Configurators/Edit.hs
View file

@ -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 <tt>#{loc}</tt>|]
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)

6
Assistant/WebApp/Configurators/WebDAV.hs
View file

@ -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