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

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

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

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

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