    -- | Maintainer: Félix Sipma <felix+propellor@gueux.org>

    module Propellor.Property.DebianMirror
    	( DebianPriority (..)
    	, showPriority
    	, mirror
    	, RsyncExtra (..)
    	, Method (..)
    	, DebianMirror
    	, debianMirrorHostName
    	, debianMirrorSuites
    	, debianMirrorArchitectures
    	, debianMirrorSections
    	, debianMirrorSourceBool
    	, debianMirrorPriorities
    	, debianMirrorMethod
    	, debianMirrorKeyring
    	, debianMirrorRsyncExtra
    	, mkDebianMirror
    	) where

    import Propellor.Base
    import qualified Propellor.Property.File as File
    import qualified Propellor.Property.Apt as Apt
    import qualified Propellor.Property.Cron as Cron
    import qualified Propellor.Property.User as User

    import Data.List

    data DebianPriority = Essential | Required | Important | Standard | Optional | Extra
    	deriving (Int -> DebianPriority -> ShowS
    [DebianPriority] -> ShowS
    DebianPriority -> String
    (Int -> DebianPriority -> ShowS)
    -> (DebianPriority -> String)
    -> ([DebianPriority] -> ShowS)
    -> Show DebianPriority
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [DebianPriority] -> ShowS
    $cshowList :: [DebianPriority] -> ShowS
    show :: DebianPriority -> String
    $cshow :: DebianPriority -> String
    showsPrec :: Int -> DebianPriority -> ShowS
    $cshowsPrec :: Int -> DebianPriority -> ShowS
    Show, DebianPriority -> DebianPriority -> Bool
    (DebianPriority -> DebianPriority -> Bool)
    -> (DebianPriority -> DebianPriority -> Bool) -> Eq DebianPriority
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: DebianPriority -> DebianPriority -> Bool
    $c/= :: DebianPriority -> DebianPriority -> Bool
    == :: DebianPriority -> DebianPriority -> Bool
    $c== :: DebianPriority -> DebianPriority -> Bool
    Eq)

    showPriority :: DebianPriority -> String
    showPriority :: DebianPriority -> String
    showPriority Essential = "essential"
    showPriority Required  = "required"
    showPriority Important = "important"
    showPriority Standard  = "standard"
    showPriority Optional  = "optional"
    showPriority Extra     = "extra"

    data RsyncExtra = Doc | Indices | Tools | Trace
    	deriving (Int -> RsyncExtra -> ShowS
    [RsyncExtra] -> ShowS
    RsyncExtra -> String
    (Int -> RsyncExtra -> ShowS)
    -> (RsyncExtra -> String)
    -> ([RsyncExtra] -> ShowS)
    -> Show RsyncExtra
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [RsyncExtra] -> ShowS
    $cshowList :: [RsyncExtra] -> ShowS
    show :: RsyncExtra -> String
    $cshow :: RsyncExtra -> String
    showsPrec :: Int -> RsyncExtra -> ShowS
    $cshowsPrec :: Int -> RsyncExtra -> ShowS
    Show, RsyncExtra -> RsyncExtra -> Bool
    (RsyncExtra -> RsyncExtra -> Bool)
    -> (RsyncExtra -> RsyncExtra -> Bool) -> Eq RsyncExtra
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: RsyncExtra -> RsyncExtra -> Bool
    $c/= :: RsyncExtra -> RsyncExtra -> Bool
    == :: RsyncExtra -> RsyncExtra -> Bool
    $c== :: RsyncExtra -> RsyncExtra -> Bool
    Eq)

    showRsyncExtra :: RsyncExtra -> String
    showRsyncExtra :: RsyncExtra -> String
    showRsyncExtra Doc = "doc"
    showRsyncExtra Indices = "indices"
    showRsyncExtra Tools = "tools"
    showRsyncExtra Trace = "trace"

    data Method = Ftp | Http | Https | Rsync | MirrorFile

    showMethod :: Method -> String
    showMethod :: Method -> String
    showMethod Ftp = "ftp"
    showMethod Http = "http"
    showMethod Https = "https"
    showMethod Rsync = "rsync"
    showMethod MirrorFile = "file"

    -- | To get a new DebianMirror and set options, use:
    --
    -- > mkDebianMirror mymirrordir mycrontimes
    -- > 	. debianMirrorHostName "otherhostname"
    -- > 	. debianMirrorSourceBool True

    data DebianMirror = DebianMirror
    	{ DebianMirror -> String
    _debianMirrorHostName :: HostName
    	, DebianMirror -> String
    _debianMirrorDir :: FilePath
    	, DebianMirror -> [DebianSuite]
    _debianMirrorSuites :: [DebianSuite]
    	, DebianMirror -> [Architecture]
    _debianMirrorArchitectures :: [Architecture]
    	, DebianMirror -> [String]
    _debianMirrorSections :: [Apt.Section]
    	, DebianMirror -> Bool
    _debianMirrorSourceBool :: Bool
    	, DebianMirror -> [DebianPriority]
    _debianMirrorPriorities :: [DebianPriority]
    	, DebianMirror -> Method
    _debianMirrorMethod :: Method
    	, DebianMirror -> String
    _debianMirrorKeyring :: FilePath
    	, DebianMirror -> [RsyncExtra]
    _debianMirrorRsyncExtra :: [RsyncExtra]
    	, DebianMirror -> Times
    _debianMirrorCronTimes :: Cron.Times
    	}

    mkDebianMirror :: FilePath -> Cron.Times -> DebianMirror
    mkDebianMirror :: String -> Times -> DebianMirror
    mkDebianMirror dir :: String
    dir crontimes :: Times
    crontimes = DebianMirror :: String
    -> String
    -> [DebianSuite]
    -> [Architecture]
    -> [String]
    -> Bool
    -> [DebianPriority]
    -> Method
    -> String
    -> [RsyncExtra]
    -> Times
    -> DebianMirror
    DebianMirror
    	{ _debianMirrorHostName :: String
    _debianMirrorHostName = "deb.debian.org"
    	, _debianMirrorDir :: String
    _debianMirrorDir = String
    dir
    	, _debianMirrorSuites :: [DebianSuite]
    _debianMirrorSuites = []
    	, _debianMirrorArchitectures :: [Architecture]
    _debianMirrorArchitectures = []
    	, _debianMirrorSections :: [String]
    _debianMirrorSections = []
    	, _debianMirrorSourceBool :: Bool
    _debianMirrorSourceBool = Bool
    False
    	, _debianMirrorPriorities :: [DebianPriority]
    _debianMirrorPriorities = []
    	, _debianMirrorMethod :: Method
    _debianMirrorMethod = Method
    Http
    	, _debianMirrorKeyring :: String
    _debianMirrorKeyring = "/usr/share/keyrings/debian-archive-keyring.gpg"
    	, _debianMirrorRsyncExtra :: [RsyncExtra]
    _debianMirrorRsyncExtra = [RsyncExtra
    Trace]
    	, _debianMirrorCronTimes :: Times
    _debianMirrorCronTimes = Times
    crontimes
    	}

    debianMirrorHostName :: HostName -> DebianMirror -> DebianMirror
    debianMirrorHostName :: String -> DebianMirror -> DebianMirror
    debianMirrorHostName hn :: String
    hn m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorHostName :: String
    _debianMirrorHostName = String
    hn }

    debianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror
    debianMirrorSuites :: [DebianSuite] -> DebianMirror -> DebianMirror
    debianMirrorSuites s :: [DebianSuite]
    s m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorSuites :: [DebianSuite]
    _debianMirrorSuites = [DebianSuite]
    s }

    debianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror
    debianMirrorArchitectures :: [Architecture] -> DebianMirror -> DebianMirror
    debianMirrorArchitectures a :: [Architecture]
    a m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorArchitectures :: [Architecture]
    _debianMirrorArchitectures = [Architecture]
    a }

    debianMirrorSections :: [Apt.Section] -> DebianMirror -> DebianMirror
    debianMirrorSections :: [String] -> DebianMirror -> DebianMirror
    debianMirrorSections s :: [String]
    s m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorSections :: [String]
    _debianMirrorSections = [String]
    s }

    debianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror
    debianMirrorSourceBool :: Bool -> DebianMirror -> DebianMirror
    debianMirrorSourceBool s :: Bool
    s m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorSourceBool :: Bool
    _debianMirrorSourceBool = Bool
    s }

    debianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror
    debianMirrorPriorities :: [DebianPriority] -> DebianMirror -> DebianMirror
    debianMirrorPriorities p :: [DebianPriority]
    p m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorPriorities :: [DebianPriority]
    _debianMirrorPriorities = [DebianPriority]
    p }

    debianMirrorMethod :: Method -> DebianMirror -> DebianMirror
    debianMirrorMethod :: Method -> DebianMirror -> DebianMirror
    debianMirrorMethod me :: Method
    me m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorMethod :: Method
    _debianMirrorMethod = Method
    me }

    debianMirrorKeyring :: FilePath -> DebianMirror -> DebianMirror
    debianMirrorKeyring :: String -> DebianMirror -> DebianMirror
    debianMirrorKeyring k :: String
    k m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorKeyring :: String
    _debianMirrorKeyring = String
    k }

    debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror
    debianMirrorRsyncExtra :: [RsyncExtra] -> DebianMirror -> DebianMirror
    debianMirrorRsyncExtra r :: [RsyncExtra]
    r m :: DebianMirror
    m = DebianMirror
    m { _debianMirrorRsyncExtra :: [RsyncExtra]
    _debianMirrorRsyncExtra = [RsyncExtra]
    r }

    mirror :: DebianMirror -> Property DebianLike
    mirror :: DebianMirror -> Property DebianLike
    mirror mirror' :: DebianMirror
    mirror' = String -> Props DebianLike -> Property DebianLike
    forall k (metatypes :: k).
    SingI metatypes =>
    String
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    propertyList ("Debian mirror " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    dir) (Props DebianLike -> Property DebianLike)
    -> Props DebianLike -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ Props UnixLike
    props
    	Props UnixLike
    -> Property DebianLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    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 DebianLike
    Apt.installed ["debmirror"]
    	Props DebianLike
    -> Property DebianLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    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))
    & User -> Property DebianLike
    User.accountFor (String -> User
    User "debmirror")
    	Props DebianLike
    -> Property UnixLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    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
    dir
    	Props DebianLike
    -> Property UnixLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    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 -> User -> Group -> Property UnixLike
    File.ownerGroup String
    dir (String -> User
    User "debmirror") (String -> Group
    Group "debmirror")
    	Props DebianLike
    -> Property UnixLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    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))
    & 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) -> ([Bool] -> Bool) -> [Bool] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ([Bool] -> Bool) -> IO [Bool] -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DebianSuite -> IO Bool) -> [DebianSuite] -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM DebianSuite -> IO Bool
    suitemirrored [DebianSuite]
    suites)
    		(String -> [String] -> UncheckedProperty UnixLike
    cmdProperty "debmirror" [String]
    args)
    			Property UnixLike -> String -> Property UnixLike
    forall p. IsProp p => p -> String -> p
    `describe` "debmirror setup"
    	Props DebianLike
    -> Property DebianLike
    -> Props
         (MetaTypes
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    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 -> Times -> User -> String -> String -> Property DebianLike
    Cron.niceJob ("debmirror_" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    dir) (DebianMirror -> Times
    _debianMirrorCronTimes DebianMirror
    mirror') (String -> User
    User "debmirror") "/"
    		([String] -> String
    unwords ("/usr/bin/debmirror" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    args))
      where
    	dir :: String
    dir = DebianMirror -> String
    _debianMirrorDir DebianMirror
    mirror'
    	suites :: [DebianSuite]
    suites = DebianMirror -> [DebianSuite]
    _debianMirrorSuites DebianMirror
    mirror'
    	suitemirrored :: DebianSuite -> IO Bool
    suitemirrored suite :: DebianSuite
    suite = String -> IO Bool
    doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ String
    dir String -> ShowS
    </> "dists" String -> ShowS
    </> DebianSuite -> String
    Apt.showSuite DebianSuite
    suite
    	architecturearg :: [String] -> String
    architecturearg = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate ","
    	suitearg :: String
    suitearg = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (DebianSuite -> String) -> [DebianSuite] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map DebianSuite -> String
    Apt.showSuite [DebianSuite]
    suites
    	priorityRegex :: [DebianPriority] -> String
    priorityRegex pp :: [DebianPriority]
    pp = "(" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "|" ((DebianPriority -> String) -> [DebianPriority] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map DebianPriority -> String
    showPriority [DebianPriority]
    pp) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"
    	rsyncextraarg :: [RsyncExtra] -> String
    rsyncextraarg [] = "none"
    	rsyncextraarg res :: [RsyncExtra]
    res = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (RsyncExtra -> String) -> [RsyncExtra] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map RsyncExtra -> String
    showRsyncExtra [RsyncExtra]
    res
    	args :: [String]
    args =
    		[ "--dist" , String
    suitearg
    		, "--arch", [String] -> String
    architecturearg ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Architecture -> String) -> [Architecture] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Architecture -> String
    architectureToDebianArchString (DebianMirror -> [Architecture]
    _debianMirrorArchitectures DebianMirror
    mirror')
    		, "--section", String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ DebianMirror -> [String]
    _debianMirrorSections DebianMirror
    mirror'
    		, "--limit-priority", "\"" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [DebianPriority] -> String
    priorityRegex (DebianMirror -> [DebianPriority]
    _debianMirrorPriorities DebianMirror
    mirror') String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "\""
    		]
    		[String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
    		(if DebianMirror -> Bool
    _debianMirrorSourceBool DebianMirror
    mirror' then [] else ["--nosource"])
    		[String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
    		[ "--host", DebianMirror -> String
    _debianMirrorHostName DebianMirror
    mirror'
    		, "--method", Method -> String
    showMethod (Method -> String) -> Method -> String
    forall a b. (a -> b) -> a -> b
    $ DebianMirror -> Method
    _debianMirrorMethod DebianMirror
    mirror'
    		, "--rsync-extra", [RsyncExtra] -> String
    rsyncextraarg ([RsyncExtra] -> String) -> [RsyncExtra] -> String
    forall a b. (a -> b) -> a -> b
    $ DebianMirror -> [RsyncExtra]
    _debianMirrorRsyncExtra DebianMirror
    mirror'
    		, "--keyring", DebianMirror -> String
    _debianMirrorKeyring DebianMirror
    mirror'
    		, String
    dir
    		]