    -- | 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 = Apt.installed ["unbound"]

    restarted :: Property DebianLike
    restarted = Service.restarted "unbound"

    reloaded :: Property DebianLike
    reloaded = Service.reloaded "unbound"

    dValue :: BindDomain -> String
    dValue (RelDomain d) = d
    dValue (AbsDomain d) = d ++ "."
    dValue (RootDomain) = "@"

    sectionHeader :: ConfSection -> String
    sectionHeader header = header ++ ":"

    config :: FilePath
    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 sections zones hosts =
            config `hasContent` (comment : otherSections ++ serverSection)
            `onChange` restarted
      where
            comment = "# deployed with propellor, do not modify"
            serverSection = genSection (fromMaybe ("server", []) $ find ((== "server") . fst) sections)
                    ++ map genZone zones
                    ++ map (uncurry genRecord') hosts
            otherSections = foldr ((++) . genSection) [] $ filter ((/= "server") . fst) sections

    genSection :: UnboundSection -> [Line]
    genSection (section, settings) = sectionHeader section : map genSetting settings

    genSetting :: UnboundSetting -> Line
    genSetting (key, value) = "    " ++ key ++ ": " ++ value

    genZone :: UnboundZone -> Line
    genZone (dom, zt) = "    local-zone: \"" ++ dValue dom ++ "\" " ++ zt

    genRecord' :: BindDomain -> Record -> Line
    genRecord' dom r = "    local-data: \"" ++ fromMaybe "" (genRecord dom r) ++ "\""

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

    genAddressNoTtl :: BindDomain -> IPAddr -> String
    genAddressNoTtl dom = genAddress dom Nothing

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

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