d266a41f8d
Ignore annex.numcopies set to 0 in gitattributes or git config, or by git-annex numcopies or by --numcopies, since that configuration would make git-annex easily lose data. Same for mincopies. This is a continuation of the work to make data only be able to be lost when --force is used. It earlier led to the --trust option being disabled, and similar reasoning applies here. Most numcopies configs had docs that strongly discouraged setting it to 0 anyway. And I can't imagine a use case for setting to 0. Not that there might not be one, but it's just so far from the intended use case of git-annex, of managing and storing your data, that it does not seem like it makes sense to cater to such a hypothetical use case, where any git-annex drop can lose your data at any time. Using a smart constructor makes sure every place avoids 0. Note that this does mean that NumCopies is for the configured desired values, and not the actual existing number of copies, which of course can be 0. The name configuredNumCopies is used to make that clear. Sponsored-by: Brock Spratlen on Patreon
114 lines
3.6 KiB
Haskell
114 lines
3.6 KiB
Haskell
{- git-annex assistant general preferences
|
|
-
|
|
- Copyright 2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
|
|
|
|
module Assistant.WebApp.Configurators.Preferences (
|
|
getPreferencesR,
|
|
postPreferencesR
|
|
) where
|
|
|
|
import Assistant.WebApp.Common
|
|
import qualified Annex
|
|
import qualified Git
|
|
import Config
|
|
import Config.Files.AutoStart
|
|
import Annex.NumCopies
|
|
import Utility.DataUnits
|
|
import Types.Distribution
|
|
import Assistant.Upgrade
|
|
|
|
import qualified Data.Text as T
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
data PrefsForm = PrefsForm
|
|
{ diskReserve :: Text
|
|
, numCopies :: Int
|
|
, autoStart :: Bool
|
|
, autoUpgrade :: AutoUpgrade
|
|
}
|
|
|
|
prefsAForm :: PrefsForm -> MkAForm PrefsForm
|
|
prefsAForm d = PrefsForm
|
|
<$> areq (storageField `withNote` diskreservenote)
|
|
(bfs "Disk reserve") (Just $ diskReserve d)
|
|
<*> areq (positiveIntField `withNote` numcopiesnote)
|
|
(bfs "Number of copies") (Just $ numCopies d)
|
|
<*> areq (checkBoxField `withNote` autostartnote)
|
|
"Auto start" (Just $ autoStart d)
|
|
<*> areq (selectFieldList autoUpgradeChoices)
|
|
(bfs autoUpgradeLabel) (Just $ autoUpgrade d)
|
|
where
|
|
diskreservenote = [whamlet|<br>Avoid downloading files from other repositories when there is too little free disk space.|]
|
|
numcopiesnote = [whamlet|<br>Only drop a file after verifying that other repositories contain this many copies.|]
|
|
autostartnote = [whamlet|Start the git-annex assistant at boot or on login.|]
|
|
|
|
autoUpgradeChoices :: [(Text, AutoUpgrade)]
|
|
autoUpgradeChoices =
|
|
[ ("ask me", AskUpgrade)
|
|
, ("enabled", AutoUpgrade)
|
|
, ("disabled", NoAutoUpgrade)
|
|
]
|
|
autoUpgradeLabel
|
|
| upgradeSupported = "Auto upgrade"
|
|
| otherwise = "Auto restart on upgrade"
|
|
|
|
positiveIntField = check isPositive intField
|
|
where
|
|
isPositive i
|
|
| i > 0 = Right i
|
|
| otherwise = Left notPositive
|
|
notPositive :: Text
|
|
notPositive = "This should be 1 or more!"
|
|
|
|
storageField = check validStorage textField
|
|
where
|
|
validStorage t
|
|
| T.null t = Right t
|
|
| otherwise = case readSize dataUnits $ T.unpack t of
|
|
Nothing -> Left badParse
|
|
Just _ -> Right t
|
|
badParse :: Text
|
|
badParse = "Parse error. Expected something like \"100 megabytes\" or \"2 gb\""
|
|
|
|
getPrefs :: Annex PrefsForm
|
|
getPrefs = PrefsForm
|
|
<$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig)
|
|
<*> (fromNumCopies <$> getNumCopies)
|
|
<*> inAutoStartFile
|
|
<*> (annexAutoUpgrade <$> Annex.getGitConfig)
|
|
|
|
storePrefs :: PrefsForm -> Annex ()
|
|
storePrefs p = do
|
|
setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p)
|
|
setGlobalNumCopies (configuredNumCopies $ numCopies p)
|
|
unsetConfig (annexConfig "numcopies") -- deprecated
|
|
setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p)
|
|
unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do
|
|
here <- fromRawFilePath <$> fromRepo Git.repoPath
|
|
liftIO $ if autoStart p
|
|
then addAutoStartFile here
|
|
else removeAutoStartFile here
|
|
|
|
getPreferencesR :: Handler Html
|
|
getPreferencesR = postPreferencesR
|
|
postPreferencesR :: Handler Html
|
|
postPreferencesR = page "Preferences" (Just Configuration) $ do
|
|
((result, form), enctype) <- liftH $ do
|
|
current <- liftAnnex getPrefs
|
|
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ prefsAForm current
|
|
case result of
|
|
FormSuccess new -> liftH $ do
|
|
liftAnnex $ storePrefs new
|
|
redirect ConfigurationR
|
|
_ -> $(widgetFile "configurators/preferences")
|
|
|
|
inAutoStartFile :: Annex Bool
|
|
inAutoStartFile = do
|
|
here <- liftIO . absPath =<< fromRepo Git.repoPath
|
|
any (`P.equalFilePath` here) . map toRawFilePath
|
|
<$> liftIO readAutoStartFile
|