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(..)

  -- * Utilities
  , CIText
  , 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 (FromJSON(..), ToJSON(..), allNullaryToStringTag,
                             constructorTagModifier, defaultOptions,
                             fieldLabelModifier, genericParseJSON,
                             genericToJSON, omitNothingFields)
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)

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

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

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

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

-- | 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 :: Word32
  , rrset_changetype :: Maybe ChangeType
  , rrset_records :: Maybe [Record]
  , rrset_comments :: Maybe [Comment]
  } deriving (Eq, Ord, Show, Generic, NFData, Data)

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
  , comment_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_" }