packages feed

powerdns-0.2.2: PowerDNS/API/Zones.hs

-- |
-- Module: PowerDNS.API.Zones
-- Description: Zones endpoints for PowerDNS API
--
-- Implementation of the API endpoints described at [PowerDNS Zones API](https://doc.powerdns.com/authoritative/http-api/zone.html)

{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE TypeOperators      #-}
module PowerDNS.API.Zones
  (
  -- * API
    ZonesAPI(..)

  -- * Data types
  , Zone(..)
  , Kind(..)
  , RRSets(..)
  , RRSet(..)
  , Record(..)
  , Comment(..)
  , ChangeType(..)
  , RecordType(..)
  )
where

import           Data.Char (toUpper)
import           Data.Coerce (coerce)
import           Data.Data (Data)
import           Data.Word (Word32)

import           Control.DeepSeq (NFData)
import           Data.Aeson (FromJSON(..), ToJSON(..), allNullaryToStringTag,
                             constructorTagModifier, defaultOptions,
                             fieldLabelModifier, genericParseJSON,
                             genericToJSON, omitNothingFields)
import qualified Data.Text as T
import           Data.Time.Clock.POSIX (POSIXTime)
import           Servant.API
import           Servant.API.Generic

import           PowerDNS.Internal.Utils (Empty(..), strip)

----------------------------------------------------------------------------------------

data ZonesAPI f = ZonesAPI
  { apiListZones     :: f :- "servers" :> Capture "server_id" T.Text :> "zones"
                          :> QueryParam "zone" T.Text
                          :> QueryParam "dnssec" Bool
                          :> Get '[JSON] [Zone]

  , apiCreateZone    :: f :- "servers" :> Capture "server_id" T.Text :> "zones"
                          :> QueryParam "rrset" Bool
                          :> ReqBody '[JSON] Zone
                          :> PostCreated '[JSON] Zone

  , apiGetZone       :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text
                          :> QueryParam "rrsets" Bool
                          :> Get '[JSON] Zone

  , apiDeleteZone    :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text
                          :> DeleteNoContent

  , apiUpdateRecords :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text
                          :> ReqBody '[JSON] RRSets
                          :> PatchNoContent

  , apiUpdateZone    :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text
                          :> ReqBody '[JSON] Zone
                          :> PutNoContent

  , apiTriggerAxfr   :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "axfr-retrieve"
                          :> Put '[JSON] NoContent

  , apiNotifySlaves  :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "notify"
                          :> Put '[JSON] NoContent

  , apiGetZoneAxfr   :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "export"
                          :> Get '[JSON] T.Text

  , apiRectifyZone   :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "rectify"
                          :> Put '[JSON] T.Text

  } deriving Generic


----------------------------------------------------------------------------------------

-- | Zone according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#zone).
-- All fields are optional because the PowerDNS API differs on which fields are required depending on the endpoint.
--
-- Note that the 'Eq' instance is up to limited case-sensitivity on 'zone_name' and equivalently contained rrset names
-- as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343)
data Zone = Zone
  { zone_id :: Maybe T.Text
  , zone_name :: Maybe T.Text
  , zone_type :: Maybe T.Text
  , zone_url :: Maybe T.Text
  , zone_kind :: Maybe Kind
  , zone_rrsets :: Maybe [RRSet]
  , zone_serial :: Maybe Integer
  , zone_notified_serial :: Maybe Integer
  , zone_edited_serial :: Maybe Integer
  , zone_masters :: Maybe [T.Text]
  , zone_dnssec :: Maybe Bool
  , zone_nsec3param :: Maybe T.Text
  , zone_nsec3narrow :: Maybe Bool
  , zone_presigned :: Maybe Bool
  , zone_soa_edit :: Maybe T.Text
  , zone_soa_edit_api :: Maybe T.Text
  , zone_api_rectify :: Maybe Bool
  , zone_zone :: Maybe T.Text
  , zone_account :: Maybe T.Text
  , zone_nameservers :: Maybe [T.Text]
  , zone_master_tsig_key_ids :: Maybe [T.Text]
  , zone_slave_tsig_key_ids :: Maybe [T.Text]
  } deriving (Ord, Show, Generic, NFData, Data, Empty)

instance Eq Zone where
  l == r
    = zone_id l == zone_id r
   && (coerce (zone_name l) :: Maybe CI) == (coerce (zone_name r) :: Maybe CI)
   && zone_type l == zone_type r
   && zone_url l == zone_url r
   && zone_kind l == zone_kind r
   && zone_rrsets l == zone_rrsets r
   && zone_serial l == zone_serial r
   && zone_notified_serial l == zone_notified_serial r
   && zone_edited_serial l == zone_edited_serial r
   && zone_masters l == zone_masters r
   && zone_dnssec l == zone_dnssec r
   && zone_nsec3param l == zone_nsec3param r
   && zone_nsec3narrow l == zone_nsec3narrow r
   && zone_presigned l == zone_presigned r
   && zone_soa_edit l == zone_soa_edit r
   && zone_soa_edit_api l == zone_soa_edit_api r
   && zone_api_rectify l == zone_api_rectify r
   && zone_zone l == zone_zone r
   && zone_account l == zone_account r
   && zone_nameservers l == zone_nameservers r
   && zone_master_tsig_key_ids l == zone_master_tsig_key_ids r
   && zone_slave_tsig_key_ids l == zone_slave_tsig_key_ids r

instance ToJSON Zone where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "zone_"}

