powerdns-0.4.4: 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      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell  #-}
module PowerDNS.API.Zones
  (
  -- * API
    ZonesAPI(..)

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

  -- * Utilities
  , CIText
  , Result(..)
  , mkCIText
  , original
  , caseFolded
  )
where

import           Data.Char (ord, toUpper)
import           Data.Data (Data)
import           Data.Function (on)
import           Data.String (IsString(..))
import           Data.Word (Word32)
import           GHC.Base (unsafeChr)
import           Text.Read (readPrec)

import           Control.DeepSeq (NFData(..), deepseq)
import           Data.Aeson.TH (allNullaryToStringTag,
                                constructorTagModifier, defaultOptions,
                                fieldLabelModifier,
                                deriveJSON, omitNothingFields)
import           Data.Aeson (FromJSON(..), ToJSON(..), object, (.:), (.=), withObject)
import           Data.Hashable (Hashable(..))
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)

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

-- | 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, Read, Show, Generic, NFData, Data)

$(deriveJSON defaultOptions { fieldLabelModifier = strip "record_"
                            , omitNothingFields = True } ''Record)


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

-- | 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
  , comment_modified_at :: Maybe POSIXTime
  } deriving (Eq, Ord, Read, Show, Generic, NFData, Data, Empty)

$(deriveJSON defaultOptions { fieldLabelModifier = strip "comment_" } ''Comment)

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

-- | 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, Read, Show, Generic, NFData, Data)

$(deriveJSON defaultOptions { constructorTagModifier = fmap toUpper
                            , allNullaryToStringTag = True } ''ChangeType)


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

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, Read, Show, Generic, NFData, Data)

$(deriveJSON defaultOptions { allNullaryToStringTag = True
                            } ''RecordType)


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

-- | A wrapper for 'T.Text' implementing limited case-sensitivity as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343).
-- Use 'mkCIText' for construction.
--
-- See 'original' and 'caseFolded' for extracting a 'T.Text' back.

data CIText = CIText { ciOriginal :: T.Text, ciCaseFolded :: T.Text } deriving Data

-- | Obtain the original 'T.Text' from a 'CIText'.
original :: CIText -> T.Text
original = ciOriginal

-- | Obtain a [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343) case-folded 'T.Text' from a 'CIText'.
caseFolded :: CIText -> T.Text
caseFolded = ciCaseFolded

-- | Smart constructor for 'CIText'.
mkCIText :: T.Text -> CIText
mkCIText s = CIText s (T.map foldCase s)

instance IsString CIText where
  fromString = mkCIText . fromString

instance Semigroup CIText where
  CIText o1 f1 <> CIText o2 f2 = CIText (o1 <> o2) (f1 <> f2)

instance Monoid CIText where
  mempty = CIText mempty mempty

instance Read CIText where
  readPrec = fmap mkCIText readPrec

instance Show CIText where
  showsPrec p = showsPrec p . ciOriginal

instance Ord CIText where
  compare = compare `on` ciCaseFolded

instance Eq CIText where
  (==) = (==) `on` ciCaseFolded

instance ToJSON CIText where
  toJSON = toJSON . ciOriginal

instance FromJSON CIText where
  parseJSON = fmap mkCIText . parseJSON

instance Hashable CIText where
  hashWithSalt s = hashWithSalt s . ciCaseFolded

instance NFData CIText where
    rnf (CIText o f) = o `deepseq` f `deepseq` ()

{-# INLINE foldCase #-}
foldCase :: Char -> Char
foldCase x | x' <- fromIntegral (ord x)
           , x' >= 0x41
           , x' <= 0x5A
           = unsafeChr (x' + 32)

           | otherwise
           = x

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

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

$(deriveJSON defaultOptions { fieldLabelModifier = strip "rrset_"
                            , omitNothingFields = True } ''RRSet)

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

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

instance ToJSON RRSets
instance FromJSON RRSets

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

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

$(deriveJSON defaultOptions { allNullaryToStringTag = True } ''Kind)

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

-- | 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 'Eq' and 'Ord' use 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 CIText
  , 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 (Eq, Ord, Read, Show, Generic, NFData, Data, Empty)

$(deriveJSON defaultOptions { fieldLabelModifier = strip "zone_" } ''Zone)

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

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

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

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

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

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

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

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

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

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

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

  } deriving Generic

-- | A simple newtype wrapper, because the original PowerDNS API encodes some textual result types more equal than others.
newtype Result = Result T.Text

instance ToJSON Result where
  toJSON (Result t) = object ["result" .= t]

instance FromJSON Result where
  parseJSON = withObject "result" $ \o -> Result <$> (o .: "result")