Removed the S3 and WebDAV build flags

So these special remotes are always supported.

IIRC these build flags were added because the dep chains were a bit too
long, or perhaps because the libraries were not available in Debian stable,
or something like that. That was long ago, those reasons no longer apply,
and users get confused when builtin special remotes are not available, so
it seems best to remove the build flags now.

If this does cause a problem it can be reverted of course..

This commit was sponsored by Jochen Bartl on Patreon.
This commit is contained in:
Joey Hess 2020-09-08 12:42:59 -04:00
parent 17479e45ab
commit 6ea511beb4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 19 additions and 119 deletions

View file

@ -5,18 +5,16 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
module Assistant.WebApp.Configurators.AWS where
import Assistant.WebApp.Common
import Assistant.WebApp.MakeRemote
#ifdef WITH_S3
import qualified Remote.S3 as S3
import Logs.Remote
import qualified Remote
import qualified Types.Remote as Remote
#endif
import qualified Remote.Glacier as Glacier
import qualified Remote.Helper.AWS as AWS
import Types.Remote (RemoteConfig)
@ -120,7 +118,6 @@ getAddS3R :: Handler Html
getAddS3R = postAddS3R
postAddS3R :: Handler Html
#ifdef WITH_S3
postAddS3R = awsConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $
@ -136,15 +133,11 @@ postAddS3R = awsConfigurator $ do
, (Proposed "chunk", Proposed "1MiB")
]
_ -> $(widgetFile "configurators/adds3")
#else
postAddS3R = giveup "S3 not supported by this build"
#endif
getAddGlacierR :: Handler Html
getAddGlacierR = postAddGlacierR
postAddGlacierR :: Handler Html
#ifdef WITH_S3
postAddGlacierR = glacierConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $
@ -158,12 +151,8 @@ postAddGlacierR = glacierConfigurator $ do
, (Proposed "datacenter", Proposed $ T.unpack $ datacenter input)
]
_ -> $(widgetFile "configurators/addglacier")
#else
postAddGlacierR = giveup "S3 not supported by this build"
#endif
getEnableS3R :: UUID -> Handler Html
#ifdef WITH_S3
getEnableS3R uuid = do
m <- liftAnnex readRemoteLog
isia <- case M.lookup uuid m of
@ -174,16 +163,9 @@ getEnableS3R uuid = do
if isia
then redirect $ EnableIAR uuid
else postEnableS3R uuid
#else
getEnableS3R = postEnableS3R
#endif
postEnableS3R :: UUID -> Handler Html
#ifdef WITH_S3
postEnableS3R uuid = awsConfigurator $ enableAWSRemote S3.remote uuid
#else
postEnableS3R _ = giveup "S3 not supported by this build"
#endif
getEnableGlacierR :: UUID -> Handler Html
getEnableGlacierR = postEnableGlacierR
@ -192,7 +174,6 @@ postEnableGlacierR :: UUID -> Handler Html
postEnableGlacierR = glacierConfigurator . enableAWSRemote Glacier.remote
enableAWSRemote :: RemoteType -> UUID -> Widget
#ifdef WITH_S3
enableAWSRemote remotetype uuid = do
defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $
@ -207,9 +188,6 @@ enableAWSRemote remotetype uuid = do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid
$(widgetFile "configurators/enableaws")
#else
enableAWSRemote _ _ = giveup "S3 not supported by this build"
#endif
makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler ()
makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config =
@ -228,10 +206,8 @@ getRepoInfo c = [whamlet|S3 remote using bucket: #{bucket}|]
where
bucket = maybe "" fromProposedAccepted $ M.lookup (Accepted "bucket") c
#ifdef WITH_S3
previouslyUsedAWSCreds :: Annex (Maybe CredPair)
previouslyUsedAWSCreds = getM gettype [S3.remote, Glacier.remote]
where
gettype t = previouslyUsedCredPair AWS.creds t $
not . S3.configIA . Remote.config
#endif

View file

@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Assistant.WebApp.Configurators.Edit where
@ -19,10 +19,8 @@ import Assistant.ScanRemotes
import Assistant.Sync
import Assistant.Alert
import qualified Assistant.WebApp.Configurators.AWS as AWS
#ifdef WITH_S3
import qualified Assistant.WebApp.Configurators.IA as IA
import qualified Remote.S3 as S3
#endif
import qualified Remote
import qualified Types.Remote as Remote
import Remote.List.Util
@ -256,14 +254,10 @@ checkAssociatedDirectory cfg (Just r) = do
getRepoInfo :: Maybe Remote.Remote -> Remote.RemoteConfig -> Widget
getRepoInfo (Just r) c = case fromProposedAccepted <$> M.lookup typeField c of
Just "S3" -> do
#ifdef WITH_S3
pc <- liftAnnex $ parsedRemoteConfig S3.remote c
if S3.configIA pc
then IA.getRepoInfo c
else AWS.getRepoInfo c
#else
AWS.getRepoInfo c
#endif
Just t
| t /= "git" -> [whamlet|#{t} remote|]
_ -> getGitRepoInfo =<< liftAnnex (Remote.getRepo r)

View file

@ -5,13 +5,12 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
module Assistant.WebApp.Configurators.IA where
import Assistant.WebApp.Common
import qualified Assistant.WebApp.Configurators.AWS as AWS
#ifdef WITH_S3
import qualified Remote.S3 as S3
import qualified Remote.Helper.AWS as AWS
import Assistant.WebApp.MakeRemote
@ -20,7 +19,6 @@ import qualified Types.Remote as Remote
import Types.StandardGroups
import Logs.Remote
import Assistant.Gpg
#endif
import Types.Remote (RemoteConfig)
import qualified Annex.Url as Url
import Creds
@ -106,11 +104,9 @@ iaCredsAForm defcreds = AWS.AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
#ifdef WITH_S3
previouslyUsedIACreds :: Annex (Maybe CredPair)
previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $
S3.configIA . Remote.config
#endif
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp = AWS.accessKeyIDField help
@ -124,7 +120,6 @@ getAddIAR :: Handler Html
getAddIAR = postAddIAR
postAddIAR :: Handler Html
#ifdef WITH_S3
postAddIAR = iaConfigurator $ do
defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $
@ -149,21 +144,13 @@ postAddIAR = iaConfigurator $ do
AWS.makeAWSRemote initSpecialRemote S3.remote PublicGroup (extractCreds input) name $
M.fromList $ configureEncryption NoEncryption : c
_ -> $(widgetFile "configurators/addia")
#else
postAddIAR = giveup "S3 not supported by this build"
#endif
getEnableIAR :: UUID -> Handler Html
getEnableIAR = postEnableIAR
postEnableIAR :: UUID -> Handler Html
#ifdef WITH_S3
postEnableIAR = iaConfigurator . enableIARemote
#else
postEnableIAR _ = giveup "S3 not supported by this build"
#endif
#ifdef WITH_S3
enableIARemote :: UUID -> Widget
enableIARemote uuid = do
defcreds <- liftAnnex previouslyUsedIACreds
@ -179,7 +166,6 @@ enableIARemote uuid = do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid
$(widgetFile "configurators/enableia")
#endif
{- Convert a description into a bucket item name, which will also be
- used as the repository name, and the preferreddir.
@ -205,9 +191,4 @@ $if (not exists)
|]
where
bucket = maybe "" fromProposedAccepted $ M.lookup (Accepted "bucket") c
#ifdef WITH_S3
url = S3.iaItemUrl bucket
#else
url = case bucket of
_ -> ""
#endif

View file

@ -5,13 +5,12 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP, TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
module Assistant.WebApp.Configurators.WebDAV where
import Assistant.WebApp.Common
import Creds
#ifdef WITH_WEBDAV
import qualified Remote.WebDAV as WebDAV
import Assistant.WebApp.MakeRemote
import qualified Remote
@ -25,7 +24,6 @@ import Annex.SpecialRemote.Config
import Types.ProposedAccepted
import qualified Data.Map as M
#endif
import qualified Data.Text as T
import Network.URI
@ -54,7 +52,6 @@ webDAVCredsAForm defcreds = WebDAVInput
getEnableWebDAVR :: UUID -> Handler Html
getEnableWebDAVR = postEnableWebDAVR
postEnableWebDAVR :: UUID -> Handler Html
#ifdef WITH_WEBDAV
postEnableWebDAVR uuid = do
m <- liftAnnex readRemoteLog
let c = fromJust $ M.lookup uuid m
@ -83,11 +80,7 @@ postEnableWebDAVR uuid = do
description <- liftAnnex $
T.pack <$> Remote.prettyUUID uuid
$(widgetFile "configurators/enablewebdav")
#else
postEnableWebDAVR _ = giveup "WebDAV not supported by this build"
#endif
#ifdef WITH_WEBDAV
makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler ()
makeWebDavRemote maker name creds c =
setupCloudRemote TransferGroup Nothing $
@ -101,7 +94,6 @@ previouslyUsedWebDAVCreds hostname =
samehost r = case urlHost =<< WebDAV.configUrl (config r) of
Nothing -> False
Just h -> h == hostname
#endif
urlHost :: String -> Maybe String
urlHost url = uriRegName <$> (uriAuthority =<< parseURI url)

View file

@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings, CPP #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
module Assistant.WebApp.RepoList where
@ -179,13 +179,9 @@ repoList reposelector
findinfo m g u = case fromProposedAccepted <$> getconfig (Accepted "type") of
Just "rsync" -> val True EnableRsyncR
Just "directory" -> val False EnableDirectoryR
#ifdef WITH_S3
Just "S3" -> val True EnableS3R
#endif
Just "glacier" -> val True EnableGlacierR
#ifdef WITH_WEBDAV
Just "webdav" -> val True EnableWebDAVR
#endif
Just "gcrypt" ->
-- Skip gcrypt repos on removable drives;
-- handled separately.