-- | Support for the Obnam backup tool <http://obnam.org/>
--
-- This module is deprecated because Obnam has been retired by its
-- author.

module Propellor.Property.Obnam {-# DEPRECATED "Obnam has been retired; time to transition to something else" #-} where

import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cron as Cron
import qualified Propellor.Property.Gpg as Gpg

import Data.List

type ObnamParam = String

-- | An obnam repository can be used by multiple clients. Obnam uses
-- locking to allow only one client to write at a time. Since stale lock
-- files can prevent backups from happening, it's more robust, if you know
-- a repository has only one client, to force the lock before starting a
-- backup. Using OnlyClient allows propellor to do so when running obnam.
data NumClients = OnlyClient | MultipleClients
	deriving (NumClients -> NumClients -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumClients -> NumClients -> Bool
$c/= :: NumClients -> NumClients -> Bool
== :: NumClients -> NumClients -> Bool
$c== :: NumClients -> NumClients -> Bool
Eq)

-- | Installs a cron job that causes a given directory to be backed
-- up, by running obnam 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: 
--
-- >	& Obnam.backup "/srv/git" "33 3 * * *"
-- >		[ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam"
-- >		] Obnam.OnlyClient
-- >		`requires` Ssh.keyImported SshEd25519 "root" (Context hostname)
--
-- How awesome is that?
--
-- Note that this property does not make obnam encrypt the backup
-- repository.
--
-- Since obnam uses a fair amount of system resources, only one obnam
-- backup job will be run at a time. Other jobs will wait their turns to
-- run.
backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
backup :: FilePath
-> Times -> [FilePath] -> NumClients -> Property DebianLike
backup FilePath
dir Times
crontimes [FilePath]
params NumClients
numclients =
	FilePath
-> Times -> [FilePath] -> NumClients -> Property DebianLike
backup' FilePath
dir Times
crontimes [FilePath]
params NumClients
numclients
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` FilePath -> [FilePath] -> Property DebianLike
restored FilePath
dir [FilePath]
params

-- | Like backup, but the specified gpg key id is used to encrypt
-- the repository.
--
-- The gpg secret key will be automatically imported
-- into root's keyring using Propellor.Property.Gpg.keyImported
backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property (HasInfo + DebianLike)
backupEncrypted :: FilePath
-> Times
-> [FilePath]
-> NumClients
-> GpgKeyId
-> Property (HasInfo + DebianLike)
backupEncrypted FilePath
dir Times
crontimes [FilePath]
params NumClients
numclients GpgKeyId
keyid =
	FilePath
-> Times -> [FilePath] -> NumClients -> Property DebianLike
backup FilePath
dir Times
crontimes [FilePath]
params' NumClients
numclients
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` GpgKeyId -> User -> Property (HasInfo + DebianLike)
Gpg.keyImported GpgKeyId
keyid (FilePath -> User
User FilePath
"root")
  where
	params' :: [FilePath]
params' = (FilePath
"--encrypt-with=" forall a. [a] -> [a] -> [a]
++ GpgKeyId -> FilePath
Gpg.getGpgKeyId GpgKeyId
keyid) forall a. a -> [a] -> [a]
: [FilePath]
params

-- | Does a backup, but does not automatically restore.
backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property DebianLike
backup' :: FilePath
-> Times -> [FilePath] -> NumClients -> Property DebianLike
backup' FilePath
dir Times
crontimes [FilePath]
params NumClients
numclients = Property DebianLike
cronjob forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
desc
  where
	desc :: FilePath
desc = FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
" backed up by obnam"
	cronjob :: Property DebianLike
cronjob = FilePath
-> Times -> User -> FilePath -> FilePath -> Property DebianLike
Cron.niceJob (FilePath
"obnam_backup" forall a. [a] -> [a] -> [a]
++ FilePath
dir) Times
crontimes (FilePath -> User
User FilePath
"root") FilePath
"/" forall a b. (a -> b) -> a -> b
$
		FilePath
"flock " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
lockfile forall a. [a] -> [a] -> [a]
++ FilePath
" sh -c " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
cmdline
	lockfile :: FilePath
lockfile = FilePath
"/var/lock/propellor-obnam.lock"
	cmdline :: FilePath
