-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
--
-- Support for the Borg backup tool <https://github.com/borgbackup>

module Propellor.Property.Borg
	( BorgParam
	, BorgRepo(..)
	, BorgRepoOpt(..)
	, BorgEnc(..)
	, installed
	, repoExists
	, init
	, restored
	, backup
	, KeepPolicy (..)
	) where

import Propellor.Base hiding (init, last)
import Prelude hiding (init)
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
import Data.List (intercalate, isSuffixOf)
import Data.Char (intToDigit)
import Numeric (showIntAtBase)
import Utility.SafeCommand (boolSystem', toCommand)

-- | Borg command.
type BorgCommand = String

-- | Parameter to pass to a borg command.
type BorgParam = String

-- | A borg repository.
data BorgRepo
	-- | Location of the repository, eg
	-- `BorgRepo "root@myserver:/mnt/backup/git.borg"`
	= BorgRepo String
	-- | Location of the repository, and additional options to use
	-- when accessing the repository.
	| BorgRepoUsing [BorgRepoOpt] String

data BorgRepoOpt 
	-- | Use to specify a ssh private key to use when accessing a
	-- BorgRepo.
	= UseSshKey FilePath
	-- | Use to specify a umask to use when accessing BorgRepo.
	| UseUmask FileMode
	-- | Use to specify an environment variable to set when running
	-- borg on a BorgRepo.
	| UsesEnvVar (String, String)

-- | Borg Encryption type.
data BorgEnc
	-- | No encryption, no authentication.
	= BorgEncNone
	-- | Authenticated, using SHA-256 for hash/MAC.
	| BorgEncAuthenticated
	-- | Authenticated, using Blake2b for hash/MAC.
	| BorgEncAuthenticatedBlake2
	-- | Encrypted, storing the key in the repository, using SHA-256 for
	-- hash/MAC.
	| BorgEncRepokey
	-- | Encrypted, storing the key in the repository, using Blake2b for
	-- hash/MAC.
	| BorgEncRepokeyBlake2
	-- | Encrypted, storing the key outside of the repository, using
	-- SHA-256 for hash/MAC.
	| BorgEncKeyfile
	-- | Encrypted, storing the key outside of the repository, using
	-- Blake2b for hash/MAC.
	| BorgEncKeyfileBlake2

repoLoc :: BorgRepo -> String
repoLoc :: BorgRepo -> String
repoLoc (BorgRepo String
s) = String
s
repoLoc (BorgRepoUsing [BorgRepoOpt]
_ String
s) = String
s

runBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> Maybe FilePath -> IO Bool
runBorg :: BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
runBorg BorgRepo
repo String
cmd [CommandParam]
ps Maybe String
chdir = case BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo of
	[] -> Maybe [(String, String)] -> IO Bool
runBorg' Maybe [(String, String)]
forall a. Maybe a
Nothing
	[(String, String)]
environ -> do
		[(String, String)]
environ' <- [(String, String)] -> [(String, String)] -> [(String, String)]
forall k v. Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
addEntries [(String, String)]
environ ([(String, String)] -> [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
		Maybe [(String, String)] -> IO Bool
runBorg' ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
environ')
  where
	runBorg' :: Maybe [(String, String)] -> IO Bool
runBorg' Maybe [(String, String)]
environ = String
-> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
boolSystem' String
"borg" [CommandParam]
params ((CreateProcess -> CreateProcess) -> IO Bool)
-> (CreateProcess -> CreateProcess) -> IO Bool
forall a b. (a -> b) -> a -> b
$
		\CreateProcess
p -> CreateProcess
p { cwd :: Maybe String
cwd = Maybe String
chdir, env :: Maybe [(String, String)]
env = Maybe [(String, String)]
environ }
	params :: [CommandParam]
params = BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
cmd [CommandParam]
ps

readBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> IO String
readBorg :: BorgRepo -> String -> [CommandParam] -> IO String
readBorg BorgRepo
repo String
cmd [CommandParam]
ps = case BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo of
	[] -> String -> [String] -> IO String
readProcess String
"borg" [String]
params
	[(String, String)]
environ -> do
		[(String, String)]
environ' <- [(String, String)] -> [(String, String)] -> [(String, String)]
forall k v. Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
addEntries [(String, String)]
environ ([(String, String)] -> [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
		String -> [String] -> Maybe [(String, String)] -> IO String
readProcessEnv String
"borg" [String]
params ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
environ')
  where
	params :: [String]
params = [CommandParam] -> [String]
toCommand (BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
cmd [CommandParam]
ps)

runBorgParam :: BorgRepo -> BorgCommand -> [CommandParam] -> [CommandParam]
runBorgParam :: BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam (BorgRepo String
_) String
cmd [CommandParam]
ps = String -> CommandParam
Param String
cmd CommandParam -> [CommandParam] -> [CommandParam]
forall a. a -> [a] -> [a]
: [CommandParam]
ps
runBorgParam (BorgRepoUsing [BorgRepoOpt]
os String
_) String
cmd [CommandParam]
ps = String -> CommandParam
Param String
cmd CommandParam -> [CommandParam] -> [CommandParam]
forall a. a -> [a] -> [a]
: ((BorgRepoOpt -> [CommandParam]) -> [BorgRepoOpt] -> [CommandParam]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BorgRepoOpt -> [CommandParam]
go [BorgRepoOpt]
os [CommandParam] -> [CommandParam] -> [CommandParam]
forall a. [a] -> [a] -> [a]
++ [CommandParam]
ps)
  where
	go :: BorgRepoOpt -> [CommandParam]
go (UseUmask FileMode
i) = [String -> CommandParam
Param String
"--umask", String -> CommandParam
Param (FileMode -> (Int -> Char) -> FileMode -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase FileMode
8 Int -> Char
intToDigit FileMode
i String
"")]
	go BorgRepoOpt
_ = []

runBorgEnv :: BorgRepo -> [(String, String)]
runBorgEnv :: BorgRepo -> [(String, String)]
runBorgEnv (BorgRepo String
_) = []
runBorgEnv (BorgRepoUsing [BorgRepoOpt]
os String
_) = (BorgRepoOpt -> Maybe (String, String))
-> [BorgRepoOpt] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BorgRepoOpt -> Maybe (String, String)
go [BorgRepoOpt]
os
  where
	go :: BorgRepoOpt -> Maybe (String, String)
go (UseSshKey String
k) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
"BORG_RSH", String
"ssh -i " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k)
	go (UsesEnvVar (String
k, String
v)) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
k, String
v)
	go BorgRepoOpt
_ = Maybe (String, String)
forall a. Maybe a
Nothing

installed :: Property DebianLike
installed :: Property DebianLike
installed = Property (MetaTypes '[ 'Targeting 'OSDebian])
-> Property DebianLike -> Property DebianLike
forall k ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
 DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
 SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
pickOS Property (MetaTypes '[ 'Targeting 'OSDebian])
installdebian Property DebianLike
aptinstall
  where
	installdebian :: Property Debian
	installdebian :: Property (MetaTypes '[ 'Targeting 'OSDebian])
installdebian = String
-> (OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes '[ 'Targeting 'OSDebian])
forall k (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS String
desc ((OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
  -> Maybe System -> Propellor Result)
 -> Property (MetaTypes '[ 'Targeting 'OSDebian]))
-> (OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes '[ 'Targeting 'OSDebian])
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w Maybe System
o -> case Maybe System
o of
		(Just (System (Debian DebianKernel
_ (Stable String
"jessie")) Architecture
_)) -> OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
-> Property (MetaTypes '[ 'Targeting 'OSDebian])
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w (Property (MetaTypes '[ 'Targeting 'OSDebian]) -> Propellor Result)
-> Property (MetaTypes '[ 'Targeting 'OSDebian])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$
			[String] -> Property (MetaTypes '[ 'Targeting 'OSDebian])
Apt.backportInstalled [String
"borgbackup", String
"python3-msgpack"]
		Maybe System
_ -> OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
w (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
			[String] -> Property DebianLike
Apt.installed [String
"borgbackup"]
	aptinstall :: Property DebianLike
aptinstall = [String] -> Property DebianLike
Apt.installed [String
"borgbackup"] Property DebianLike -> String -> Property DebianLike
forall p. IsProp p => p -> String -> p
`describe` String
desc
        desc :: String
desc = String
"installed borgbackup"

repoExists :: BorgRepo -> IO Bool
repoExists :: BorgRepo -> IO Bool
repoExists BorgRepo
repo = BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
runBorg BorgRepo
repo String
"list" [String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo)] Maybe String
forall a. Maybe a
Nothing

-- | Get the name of the latest archive.
latestArchive :: BorgRepo -> IO (Maybe String)
latestArchive :: BorgRepo -> IO (Maybe String)
latestArchive BorgRepo
repo = String -> Maybe String
getLatest (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BorgRepo -> String -> [CommandParam] -> IO String
readBorg BorgRepo
repo String
"list" [CommandParam]
listargs
  where
	getLatest :: String -> Maybe String
getLatest = [String] -> Maybe String
forall a. [a] -> Maybe a
maybeLast ([String] -> Maybe String)
-> (String -> [String]) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".checkpoint") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
	maybeLast :: [a] -> Maybe a
maybeLast [] = Maybe a
forall a. Maybe a
Nothing
	maybeLast [a]
ps = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
last [a]
ps
	listargs :: [CommandParam]
listargs =
		[ String -> CommandParam
Param String
"--short"
		, String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo)
		]

-- | Inits a new borg repository
init :: BorgRepo -> BorgEnc -> Property DebianLike
init :: BorgRepo -> BorgEnc -> Property DebianLike
init BorgRepo
repo BorgEnc
enc = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BorgRepo -> IO Bool
repoExists BorgRepo
repo)
	(String
-> [String] -> [(String, String)] -> UncheckedProperty UnixLike
cmdPropertyEnv String
"borg" [String]
initargs (BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo))
		Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	initargs :: [String]
initargs = [CommandParam] -> [String]
toCommand ([CommandParam] -> [String]) -> [CommandParam] -> [String]
forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"init"
		[ BorgEnc -> CommandParam
encParam BorgEnc
enc
		, String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo)
		]

-- | Restores a directory from a borg backup.
--
-- Only does anything if the directory does not exist, or exists,
-- but is completely empty.
--
-- The restore is performed atomically; restoring to a temp directory
-- and then moving it to the directory.
restored :: FilePath -> BorgRepo -> Property DebianLike
restored :: String -> BorgRepo -> Property DebianLike
restored String
dir BorgRepo
repo = Property DebianLike
go Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = String -> Propellor Result -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property (String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" restored by borg") (Propellor Result -> Property DebianLike)
-> Propellor Result -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (IO Bool -> Propellor Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
needsRestore)
		( do
			String -> Propellor ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage (String -> Propellor ()) -> String -> Propellor ()
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is empty/missing; restoring from backup ..."
			Maybe String
latest <- IO (Maybe String) -> Propellor (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BorgRepo -> IO (Maybe String)
latestArchive BorgRepo
repo)
			case Maybe String
latest of
				Maybe String
Nothing -> do
					String -> Propellor ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage (String -> Propellor ()) -> String -> Propellor ()
forall a b. (a -> b) -> a -> b
$ String
"no archive to extract"
					Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
				Just String
l -> IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Result
restore String
l)
		, Propellor Result
noChange
		)

	needsRestore :: IO Bool
needsRestore = String -> IO Bool
isUnpopulated String
dir

	restore :: String -> IO Result
	restore :: String -> IO Result
restore String
latest = String -> String -> (String -> IO Result) -> IO Result
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTmpDirIn (ShowS
takeDirectory String
dir) String
"borg-restore" ((String -> IO Result) -> IO Result)
-> (String -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \String
tmpdir -> do
		Bool
ok <- BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
runBorg BorgRepo
repo String
"extract"
			[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
latest) ]
			(String -> Maybe String
forall a. a -> Maybe a
Just String
tmpdir)
		let restoreddir :: String
restoreddir = String
tmpdir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir
		IO Bool -> (IO Result, IO Result) -> IO Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ok IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> String -> IO Bool
doesDirectoryExist String
restoreddir)
			( do
				IO (Either IOException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either IOException ()) -> IO ())
-> IO (Either IOException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectory String
dir
				String -> String -> IO ()
renameDirectory String
restoreddir String
dir
				Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
			, Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
			)

-- | Installs a cron job that causes a given directory to be backed
-- up, by running borg with some parameters.
--
-- If the directory does not exist, or exists but is completely empty,
-- this Property will immediately restore it from an existing backup.
--
-- So, this property can be used to deploy a directory of content
-- to a host, while also ensuring any changes made to it get backed up.
-- For example:
--
-- >	& Borg.backup "/srv/git"
-- >		(BorgRepo "root@myserver:/mnt/backup/git.borg") 
-- >		Cron.Daily
-- >		["--exclude=/srv/git/tobeignored"]
-- >		[Borg.KeepDays 7, Borg.KeepWeeks 4, Borg.KeepMonths 6, Borg.KeepYears 1]
--
-- Note that this property does not initialize the backup repository,
-- so that will need to be done once, before-hand.
--
-- Since borg uses a fair amount of system resources, only one borg
-- backup job will be run at a time. Other jobs will wait their turns to
-- run.
backup :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
backup :: String
-> BorgRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property DebianLike
backup String
dir BorgRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp = String
-> BorgRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property DebianLike
backup' String
dir BorgRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> BorgRepo -> Property DebianLike
restored String
dir BorgRepo
repo

-- | Does a backup, but does not automatically restore.
backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike
backup' :: String
-> BorgRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property DebianLike
backup' String
dir BorgRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp = Property DebianLike
cronjob
	Property DebianLike -> String -> Property DebianLike
forall p. IsProp p => p -> String -> p
`describe` String
desc
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	desc :: String
desc = BorgRepo -> String
repoLoc BorgRepo
repo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" borg backup"
	cronjob :: Property DebianLike
cronjob = String -> Times -> User -> String -> String -> Property DebianLike
Cron.niceJob (String
"borg_backup" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir) Times
crontimes (String -> User
User String
"root") String
"/" (String -> Property DebianLike) -> String -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
		String
"flock " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
lockfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" sh -c " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
backupcmd
	lockfile :: String
lockfile = String
"/var/lock/propellor-borg.lock"
	backupcmd :: String
backupcmd = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&&" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
		[ ((String, String) -> [String]) -> [(String, String)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> [String]
exportenv (BorgRepo -> [(String, String)]
runBorgEnv BorgRepo
repo)
		, [String
createCommand]
		, if [KeepPolicy] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KeepPolicy]
kp then [] else [String
pruneCommand]
		]
	exportenv :: (String, String) -> [String]
exportenv (String
k, String
v) = 
		[ String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
v
		, String
"export " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k
		]
	createCommand :: String
createCommand = [String] -> String
unwords (String
"borg" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
createCommandParams)
	createCommandParams :: [String]
createCommandParams = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
shellEscape ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [CommandParam] -> [String]
toCommand ([CommandParam] -> [String]) -> [CommandParam] -> [String]
forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"create" ([CommandParam] -> [CommandParam])
-> [CommandParam] -> [CommandParam]
forall a b. (a -> b) -> a -> b
$
		[ String -> CommandParam
Param String
"--stats" ]
		[CommandParam] -> [CommandParam] -> [CommandParam]
forall a. [a] -> [a] -> [a]
++ (String -> CommandParam) -> [String] -> [CommandParam]
forall a b. (a -> b) -> [a] -> [b]
map String -> CommandParam
Param [String]
extraargs [CommandParam] -> [CommandParam] -> [CommandParam]
forall a. [a] -> [a] -> [a]
++
		[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::{now}")
		, String -> CommandParam
File String
dir
		]
	pruneCommand :: String
pruneCommand = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
"borg" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
pruneCommandParams)
	pruneCommandParams :: [String]
pruneCommandParams = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
shellEscape ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [CommandParam] -> [String]
toCommand ([CommandParam] -> [String]) -> [CommandParam] -> [String]
forall a b. (a -> b) -> a -> b
$ BorgRepo -> String -> [CommandParam] -> [CommandParam]
runBorgParam BorgRepo
repo String
"prune" ([CommandParam] -> [CommandParam])
-> [CommandParam] -> [CommandParam]
forall a b. (a -> b) -> a -> b
$
		[ String -> CommandParam
Param (BorgRepo -> String
repoLoc BorgRepo
repo) ]
		[CommandParam] -> [CommandParam] -> [CommandParam]
forall a. [a] -> [a] -> [a]
++ (KeepPolicy -> CommandParam) -> [KeepPolicy] -> [CommandParam]
forall a b. (a -> b) -> [a] -> [b]
map KeepPolicy -> CommandParam
keepParam [KeepPolicy]
kp

-- | Constructs an BorgParam that specifies which old backup generations to
-- keep. By default, all generations are kept. However, when this parameter is
-- passed to the `backup` property, it will run borg prune to clean out
-- generations not specified here.
keepParam :: KeepPolicy -> CommandParam
keepParam :: KeepPolicy -> CommandParam
keepParam (KeepHours Int
n) = String -> CommandParam
Param (String
"--keep-hourly=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepDays Int
n) = String -> CommandParam
Param (String
"--keep-daily=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepWeeks Int
n) = String -> CommandParam
Param (String
"--keep-daily=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepMonths Int
n) = String -> CommandParam
Param (String
"--keep-monthly=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. ConfigurableValue t => t -> String
val Int
n)
keepParam (KeepYears Int
n) = String -> CommandParam
Param (String
"--keep-yearly=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. ConfigurableValue t => t -> String
val Int
n)

-- | Policy for backup generations to keep. For example, KeepDays 30 will
-- keep the latest backup for each day when a backup was made, and keep the
-- last 30 such backups. When multiple KeepPolicies are combined together,
-- backups meeting any policy are kept. See borg's man page for details.
data KeepPolicy
	= KeepHours Int
	| KeepDays Int
	| KeepWeeks Int
	| KeepMonths Int
	| KeepYears Int

-- | Construct the encryption type parameter.
encParam :: BorgEnc -> CommandParam
encParam :: BorgEnc -> CommandParam
encParam BorgEnc
BorgEncNone = String -> CommandParam
Param String
"--encryption=none"
encParam BorgEnc
BorgEncAuthenticated = String -> CommandParam
Param String
"--encryption=authenticated"
encParam BorgEnc
BorgEncAuthenticatedBlake2 = String -> CommandParam
Param String
"--encryption=authenticated-blake2"
encParam BorgEnc
BorgEncRepokey = String -> CommandParam
Param String
"--encryption=repokey"
encParam BorgEnc
BorgEncRepokeyBlake2 = String -> CommandParam
Param String
"--encryption=repokey-blake2"
encParam BorgEnc
BorgEncKeyfile = String -> CommandParam
Param String
"--encryption=keyfile"
encParam BorgEnc
BorgEncKeyfileBlake2 = String -> CommandParam
Param String
"--encryption=keyfile-blake2"