instance FromJSON Zone where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "zone_"}

----------------------------------------------------------------------------------------

data Kind = Native | Master | Slave
  deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON Kind where
  toJSON = genericToJSON defaultOptions { allNullaryToStringTag = True }

instance FromJSON Kind where
  parseJSON = genericParseJSON defaultOptions { allNullaryToStringTag = True }

----------------------------------------------------------------------------------------

-- | A list of RRSets
data RRSets = RRSets
  { rrsets :: [RRSet]
  } deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON RRSets
instance FromJSON RRSets

----------------------------------------------------------------------------------------

newtype CI = CI T.Text

instance Eq CI where
  CI l == CI r = T.map caseFold l == T.map caseFold r
    where
        caseFold x = case x of
            'A' -> 'a'
            'B' -> 'b'
            'C' -> 'c'
            'D' -> 'd'
            'E' -> 'e'
            'F' -> 'f'
            'G' -> 'g'
            'H' -> 'h'
            'I' -> 'i'
            'J' -> 'j'
            'K' -> 'k'
            'L' -> 'l'
            'M' -> 'm'
            'N' -> 'n'
            'O' -> 'o'
            'P' -> 'p'
            'Q' -> 'q'
            'R' -> 'r'
            'S' -> 's'
            'T' -> 't'
            'U' -> 'u'
            'V' -> 'v'
            'W' -> 'w'
            'X' -> 'x'
            'Y' -> 'y'
            'Z' -> 'z'
            _   -> x

-- | RRSet according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#rrset).
--
-- Note that the 'Eq' instance is up to limited case-sensitivity on 'rrset_name' as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343)
data RRSet = RRSet
  { rrset_name :: T.Text
  , rrset_type :: RecordType
  , rrset_ttl :: Word32
  , rrset_changetype :: Maybe ChangeType
  , rrset_records :: Maybe [Record]
  , rrset_comments :: Maybe [Comment]
  } deriving (Ord, Show, Generic, NFData, Data)

instance Eq RRSet where
  l == r =
     (coerce (rrset_name l) :: CI) == (coerce (rrset_name r) :: CI)
   && rrset_type l == rrset_type r
   && rrset_ttl l == rrset_ttl r
   && rrset_changetype l == rrset_changetype r
   && rrset_records l == rrset_records r
   && rrset_comments l == rrset_comments r

instance ToJSON RRSet where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "rrset_"
                                        , omitNothingFields = True }

instance FromJSON RRSet where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "rrset_"
                                              , omitNothingFields = True }

----------------------------------------------------------------------------------------

data RecordType = A
                | AAAA
                | AFSDB
                | ALIAS
                | APL
                | CAA
                | CERT
                | CDNSKEY
                | CDS
                | CNAME
                | DNSKEY
                | DNAME
                | DS
                | HINFO
                | KEY
                | LOC
                | MX
                | NAPTR
                | NS
                | NSEC
                | NSEC3
                | NSEC3PARAM
                | OPENPGPKEY
                | PTR
                | RP
                | RRSIG
                | SOA
                | SPF
                | SSHFP
                | SRV
                | TKEY
                | TSIG
                | TLSA
                | SMIMEA
                | TXT
                | URI
                | A6
                | DHCID
                | DLV
                | EUI48
                | EUI64
                | IPSECKEY
                | KX
                | MAILA
                | MAILB
                | MINFO
                | MR
                | RKEY
                | SIG
                | WKS
                deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON RecordType where
  toJSON = genericToJSON defaultOptions { allNullaryToStringTag = True
                                        }

instance FromJSON RecordType where
  parseJSON = genericParseJSON defaultOptions { allNullaryToStringTag = True
                                              }

----------------------------------------------------------------------------------------

-- | Whether or not an 'RRSet' replace or delete an existing entry.
-- If the 'ChangeType' is left at @Nothing@ it will create a new domain entry.
data ChangeType = Replace
                | Delete
                deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON ChangeType where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = fmap toUpper
                                        , allNullaryToStringTag = True }

instance FromJSON ChangeType where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = fmap toUpper
                                              , allNullaryToStringTag = True }

----------------------------------------------------------------------------------------
-- | Record according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#record)
data Record = Record
  { record_content :: T.Text
  , record_disabled :: Bool
  } deriving (Eq, Ord, Show, Generic, NFData, Data)

instance ToJSON Record where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "record_"
                                        , omitNothingFields = True }

instance FromJSON Record where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "record_"
                                              , omitNothingFields = True }

----------------------------------------------------------------------------------------

-- | Comment according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#comment)
data Comment = Comment
  { comment_content :: Maybe T.Text
  , comment_account :: Maybe T.Text
  , commant_modified_at :: Maybe POSIXTime
  } deriving (Eq, Ord, Show, Generic, NFData, Data, Empty)

instance ToJSON Comment where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = strip "comment_" }

instance FromJSON Comment where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = strip "comment_" }