-- | 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 Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
"."
dValue (BindDomain
RootDomain) = Package
"@"

sectionHeader :: ConfSection -> String
sectionHeader :: Package -> Package
sectionHeader Package
header = Package
header Package -> Package -> Package
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 Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: [Package]
otherSections [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [Package]
serverSection)
	Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
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 (UnboundSection -> Maybe UnboundSection -> UnboundSection
forall a. a -> Maybe a -> a
fromMaybe (Package
"server", []) (Maybe UnboundSection -> UnboundSection)
-> Maybe UnboundSection -> UnboundSection
forall a b. (a -> b) -> a -> b
$ (UnboundSection -> Bool)
-> [UnboundSection] -> Maybe UnboundSection
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Package -> Package -> Bool
forall a. Eq a => a -> a -> Bool
== Package
"server") (Package -> Bool)
-> (UnboundSection -> Package) -> UnboundSection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnboundSection -> Package
forall a b. (a, b) -> a
fst) [UnboundSection]
sections)
		[Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ (UnboundZone -> Package) -> [UnboundZone] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map UnboundZone -> Package
genZone [UnboundZone]
zones
		[Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ (UnboundHost -> Package) -> [UnboundHost] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map ((BindDomain -> Record -> Package) -> UnboundHost -> Package
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BindDomain -> Record -> Package
genRecord') [UnboundHost]
hosts
	otherSections :: [Package]
otherSections = (UnboundSection -> [Package] -> [Package])
-> [Package] -> [UnboundSection] -> [Package]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
(++) ([Package] -> [Package] -> [Package])
-> (UnboundSection -> [Package])
-> UnboundSection
-> [Package]
-> [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnboundSection -> [Package]
genSection) [] ([UnboundSection] -> [Package]) -> [UnboundSection] -> [Package]
forall a b. (a -> b) -> a -> b
$ (UnboundSection -> Bool) -> [UnboundSection] -> [UnboundSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Package -> Package -> Bool
forall a. Eq a => a -> a -> Bool
/= Package
"server") (Package -> Bool)
-> (UnboundSection -> Package) -> UnboundSection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnboundSection -> Package
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 Package -> [Package] -> [Package]
forall a. a -> [a] -> [a]
: (UnboundSetting -> Package) -> [UnboundSetting] -> [Package]
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
"    " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
key Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
": " Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
value

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

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

genRecord :: BindDomain -> Record -> Maybe String
genRecord :: BindDomain -> Record -> Maybe Package
genRecord BindDomain
dom (Address IPAddr
addr) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
forall a b. (a -> b) -> a -> b
$ BindDomain -> IPAddr -> Package
genAddressNoTtl BindDomain
dom IPAddr
addr
genRecord BindDomain
dom (MX Int
priority BindDomain
dest) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"MX"
	, Int -> Package
forall t. ConfigurableValue t => t -> Package
val Int
priority
	, BindDomain -> Package
dValue BindDomain
dest
	]
genRecord BindDomain
dom (PTR Package
revip) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ Package
revip Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
"."
	, Package
"PTR"
	, BindDomain -> Package
dValue BindDomain
dom
	]
genRecord BindDomain
dom (CNAME BindDomain
dest) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
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) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
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) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
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) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"SRV"
	, Word16 -> Package
forall t. ConfigurableValue t => t -> Package
val Word16
priority
	, Word16 -> Package
forall t. ConfigurableValue t => t -> Package
val Word16
weight
	, Word16 -> Package
forall t. ConfigurableValue t => t -> Package
val Word16
port
	, BindDomain -> Package
dValue BindDomain
target
	]
genRecord BindDomain
dom (SSHFP Int
algo Int
hash Package
fingerprint) = Package -> Maybe Package
forall a. a -> Maybe a
Just (Package -> Maybe Package) -> Package -> Maybe Package
forall a b. (a -> b) -> a -> b
$ [Package] -> Package
unwords
	[ BindDomain -> Package
dValue BindDomain
dom
	, Package
"SSHFP"
	, Int -> Package
forall t. ConfigurableValue t => t -> Package
val Int
algo
	, Int -> Package
forall t. ConfigurableValue t => t -> Package
val Int
hash
	, Package
fingerprint
	]
genRecord BindDomain
_ (INCLUDE Package
_) = Maybe 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 Maybe Int
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 ([Package] -> Package) -> [Package] -> Package
forall a b. (a -> b) -> a -> b
$
	[ BindDomain -> Package
dValue BindDomain
dom ]
	[Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++ [Package] -> (Int -> [Package]) -> Maybe Int -> [Package]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
ttl' -> [Int -> Package
forall t. ConfigurableValue t => t -> Package
val Int
ttl']) Maybe Int
ttl [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++
	[ Package
"IN"
	, Package
recordtype
	, IPAddr -> Package
forall t. ConfigurableValue t => t -> Package
val IPAddr
addr
	]