-- | 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
		]