    -- | 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 (Show, Eq)

    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 (Show, Eq)

    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 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
            { _debianMirrorHostName :: HostName
            , _debianMirrorDir :: FilePath
            , _debianMirrorSuites :: [DebianSuite]
            , _debianMirrorArchitectures :: [Architecture]
            , _debianMirrorSections :: [Apt.Section]
            , _debianMirrorSourceBool :: Bool
            , _debianMirrorPriorities :: [DebianPriority]
            , _debianMirrorMethod :: Method
            , _debianMirrorKeyring :: FilePath
            , _debianMirrorRsyncExtra :: [RsyncExtra]
            , _debianMirrorCronTimes :: Cron.Times
            }

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

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

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

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

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

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

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

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

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

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

    mirror :: DebianMirror -> Property DebianLike
    mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props
            & Apt.installed ["debmirror"]
            & User.accountFor (User "debmirror")
            & File.dirExists dir
            & File.ownerGroup dir (User "debmirror") (Group "debmirror")
            & check (not . and <$> mapM suitemirrored suites)
                    (cmdProperty "debmirror" args)
                            `describe` "debmirror setup"
            & Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/"
                    (unwords ("/usr/bin/debmirror" : args))
      where
            dir = _debianMirrorDir mirror'
            suites = _debianMirrorSuites mirror'
            suitemirrored suite = doesDirectoryExist $ dir </> "dists" </> Apt.showSuite suite
            architecturearg = intercalate ","
            suitearg = intercalate "," $ map Apt.showSuite suites
            priorityRegex pp = "(" ++ intercalate "|" (map showPriority pp) ++ ")"
            rsyncextraarg [] = "none"
            rsyncextraarg res = intercalate "," $ map showRsyncExtra res
            args =
                    [ "--dist" , suitearg
                    , "--arch", architecturearg $ map architectureToDebianArchString (_debianMirrorArchitectures mirror')
                    , "--section", intercalate "," $ _debianMirrorSections mirror'
                    , "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\""
                    ]
                    ++
                    (if _debianMirrorSourceBool mirror' then [] else ["--nosource"])
                    ++
                    [ "--host", _debianMirrorHostName mirror'
                    , "--method", showMethod $ _debianMirrorMethod mirror'
                    , "--rsync-extra", rsyncextraarg $ _debianMirrorRsyncExtra mirror'
                    , "--keyring", _debianMirrorKeyring mirror'
                    , dir
                    ]