    -- | 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 s :: String
    s) = String
    s
    repoLoc (BorgRepoUsing _ s :: String
    s) = String
    s

    runBorg :: BorgRepo -> BorgCommand -> [CommandParam] -> Maybe FilePath -> IO Bool
    runBorg :: BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
    runBorg repo :: BorgRepo
    repo cmd :: String
    cmd ps :: [CommandParam]
    ps chdir :: 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
    	environ :: [(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' environ :: Maybe [(String, String)]
    environ = String
    -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
    boolSystem' "borg" [CommandParam]
    params ((CreateProcess -> CreateProcess) -> IO Bool)
    -> (CreateProcess -> CreateProcess) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    		\p :: 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 repo :: BorgRepo
    repo cmd :: String
    cmd ps :: [CommandParam]
    ps = case BorgRepo -> [(String, String)]
    runBorgEnv BorgRepo
    repo of
    	[] -> String -> [String] -> IO String
    readProcess "borg" [String]
    params
    	environ :: [(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 "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 _) cmd :: String
    cmd ps :: [CommandParam]
    ps = String -> CommandParam
    Param String
    cmd CommandParam -> [CommandParam] -> [CommandParam]
    forall a. a -> [a] -> [a]
    : [CommandParam]
    ps
    runBorgParam (BorgRepoUsing os :: [BorgRepoOpt]
    os _) cmd :: String
    cmd ps :: [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 i :: FileMode
    i) = [String -> CommandParam
    Param "--umask", String -> CommandParam
    Param (FileMode -> (Int -> Char) -> FileMode -> ShowS
    forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
    showIntAtBase 8 Int -> Char
    intToDigit FileMode
    i "")]
    	go _ = []

    runBorgEnv :: BorgRepo -> [(String, String)]
    runBorgEnv :: BorgRepo -> [(String, String)]
    runBorgEnv (BorgRepo _) = []
    runBorgEnv (BorgRepoUsing os :: [BorgRepoOpt]
    os _) = (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 k :: String
    k) = (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just ("BORG_RSH", "ssh -i " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    k)
    	go (UsesEnvVar (k :: String
    k, v :: String
    v)) = (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    k, String
    v)
    	go _ = 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
    $ \w :: OuterMetaTypesWitness '[ 'Targeting 'OSDebian]
    w o :: Maybe System
    o -> case Maybe System
    o of
    		(Just (System (Debian _ (Stable "jessie")) _)) -> 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 ["borgbackup", "python3-msgpack"]
    		_ -> 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 ["borgbackup"]
    	aptinstall :: Property DebianLike
    aptinstall = [String] -> Property DebianLike
    Apt.installed ["borgbackup"] Property DebianLike -> String -> Property DebianLike
    forall p. IsProp p => p -> String -> p
    `describe` String
    desc
            desc :: String
    desc = "installed borgbackup"

    repoExists :: BorgRepo -> IO Bool
    repoExists :: BorgRepo -> IO Bool
    repoExists repo :: BorgRepo
    repo = BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
    runBorg BorgRepo
    repo "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 repo :: 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 "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 ".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 ps :: [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 "--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 repo :: BorgRepo
    repo enc :: 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 "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 "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 dir :: String
    dir repo :: 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]
    ++ " 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]
    ++ " 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
    				Nothing -> do
    					String -> Propellor ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    warningMessage (String -> Propellor ()) -> String -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ "no archive to extract"
    					Result -> Propellor Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange
    				Just l :: 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 latest :: 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) "borg-restore" ((String -> IO Result) -> IO Result)
    -> (String -> IO Result) -> IO Result
    forall a b. (a -> b) -> a -> b
    $ \tmpdir :: String
    tmpdir -> do
    		Bool
    ok <- BorgRepo -> String -> [CommandParam] -> Maybe String -> IO Bool
    runBorg BorgRepo
    repo "extract"
    			[ String -> CommandParam
    Param (BorgRepo -> String
    repoLoc BorgRepo
    repo String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "::" 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 -> 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 dir :: String
    dir repo :: BorgRepo
    repo crontimes :: Times
    crontimes extraargs :: [String]
    extraargs kp :: [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' dir :: String
    dir repo :: BorgRepo
    repo crontimes :: Times
    crontimes extraargs :: [String]
    extraargs kp :: [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]
    ++ " borg backup"
    	cronjob :: Property DebianLike
    cronjob = String -> Times -> User -> String -> String -> Property DebianLike
    Cron.niceJob ("borg_backup" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    dir) Times
    crontimes (String -> User
    User "root") "/" (String -> Property DebianLike) -> String -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $
    		"flock " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    shellEscape String
    lockfile String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " sh -c " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    shellEscape String
    backupcmd
    	lockfile :: String
    lockfile = "/var/lock/propellor-borg.lock"
    	backupcmd :: String
    backupcmd = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "&&" ([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 (k :: String
    k, v :: String
    v) =
    		[ String
    k String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    shellEscape String
    v
    		, "export " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    k
    		]
    	createCommand :: String
    createCommand = [String] -> String
    unwords ("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 "create" ([CommandParam] -> [CommandParam])
    -> [CommandParam] -> [CommandParam]
    forall a b. (a -> b) -> a -> b
    $
    		[ String -> CommandParam
    Param "--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]
    ++ "::{now}")
    		, String -> CommandParam
    File String
    dir
    		]
    	pruneCommand :: String
    pruneCommand = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ ("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 "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 n :: Int
    n) = String -> CommandParam
    Param ("--keep-hourly=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall t. ConfigurableValue t => t -> String
    val Int
    n)
    keepParam (KeepDays n :: Int
    n) = String -> CommandParam
    Param ("--keep-daily=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall t. ConfigurableValue t => t -> String
    val Int
    n)
    keepParam (KeepWeeks n :: Int
    n) = String -> CommandParam
    Param ("--keep-daily=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall t. ConfigurableValue t => t -> String
    val Int
    n)
    keepParam (KeepMonths n :: Int
    n) = String -> CommandParam
    Param ("--keep-monthly=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall t. ConfigurableValue t => t -> String
    val Int
    n)
    keepParam (KeepYears n :: Int
    n) = String -> CommandParam
    Param ("--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 BorgEncNone = String -> CommandParam
    Param "--encryption=none"
    encParam BorgEncAuthenticated = String -> CommandParam
    Param "--encryption=authenticated"
    encParam BorgEncAuthenticatedBlake2 = String -> CommandParam
    Param "--encryption=authenticated-blake2"
    encParam BorgEncRepokey = String -> CommandParam
    Param "--encryption=repokey"
    encParam BorgEncRepokeyBlake2 = String -> CommandParam
    Param "--encryption=repokey-blake2"
    encParam BorgEncKeyfile = String -> CommandParam
    Param "--encryption=keyfile"
    encParam BorgEncKeyfileBlake2 = String -> CommandParam
    Param "--encryption=keyfile-blake2"