-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>
--
-- Properties for the Unbound caching DNS server

module Propellor.Property.Unbound
	( installed
	, restarted
	, reloaded
	, UnboundSection
	, UnboundZone
	, UnboundHost
	, UnboundSetting
	, UnboundValue
	, UnboundKey
	, ConfSection
	, ZoneType
	, cachingDnsServer
	) where

import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service

import Data.List (find)


type ConfSection = String

type UnboundSetting = (UnboundKey, UnboundValue)

type UnboundSection = (ConfSection, [UnboundSetting])

type UnboundZone = (BindDomain, ZoneType)

type UnboundHost = (BindDomain, Record)

type UnboundKey = String

type UnboundValue = String

type ZoneType = String

installed :: Property DebianLike
installed :: Property DebianLike
installed = [Package] -> Property DebianLike
Apt.installed [Package
"unbound"]

restarted :: Property DebianLike
restarted :: Property DebianLike
restarted = Package -> Property DebianLike
Service.restarted Package
"unbound"

reloaded :: Property DebianLike
reloaded :: Property DebianLike
reloaded = Package -> Property DebianLike
Service.reloaded Package
"unbound"

dValue :: BindDomain -> String
dValue :: BindDomain -> Package
dValue (RelDomain Package
d) = Package
d
dValue (AbsDomain Package
d) = Package
d forall a. [a] -> [a] -> [a]
++ Package
"."
dValue (BindDomain
RootDomain) = Package
"@"

sectionHeader :: ConfSection -> String
sectionHeader :: Package -> Package
sectionHeader Package
header = Package
header forall a. [a] -> [a] -> [a]
++ Package
":"

config :: FilePath
config :: Package
config = Package
"/etc/unbound/unbound.conf.d/propellor.conf"

-- | Provided a [UnboundSection], a [UnboundZone] and a [UnboundHost],
-- cachingDnsServer ensure unbound is configured accordingly.
--
-- Be carefull with CNAMEs, unbound is not a primary DNS server, so it will
-- resolve these by itself. For a locally served zone, you probably want A/AAAA
-- records instead.
--
-- Example property:
--
-- > cachingDnsServer
-- >      [ ("remote-control", [("control-enable", "no")]
-- >      , ("server",
-- >      	[ ("interface", "0.0.0.0")
-- >      	, ("access-control", "192.168.1.0/24 allow")
-- >      	, ("do-tcp", "no")
-- >      	])
-- >      [ (AbsDomain "example.com", "transparent")
-- >      , (AbsDomain $ reverseIP $ IPv4 "192.168.1", "static")
-- >      ]
-- >      [ (AbsDomain "example.com", Address $ IPv4 "192.168.1.2")
-- >      , (AbsDomain "myhost.example.com", Address $ IPv4 "192.168.1.2")
-- >      , (AbsDomain "myrouter.example.com", Address $ IPv4 "192.168.1.1")
-- >      , (AbsDomain "www.example.com", Address $ IPv4 "192.168.1.2")
-- >      , (AbsDomain "example.com", MX 10 "mail.example.com")
-- >      , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.1.2")
-- >      -- ^ connected via ethernet
-- >      , (AbsDomain "mywifi.example.com", Address $ IPv4 "192.168.2.1")
-- >      , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.2.2")
-- >      -- ^ connected via wifi, use round robin
-- >      , (AbsDomain "myhost.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
-- >      , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
-- >      , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
-- >      ]
cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property DebianLike
cachingDnsServer :: [UnboundSection]
-> [UnboundZone] -> [UnboundHost] -> Property DebianLike
cachingDnsServer [UnboundSection]
sections [UnboundZone]
zones [UnboundHost]
hosts =
	Package
config Package -> [Package] -> Property UnixLike
`hasContent` (Package
comment forall a. a -> [a] -> [a]
: [Package]
otherSections forall a. [a] -> [a] -> [a]
++ [Package]
serverSection)
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
restarted
  where
	comment :: Package
comment = Package
"# deployed with propellor, do not modify"
	serverSection :: [Package]
serverSection = UnboundSection -> [Package]
genSection (forall a. a -> Maybe a -> a
fromMaybe (Package
"server", []) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Package
"server") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [UnboundSection]
sections)
		forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map UnboundZone -> Package
genZone [UnboundZone]
zones
		forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BindDomain -> Record -> Package
genRecord') [UnboundHost]
hosts
	otherSections :: [Package]
otherSections = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnboundSection -> [Package]
genSection) [] forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Package
"server") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [UnboundSection]
sections

genSection :: UnboundSection -> [Line]
genSection :: UnboundSection -> [Package]
genSection (Package
section, [UnboundSetting]
settings) = Package -> Package
sectionHeader Package
section forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map UnboundSetting -> Package
genSetting [UnboundSetting]
settings

