From 3490977d97bf57bc1ce4800c2c6ada2df3b67af2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 10 Oct 2012 15:27:25 -0400 Subject: [PATCH] webapp: put new repos in standard groups I'm using transfer for most things, both removable drives and cloud storage, because it's the safest choice. We'll see if it makes sense to prompt for the group when setting this up, or let the user pick something else after the fact. --- Annex/{Groups.hs => StandardGroups.hs} | 10 +++++++++- Assistant/WebApp/Configurators/Local.hs | 9 ++++----- Assistant/WebApp/Configurators/S3.hs | 5 ++--- Assistant/WebApp/Configurators/Ssh.hs | 5 ++--- Logs/PreferredContent.hs | 2 +- 5 files changed, 18 insertions(+), 13 deletions(-) rename Annex/{Groups.hs => StandardGroups.hs} (82%) diff --git a/Annex/Groups.hs b/Annex/StandardGroups.hs similarity index 82% rename from Annex/Groups.hs rename to Annex/StandardGroups.hs index 3b44495144..e94185fbfa 100644 --- a/Annex/Groups.hs +++ b/Annex/StandardGroups.hs @@ -5,7 +5,12 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.Groups where +module Annex.StandardGroups where + +import Common.Annex +import Logs.Group + +import qualified Data.Set as S data StandardGroup = ClientGroup | TransferGroup | ArchiveGroup | BackupGroup @@ -28,3 +33,6 @@ preferredContent ClientGroup = "exclude=*/archive/*" preferredContent TransferGroup = "not inallgroup=client and " ++ preferredContent ClientGroup preferredContent ArchiveGroup = "not copies=archive:1" preferredContent BackupGroup = "" -- all content is preferred + +setStandardGroup :: UUID -> StandardGroup -> Annex () +setStandardGroup u = groupSet u . S.singleton . fromStandardGroup diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index d519113e5b..796edc3eeb 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -28,13 +28,12 @@ import Utility.DiskFree import Utility.DataUnits import Utility.Network import Remote (prettyListUUIDs) -import Logs.Group import Annex.UUID +import Annex.StandardGroups import Yesod import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Set as S import Data.Char import System.Posix.Directory import qualified Control.Exception as E @@ -147,7 +146,7 @@ getNewRepositoryR = bootstrap (Just Config) $ do let path = T.unpack p liftIO $ makeRepo path False u <- liftIO $ initRepo path Nothing - runAnnex () $ groupSet u (S.singleton "clients") + runAnnex () $ setStandardGroup u ClientGroup liftIO $ addAutoStart path redirect $ SwitchToRepositoryR path _ -> $(widgetFile "configurators/newrepository") @@ -196,7 +195,7 @@ getAddDriveR = bootstrap (Just Config) $ do liftIO $ makerepo dir u <- liftIO $ initRepo dir $ Just remotename r <- addremote dir remotename - runAnnex () $ groupSet u (S.singleton "drives") + runAnnex () $ setStandardGroup u TransferGroup syncRemote r where dir = mountpoint gitAnnexAssistantDefaultDir @@ -266,7 +265,7 @@ startFullAssistant path = do webapp <- getYesod liftIO $ makeRepo path False u <- liftIO $ initRepo path Nothing - runAnnex () $ groupSet u (S.singleton "clients") + runAnnex () $ setStandardGroup u ClientGroup url <- liftIO $ do addAutoStart path changeWorkingDirectory path diff --git a/Assistant/WebApp/Configurators/S3.hs b/Assistant/WebApp/Configurators/S3.hs index 2b9e6da7a4..9ae5fbe520 100644 --- a/Assistant/WebApp/Configurators/S3.hs +++ b/Assistant/WebApp/Configurators/S3.hs @@ -21,12 +21,11 @@ import qualified Remote.S3 as S3 import Logs.Remote import qualified Remote import Types.Remote (RemoteConfig) -import Logs.Group +import Annex.StandardGroups import Yesod import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Set as S import qualified Data.Map as M s3Configurator :: Widget -> Handler RepHtml @@ -94,7 +93,7 @@ getAddS3R = s3Configurator $ do let authtoken = webAppFormAuthToken $(widgetFile "configurators/adds3") setgroup r = runAnnex () $ - groupSet (Remote.uuid r) (S.singleton "servers") + setStandardGroup (Remote.uuid r) TransferGroup getEnableS3R :: UUID -> Handler RepHtml getEnableS3R uuid = s3Configurator $ do diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index fc3f878e8c..dafa69f263 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -19,13 +19,12 @@ import Utility.Yesod import Utility.Rsync (rsyncUrlIsShell) import Logs.Remote import Remote -import Logs.Group +import Annex.StandardGroups import Yesod import Data.Text (Text) import qualified Data.Text as T import qualified Data.Map as M -import qualified Data.Set as S import Network.Socket import System.Posix.User @@ -348,4 +347,4 @@ isRsyncNet Nothing = False isRsyncNet (Just host) = ".rsync.net" `T.isSuffixOf` T.toLower host setupGroup :: Remote -> Handler () -setupGroup r = runAnnex () $ groupSet (Remote.uuid r) (S.singleton "server") +setupGroup r = runAnnex () $ setStandardGroup (Remote.uuid r) TransferGroup diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 8fdfef1fdc..e31aa7baee 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -25,10 +25,10 @@ import Logs.UUIDBased import Limit import qualified Utility.Matcher import Annex.UUID -import Annex.Groups import Git.FilePath import Types.Group import Logs.Group +import Annex.StandardGroups {- Filename of preferred-content.log. -} preferredContentLog :: FilePath