    -- | 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 ["unbound"]

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

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

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

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

    config :: FilePath
    config :: Package
    config = "/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 sections :: [UnboundSection]
    sections zones :: [UnboundZone]
    zones hosts :: [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 = "# deployed with propellor, do not modify"
    	serverSection :: [Package]
    serverSection = UnboundSection -> [Package]
    genSection (UnboundSection -> Maybe UnboundSection -> UnboundSection
    forall a. a -> Maybe a -> a
    fromMaybe ("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
    == "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
    /= "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 (section :: Package
    section, settings :: [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 (key :: Package
    key, value :: Package
    value) = "    " Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package
    key Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ ": " Package -> Package -> Package
    forall a. [a] -> [a] -> [a]
    ++ Package
    value

    genZone :: UnboundZone -> Line
    genZone :: UnboundZone -> Package
    genZone (dom :: BindDomain
    dom, zt :: Package
    zt) = "    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
    forall a. [a] -> [a] -> [a]
    ++ Package
    zt

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

    genRecord :: BindDomain -> Record -> Maybe String
    genRecord :: BindDomain -> Record -> Maybe Package
    genRecord dom :: BindDomain
    dom (Address addr :: 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 dom :: BindDomain
    dom (MX priority :: Int
    priority dest :: 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
    	, "MX"
    	, Int -> Package
    forall t. ConfigurableValue t => t -> Package
    val Int
    priority
    	, BindDomain -> Package
    dValue BindDomain
    dest
    	]
    genRecord dom :: BindDomain
    dom (PTR revip :: 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]
    ++ "."
    	, "PTR"
    	, BindDomain -> Package
    dValue BindDomain
    dom
    	]
    genRecord dom :: BindDomain
    dom (CNAME dest :: 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
    	, "CNAME"
    	, BindDomain -> Package
    dValue BindDomain
    dest
    	]
    genRecord dom :: BindDomain
    dom (NS serv :: 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
    	, "NS"
    	, BindDomain -> Package
    dValue BindDomain
    serv
    	]
    genRecord dom :: BindDomain
    dom (TXT 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
    	, "TXT"
    	, Package
    txt
    	]
    genRecord dom :: BindDomain
    dom (SRV priority :: Word16
    priority weight :: Word16
    weight port :: Word16
    port target :: 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
    	, "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 dom :: BindDomain
    dom (SSHFP algo :: Int
    algo hash :: Int
    hash fingerprint :: 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
    	, "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 _ (INCLUDE _) = Maybe Package
    forall a. Maybe a
    Nothing

    genAddressNoTtl :: BindDomain -> IPAddr -> String
    genAddressNoTtl :: BindDomain -> IPAddr -> Package
    genAddressNoTtl dom :: 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 dom :: BindDomain
    dom ttl :: Maybe Int
    ttl addr :: IPAddr
    addr = case IPAddr
    addr of
    	IPv4 _ -> Package -> BindDomain -> Maybe Int -> IPAddr -> Package
    genAddress' "A" BindDomain
    dom Maybe Int
    ttl IPAddr
    addr
    	IPv6 _ -> Package -> BindDomain -> Maybe Int -> IPAddr -> Package
    genAddress' "AAAA" BindDomain
    dom Maybe Int
    ttl IPAddr
    addr

    genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String
    genAddress' :: Package -> BindDomain -> Maybe Int -> IPAddr -> Package
    genAddress' recordtype :: Package
    recordtype dom :: BindDomain
    dom ttl :: Maybe Int
    ttl addr :: 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 [] (\ttl' :: Int
    ttl' -> [Int -> Package
    forall t. ConfigurableValue t => t -> Package
    val Int
    ttl']) Maybe Int
    ttl [Package] -> [Package] -> [Package]
    forall a. [a] -> [a] -> [a]
    ++
    	[ "IN"
    	, Package
    recordtype
    	, IPAddr -> Package
    forall t. ConfigurableValue t => t -> Package
    val IPAddr
    addr
    	]