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

module Propellor.Property.Restic
	( ResticRepo (..)
	, installed
	, repoExists
	, init
	, restored
	, backup
	, 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 qualified Propellor.Property.File as File
import Data.List (intercalate)

type Url = String

type ResticParam = String

data ResticRepo
	= Direct FilePath
	| SFTP User HostName FilePath
	| REST Url

instance ConfigurableValue ResticRepo where
	val :: ResticRepo -> String
val (Direct String
fp) = String
fp
	val (SFTP User
u String
h String
fp) = String
"sftp:" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val User
u forall a. [a] -> [a] -> [a]
++ String
"@" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val String
h forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ String
fp
	val (REST String
url) = String
"rest:" forall a. [a] -> [a] -> [a]
++ String
url

installed :: Property DebianLike
installed :: Property DebianLike
installed = [String] -> Property DebianLike
Apt.installed [String
"restic"] forall p. IsProp p => p -> String -> p
`describe` String
"installed restic"

repoExists :: ResticRepo -> IO Bool
repoExists :: ResticRepo -> IO Bool
repoExists ResticRepo
repo = String -> [CommandParam] -> IO Bool
boolSystem String
"restic"
	[ String -> CommandParam
Param String
"-r"
	, String -> CommandParam
File (forall t. ConfigurableValue t => t -> String
val ResticRepo
repo)
	, String -> CommandParam
Param String
"--password-file"
	, String -> CommandParam
File (ResticRepo -> String
getPasswordFile ResticRepo
repo)
	, String -> CommandParam
Param String
"snapshots"
	]

passwordFileDir :: FilePath
passwordFileDir :: String
passwordFileDir = String
"/etc/restic-keys"

getPasswordFile :: ResticRepo -> FilePath
getPasswordFile :: ResticRepo -> String
getPasswordFile ResticRepo
repo = String
passwordFileDir String -> String -> String
</> String -> String
File.configFileName (forall t. ConfigurableValue t => t -> String
val ResticRepo
repo)

passwordFileConfigured :: ResticRepo -> Property (HasInfo + UnixLike)
passwordFileConfigured :: ResticRepo -> Property (HasInfo + UnixLike)
passwordFileConfigured ResticRepo
repo = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList String
"restic password file" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
	forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property UnixLike
File.dirExists String
passwordFileDir
	forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> FileMode -> Property UnixLike
File.mode String
passwordFileDir FileMode
0O2700
	forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& ResticRepo -> String
getPasswordFile ResticRepo
repo forall c.
IsContext c =>
String -> c -> Property (HasInfo + UnixLike)
`File.hasPrivContent` HostContext
hostContext

-- | Inits a new restic repository
init :: ResticRepo -> Property (HasInfo + DebianLike)
init :: ResticRepo -> Property (HasInfo + DebianLike)
init ResticRepo
repo = 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
<$> ResticRepo -> IO Bool
repoExists ResticRepo
repo) (String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"restic" [String]
initargs)
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` ResticRepo -> Property (HasInfo + UnixLike)
passwordFileConfigured ResticRepo
repo
  where
	initargs :: [String]
initargs =
		[ String
"-r"
		, forall t. ConfigurableValue t => t -> String
val ResticRepo
repo
		, String
"--password-file"
		, ResticRepo -> String
getPasswordFile ResticRepo
repo
		, String
"init"
		]

-- | Restores a directory from a restic 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 -> ResticRepo -> Property (HasInfo + DebianLike)
restored :: String -> ResticRepo -> Property (HasInfo + DebianLike)
restored String
dir ResticRepo
repo = Property DebianLike
go
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` ResticRepo -> Property (HasInfo + DebianLike)
init ResticRepo
repo
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property (String
dir forall a. [a] -> [a] -> [a]
++ String
" restored by restic") 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 => String -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ String
dir forall a. [a] -> [a] -> [a]
++ String
" 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 = String -> IO Bool
isUnpopulated String
dir

	restore :: IO Result
restore = forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTmpDirIn (String -> String
takeDirectory String
dir) String
"restic-restore" forall a b. (a -> b) -> a -> b
$ \String
tmpdir -> do
		Bool
ok <- String -> [CommandParam] -> IO Bool
boolSystem String
"restic"
			[ String -> CommandParam
Param String
"-r"
			, String -> CommandParam
File (forall t. ConfigurableValue t => t -> String
val ResticRepo
repo)
			, String -> CommandParam
Param String
"--password-file"
			, String -> CommandParam
File (ResticRepo -> String
getPasswordFile ResticRepo
repo)
			, String -> CommandParam
Param String
"restore"
			, String -> CommandParam
Param String
"latest"
			, String -> CommandParam
Param String
"--target"
			, String -> CommandParam
File String
tmpdir
			]
		let restoreddir :: String
