-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
--
-- Support for the Attic backup tool <https://attic-backup.org/>
--
-- This module is deprecated because Attic is not available in debian
-- stable any longer (so the installed property no longer works), and it
-- appears to have been mostly supersceded by Borg.

module Propellor.Property.Attic {-# DEPRECATED "Use Borg instead" #-}
	( installed
	, repoExists
	, init
	, restored
	, backup
	, KeepPolicy (..)
	) where

import Propellor.Base hiding (init)
import Prelude hiding (init)
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
import Data.List (intercalate)

type AtticParam = String

type AtticRepo = FilePath

installed :: Property DebianLike
installed :: Property DebianLike
installed = [Package] -> Property DebianLike
Apt.installed [Package
"attic"]

repoExists :: AtticRepo -> IO Bool
repoExists :: Package -> IO Bool
repoExists Package
repo = Package -> [CommandParam] -> IO Bool
boolSystem Package
"attic" [Package -> CommandParam
Param Package
"list", Package -> CommandParam
File Package
repo]

-- | Inits a new attic repository
init :: AtticRepo -> Property DebianLike
init :: Package -> Property DebianLike
init Package
backupdir = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> IO Bool
repoExists Package
backupdir) (Package -> [Package] -> UncheckedProperty UnixLike
cmdProperty Package
"attic" [Package]
initargs)
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	initargs :: [Package]
initargs =
		[ Package
"init"
		, Package
backupdir
		]

-- | Restores a directory from an attic 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 -> AtticRepo -> Property DebianLike
restored :: Package -> Package -> Property DebianLike
restored Package
dir Package
backupdir = Property DebianLike
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
Package -> Propellor Result -> Property (MetaTypes metatypes)
property (Package
dir forall a. [a] -> [a] -> [a]
++ Package
" restored by attic") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
needsRestore)
		( do
			forall (m :: * -> *). MonadIO m => Package -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ Package
dir forall a. [a] -> [a] -> [a]
++ Package
" is empty/missing; restoring from backup ..."
			forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Result
restore
		, Propellor Result
noChange
		)

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

	restore :: IO Result
restore = forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
Package -> Package -> (Package -> m a) -> m a
withTmpDirIn (Package -> Package
takeDirectory Package
dir) Package
"attic-restore" forall a b. (a -> b) -> a -> b
$ \Package
tmpdir -> do
		Bool
ok <- Package -> [CommandParam] -> IO Bool
boolSystem Package
"attic" forall a b. (a -> b) -> a -> b
$
			[ Package -> CommandParam
Param Package
"extract"
			, Package -> CommandParam
Param Package
backupdir
			, Package -> CommandParam
Param Package
tmpdir
			]
		let restoreddir :: Package
restoreddir = Package
tmpdir forall a. [a] -> [a] -> [a]
++ Package
"/" forall a. [a] -> [a] -> [a]
++ Package
dir
		forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