genSetting :: UnboundSetting -> Line
genSetting :: UnboundSetting -> Package
genSetting (Package
key, Package
value) = Package
"    " forall a. [a] -> [a] -> [a]
++ Package
key forall a. [a] -> [a] -> [a]
++ Package
": " forall a. [a] -> [a] -> [a]
++ Package
value

genZone :: UnboundZone -> Line
genZone :: UnboundZone -> Package
genZone (BindDomain
dom, Package
zt) = Package
"    local-zone: \"" forall a. [a] -> [a] -> [a]
++ BindDomain -> Package
dValue BindDomain
dom forall a. [a] -> [a] -> [a]
++ Package
"\" " forall a. [a] -> [a] -> [a]
++ Package
zt

genRecord' :: BindDomain -> Record -> Line
genRecord' :: BindDomain -> Record -> Package
genRecord' BindDomain
dom Record
r = Package
"    local-data: \"" forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe Package
"" (BindDomain -> Record -> Maybe Package
genRecord BindDomain
dom Record
r) forall a. [a] -> [a] -> [a]
++ Package
"\""

genRecord :: BindDomain -> Record -> Maybe String
genRecord :: BindDomain -> Record -> Maybe Package
genRecord BindDomain
dom (Address IPAddr
addr) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BindDomain -> IPAddr -> Package
genAddressNoTtl BindDomain
dom IPAddr
addr
genRecord BindDomain
dom (MX Int
priority BindDomain
dest) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"MX"
	, forall t. ConfigurableValue t => t -> Package
val Int
priority
	, BindDomain -> Package
dValue BindDomain
dest
	]
genRecord BindDomain
dom (PTR Package
revip) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ Package
revip forall a. [a] -> [a] -> [a]
++ Package
"."
	, Package
"PTR"
	, BindDomain -> Package
dValue BindDomain
dom
	]
genRecord BindDomain
dom (CNAME BindDomain
dest) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"CNAME"
	, BindDomain -> Package
dValue BindDomain
dest
	]
genRecord BindDomain
dom (NS BindDomain
serv) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"NS"
	, BindDomain -> Package
dValue BindDomain
serv
	]
genRecord BindDomain
dom (TXT Package
txt) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"TXT"
	, Package
txt
	]
genRecord BindDomain
dom (SRV Word16
priority Word16
weight Word16
port BindDomain
target) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"SRV"
	, forall t. ConfigurableValue t => t -> Package
val Word16
priority
	, forall t. ConfigurableValue t => t -> Package
val Word16
weight
	, forall t. ConfigurableValue t => t -> Package
val Word16
port
	, BindDomain -> Package
dValue BindDomain
target
	]
genRecord BindDomain
dom (SSHFP Int
algo Int
hash Package
fingerprint) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"SSHFP"
	, forall t. ConfigurableValue t => t -> Package
val Int
algo
	, forall t. ConfigurableValue t => t -> Package
val Int
hash
	, Package
fingerprint
	]
genRecord BindDomain
_ (INCLUDE Package
_) = forall a. Maybe a
Nothing

genAddressNoTtl :: BindDomain -> IPAddr -> String
genAddressNoTtl :: BindDomain -> IPAddr -> Package
genAddressNoTtl BindDomain
dom = BindDomain -> Maybe Int -> IPAddr -> Package
genAddress BindDomain
dom forall a. Maybe a
Nothing

genAddress :: BindDomain -> Maybe Int -> IPAddr -> String
genAddress :: BindDomain -> Maybe Int -> IPAddr -> Package
genAddress BindDomain
dom Maybe Int
ttl IPAddr
addr = case IPAddr
addr of
	IPv4 Package
_ -> Package -> BindDomain -> Maybe Int -> IPAddr -> Package
genAddress' Package
"A" BindDomain
dom Maybe Int
ttl IPAddr
addr
	IPv6 Package
_ -> Package -> BindDomain -> Maybe Int -> IPAddr -> Package
genAddress' Package
"AAAA" BindDomain
dom Maybe Int
ttl IPAddr
addr

genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String
genAddress' :: Package -> BindDomain -> Maybe Int -> IPAddr -> Package
genAddress' Package
recordtype BindDomain
dom Maybe Int
ttl IPAddr
addr = [Package] -> Package
unwords forall a b. (a -> b) -> a -> b
$
	[ BindDomain -> Package
dValue BindDomain
dom ]
	forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
ttl' -> [forall t. ConfigurableValue t => t -> Package
val Int
ttl']) Maybe Int
ttl forall a. [a] -> [a] -> [a]
++
	[ Package
"IN"
	, Package
recordtype
	, forall t. ConfigurableValue t => t -> Package
val IPAddr
addr
	]