cmdline = [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
		[ if NumClients
numclients forall a. Eq a => a -> a -> Bool
== NumClients
OnlyClient
			-- forcelock fails if repo does not exist yet
			then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
forcelockcmd forall a. [a] -> [a] -> [a]
++ FilePath
" 2>/dev/null ;"
			else forall a. Maybe a
Nothing
		, forall a. a -> Maybe a
Just FilePath
backupcmd
		, if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
isKeepParam [FilePath]
params
			then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
"&& " forall a. [a] -> [a] -> [a]
++ FilePath
forgetcmd
			else forall a. Maybe a
Nothing
		]
	forcelockcmd :: FilePath
forcelockcmd = [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$
		[ FilePath
"obnam"
		, FilePath
"force-lock"
		] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
shellEscape [FilePath]
params
	backupcmd :: FilePath
backupcmd = [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$
		[ FilePath
"obnam"
		, FilePath
"backup"
		, FilePath -> FilePath
shellEscape FilePath
dir
		] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
shellEscape [FilePath]
params
	forgetcmd :: FilePath
forgetcmd = [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$
		[ FilePath
"obnam"
		, FilePath
"forget"
		] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
shellEscape [FilePath]
params

-- | Restores a directory from an obnam 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 -> [ObnamParam] -> Property DebianLike
restored :: FilePath -> [FilePath] -> Property DebianLike
restored FilePath
dir [FilePath]
params = Property DebianLike
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	desc :: FilePath
desc = FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
" restored by obnam"
	go :: Property DebianLike
	go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
desc 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 => FilePath -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
" 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 = FilePath -> IO Bool
isUnpopulated FilePath
dir

	restore :: IO Result
restore = forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTmpDirIn (FilePath -> FilePath
takeDirectory FilePath
dir) FilePath
"obnam-restore" forall a b. (a -> b) -> a -> b
$ \FilePath
tmpdir -> do
		Bool
ok <- FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"obnam" forall a b. (a -> b) -> a -> b
$
			[ FilePath -> CommandParam
Param FilePath
"restore"
			, FilePath -> CommandParam
Param FilePath
"--to"
			, FilePath -> CommandParam
Param FilePath
tmpdir
			] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> CommandParam
Param [FilePath]
params
		let restoreddir :: FilePath
restoreddir = FilePath
tmpdir forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ FilePath
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
<&&> FilePath -> IO Bool
doesDirectoryExist FilePath
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
$ FilePath -> IO ()
removeDirectory FilePath
dir
				FilePath -> FilePath -> IO ()
renameDirectory FilePath
restoreddir FilePath
dir
				forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
			, forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
			)

-- | 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 obnam's man page for details.
data KeepPolicy 
	= KeepHours Int
	| KeepDays Int
	| KeepWeeks Int
	| KeepMonths Int
	| KeepYears Int

-- | Constructs an ObnamParam that specifies which old backup generations
-- to keep. By default, all generations are kept. However, when this parameter
-- is passed to the `backup` or `backupEncrypted` properties, they will run
-- obnam forget to clean out generations not specified here.
keepParam :: [KeepPolicy] -> ObnamParam
keepParam :: [KeepPolicy] -> FilePath
keepParam [KeepPolicy]
ps = FilePath
"--keep=" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," (forall a b. (a -> b) -> [a] -> [b]
map KeepPolicy -> FilePath
go [KeepPolicy]
ps)
  where
	go :: KeepPolicy -> FilePath
go (KeepHours Int
n) = forall {t}. ConfigurableValue t => t -> Char -> FilePath
mk Int
n Char
'h'
	go (KeepDays Int
n) = forall {t}. ConfigurableValue t => t -> Char -> FilePath
mk Int
n Char
'd'
	go (KeepWeeks Int
n) = forall {t}. ConfigurableValue t => t -> Char -> FilePath
mk Int
n Char
'w'
	go (KeepMonths Int
n) = forall {t}. ConfigurableValue t => t -> Char -> FilePath
mk Int
n Char
'm'
	go (KeepYears Int
n) = forall {t}. ConfigurableValue t => t -> Char -> FilePath
mk Int
n Char
'y'
	mk :: t -> Char -> FilePath
mk t
n Char
c = forall t. ConfigurableValue t => t -> FilePath
val t
n forall a. [a] -> [a] -> [a]
++ [Char
c]

isKeepParam :: ObnamParam -> Bool
isKeepParam :: FilePath -> Bool
isKeepParam FilePath
p = FilePath
"--keep=" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
p

installed :: Property DebianLike
installed :: Property DebianLike
installed = [FilePath] -> Property DebianLike
Apt.installed [FilePath
"obnam"]