-- | -- 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, 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, 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, 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, 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, Show, Generic, NFData, Data) $(deriveJSON defaultOptions { fieldLabelModifier = strip "rrset_" , omitNothingFields = True } ''RRSet) ---------------------------------------------------------------------------------------- -- | A list of RRSets data RRSets = RRSets { rrsets :: [RRSet] } deriving (Eq, Ord, Show, Generic, NFData, Data) instance ToJSON RRSets instance FromJSON RRSets ---------------------------------------------------------------------------------------- data Kind = Native | Master | Slave deriving (Eq, Ord, 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, Show, Generic, NFData, Data, Empty) $(deriveJSON defaultOptions { fieldLabelModifier = strip "zone_" } ''Zone) ---------------------------------------------------------------------------------------- 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] Result , apiNotifySlaves :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "notify" :> Put '[JSON] Result , apiGetZoneAxfr :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "export" :> Get '[JSON] Result , apiRectifyZone :: f :- "servers" :> Capture "server_id" T.Text :> "zones" :> Capture "zone_id" T.Text :> "rectify" :> Put '[JSON] Result } deriving Generic data 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")