ok forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Package -> IO Bool
doesDirectoryExist Package
restoreddir)
			( do
				forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ Package -> IO ()
removeDirectory Package
dir
				Package -> Package -> IO ()
renameDirectory Package
restoreddir Package
dir
				forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
			, 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 attic 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:
--
-- >	& Attic.backup "/srv/git" "root@myserver:/mnt/backup/git.attic" Cron.Daily
-- >		["--exclude=/srv/git/tobeignored"]
-- >		[Attic.KeepDays 7, Attic.KeepWeeks 4, Attic.KeepMonths 6, Attic.KeepYears 1]
--
-- Note that this property does not make attic encrypt the backup
-- repository.
--
-- Since attic uses a fair amount of system resources, only one attic
-- backup job will be run at a time. Other jobs will wait their turns to
-- run.
backup :: FilePath -> AtticRepo -> Cron.Times -> [AtticParam] -> [KeepPolicy] -> Property DebianLike
backup :: Package
-> Package
-> Times
-> [Package]
-> [KeepPolicy]
-> Property DebianLike
backup Package
dir Package
backupdir Times
crontimes [Package]
extraargs [KeepPolicy]
kp = Package
-> Package
-> Times
-> [Package]
-> [KeepPolicy]
-> Property DebianLike
backup' Package
dir Package
backupdir Times
crontimes [Package]
extraargs [KeepPolicy]
kp
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Package -> Package -> Property DebianLike
restored Package
dir Package
backupdir

-- | Does a backup, but does not automatically restore.
backup' :: FilePath -> AtticRepo -> Cron.Times -> [AtticParam] -> [KeepPolicy] -> Property DebianLike
backup' :: Package
-> Package
-> Times
-> [Package]
-> [KeepPolicy]
-> Property DebianLike
backup' Package
dir Package
backupdir Times
crontimes [Package]
extraargs [KeepPolicy]
kp = Property DebianLike
cronjob
	forall p. IsProp p => p -> Package -> p
`describe` Package
desc
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	desc :: Package
desc = Package
backupdir forall a. [a] -> [a] -> [a]
++ Package
" attic backup"
	cronjob :: Property DebianLike
cronjob = Package
-> Times -> User -> Package -> Package -> Property DebianLike
Cron.niceJob (Package
"attic_backup" forall a. [a] -> [a] -> [a]
++ Package
dir) Times
crontimes (Package -> User
User Package
"root") Package
"/" forall a b. (a -> b) -> a -> b
$
		Package
"flock " forall a. [a] -> [a] -> [a]
++ Package -> Package
shellEscape Package
lockfile forall a. [a] -> [a] -> [a]
++ Package
" sh -c " forall a. [a] -> [a] -> [a]
++ Package -> Package
shellEscape Package
backupcmd
	lockfile :: Package
lockfile = Package
"/var/lock/propellor-attic.lock"
	backupcmd :: Package
backupcmd = forall a. [a] -> [[a]] -> [a]
intercalate Package
";" forall a b. (a -> b) -> a -> b
$
		Package
createCommand
		forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KeepPolicy]
kp then [] else [Package
pruneCommand]
	createCommand :: Package
createCommand = [Package] -> Package
unwords forall a b. (a -> b) -> a -> b
$
		[ Package
"attic"
		, Package
"create"
		, Package
"--stats"
		]
		forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Package -> Package
shellEscape [Package]
extraargs forall a. [a] -> [a] -> [a]
++
		[ Package -> Package
shellEscape Package
backupdir forall a. [a] -> [a] -> [a]
++ Package
"::" forall a. [a] -> [a] -> [a]
++ Package
"$(date --iso-8601=ns --utc)"
		, Package -> Package
shellEscape Package
dir
		]
	pruneCommand :: Package
pruneCommand = [Package] -> Package
unwords forall a b. (a -> b) -> a -> b
$
		[ Package
"attic"
		, Package
"prune"
		, Package -> Package
shellEscape Package
backupdir
		]
		forall a. [a] -> [a] -> [a]
++
		forall a b. (a -> b) -> [a] -> [b]
map KeepPolicy -> Package
keepParam [KeepPolicy]
kp

-- | Constructs an AtticParam that specifies which old backup generations to
-- keep. By default, all generations are kept. However, when this parameter is
-- passed to the `backup` property, they will run attic prune to clean out
-- generations not specified here.
keepParam :: KeepPolicy -> AtticParam
keepParam :: KeepPolicy -> Package
keepParam (KeepHours Int
n) = Package
"--keep-hourly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Package
val Int
n
keepParam (KeepDays Int
n) = Package
"--keep-daily=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Package
val Int
n
keepParam (KeepWeeks Int
n) = Package
"--keep-daily=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Package
val Int
n
keepParam (KeepMonths Int
n) = Package
"--keep-monthly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Package
val Int
n
keepParam (KeepYears Int
n) = Package
"--keep-yearly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Package
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 attic's man page for details.
data KeepPolicy
	= KeepHours Int
	| KeepDays Int
	| KeepWeeks Int
	| KeepMonths Int
	| KeepYears Int