restoreddir = String
tmpdir forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
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
<&&> String -> IO Bool
doesDirectoryExist String
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
$ String -> IO ()
removeDirectory String
dir
				String -> String -> IO ()
renameDirectory String
restoreddir String
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 restic 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:
--
-- >	& Restic.backup "/srv/git"
-- >		(Restic.SFTP (User root) (HostName myserver) /mnt/backup/git.restic")
-- >		Cron.Daily
-- >		["--exclude=/srv/git/tobeignored"]
-- >		[Restic.KeepDays 7, Restic.KeepWeeks 4, Restic.KeepMonths 6, Restic.KeepYears 1]
--
-- Since restic uses a fair amount of system resources, only one restic
-- backup job will be run at a time. Other jobs will wait their turns to
-- run.
backup :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)
backup :: String
-> ResticRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property (HasInfo + DebianLike)
backup String
dir ResticRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp = [String]
-> ResticRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property (HasInfo + DebianLike)
backup' [String
dir] ResticRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> ResticRepo -> Property (HasInfo + DebianLike)
restored String
dir ResticRepo
repo

-- | Does a backup, but does not automatically restore.
backup' :: [FilePath] -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)
backup' :: [String]
-> ResticRepo
-> Times
-> [String]
-> [KeepPolicy]
-> Property (HasInfo + DebianLike)
backup' [String]
dirs ResticRepo
repo Times
crontimes [String]
extraargs [KeepPolicy]
kp = Property DebianLike
cronjob
	forall p. IsProp p => p -> String -> p
`describe` String
desc
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` ResticRepo -> Property (HasInfo + DebianLike)
init ResticRepo
repo
  where
	desc :: String
desc = forall t. ConfigurableValue t => t -> String
val ResticRepo
repo forall a. [a] -> [a] -> [a]
++ String
" restic backup"
	cronjob :: Property DebianLike
cronjob = String -> Times -> User -> String -> String -> Property DebianLike
Cron.niceJob (String
"restic_backup" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"_" [String]
dirs) Times
crontimes (String -> User
User String
"root") String
"/" forall a b. (a -> b) -> a -> b
$
		String
"flock " forall a. [a] -> [a] -> [a]
++ String -> String
shellEscape String
lockfile forall a. [a] -> [a] -> [a]
++ String
" sh -c " forall a. [a] -> [a] -> [a]
++ String -> String
shellEscape String
backupcmd
	lockfile :: String
lockfile = String
"/var/lock/propellor-restic.lock"
	backupcmd :: String
backupcmd = forall a. [a] -> [[a]] -> [a]
intercalate String
" && " forall a b. (a -> b) -> a -> b
$
		String
createCommand
		forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KeepPolicy]
kp then [] else [String
pruneCommand]
	createCommand :: String
createCommand = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$
		[ String
"restic"
		, String
"-r"
		, String -> String
shellEscape (forall t. ConfigurableValue t => t -> String
val ResticRepo
repo)
		, String
"--password-file"
		, String -> String
shellEscape (ResticRepo -> String
getPasswordFile ResticRepo
repo)
		]
		forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> String
shellEscape [String]
extraargs forall a. [a] -> [a] -> [a]
++
		[ String
"backup" ]
		forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> String
shellEscape [String]
dirs
	pruneCommand :: String
pruneCommand = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$
		[ String
"restic"
		, String
"-r"
		, String -> String
shellEscape (forall t. ConfigurableValue t => t -> String
val ResticRepo
repo)
		, String
"--password-file"
		, String -> String
shellEscape (ResticRepo -> String
getPasswordFile ResticRepo
repo)
		, String
"forget"
		, String
"--prune"
		]
		forall a. [a] -> [a] -> [a]
++
		forall a b. (a -> b) -> [a] -> [b]
map KeepPolicy -> String
keepParam [KeepPolicy]
kp

-- | Constructs a ResticParam 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 restic prune to clean out
-- generations not specified here.
keepParam :: KeepPolicy -> ResticParam
keepParam :: KeepPolicy -> String
keepParam (KeepLast Int
n) = String
"--keep-last=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n
keepParam (KeepHours Int
n) = String
"--keep-hourly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n
keepParam (KeepDays Int
n) = String
"--keep-daily=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n
keepParam (KeepWeeks Int
n) = String
"--keep-weekly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n
keepParam (KeepMonths Int
n) = String
"--keep-monthly=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Int
n
keepParam (KeepYears Int
n) = String
"--keep-yearly=" forall a. [a] -> [a] -> [a]
++ 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 restic's man page for details.
data KeepPolicy
	= KeepLast Int
	| KeepHours Int
	| KeepDays Int
	| KeepWeeks Int
	| KeepMonths Int
	| KeepYears Int