Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
PowerDNS.API.Zones
Contents
Description
Implementation of the API endpoints described at PowerDNS Zones API
Synopsis
- data ZonesAPI f = ZonesAPI {
- apiListZones :: f :- (Summary "List zones" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (QueryParam "zone" Text :> (QueryParam "dnssec" Bool :> Get '[JSON] [Zone]))))))
- apiCreateZone :: f :- (Summary "Create zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (QueryParam "rrset" Bool :> (ReqBody '[JSON] Zone :> PostCreated '[JSON] Zone))))))
- apiGetZone :: f :- (Summary "Get zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> (QueryParam "rrsets" Bool :> Get '[JSON] Zone))))))
- apiDeleteZone :: f :- (Summary "Delete zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> DeleteNoContent)))))
- apiUpdateRecords :: f :- (Summary "Update records" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> (ReqBody '[JSON] RRSets :> PatchNoContent))))))
- apiUpdateZone :: f :- (Summary "Update zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> (ReqBody '[JSON] Zone :> PutNoContent))))))
- apiTriggerAxfr :: f :- (Summary "Trigger AXFR" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("axfr-retrieve" :> Put '[JSON] Result))))))
- apiNotifySlaves :: f :- (Summary "Notify slaves" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("notify" :> Put '[JSON] Result))))))
- apiGetZoneAxfr :: f :- (Summary "Get zone AXFR" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("export" :> Get '[JSON] Result))))))
- apiRectifyZone :: f :- (Summary "Rectify zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("rectify" :> Put '[JSON] Result))))))
- data Zone = Zone {
- zone_id :: Maybe Text
- zone_name :: Maybe CIText
- zone_type :: Maybe Text
- zone_url :: Maybe 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 [Text]
- zone_dnssec :: Maybe Bool
- zone_nsec3param :: Maybe Text
- zone_nsec3narrow :: Maybe Bool
- zone_presigned :: Maybe Bool
- zone_soa_edit :: Maybe Text
- zone_soa_edit_api :: Maybe Text
- zone_api_rectify :: Maybe Bool
- zone_zone :: Maybe Text
- zone_account :: Maybe Text
- zone_nameservers :: Maybe [Text]
- zone_master_tsig_key_ids :: Maybe [Text]
- zone_slave_tsig_key_ids :: Maybe [Text]
- data Kind
- data RRSets = RRSets {}
- data RRSet = RRSet {}
- data Record = Record {}
- data Comment = Comment {}
- data 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
- data CIText
- newtype Result = Result Text
- mkCIText :: Text -> CIText
- original :: CIText -> Text
- caseFolded :: CIText -> Text
API
Constructors
ZonesAPI | |
Fields
|
Instances
Generic (ZonesAPI f) Source # | |
type Rep (ZonesAPI f) Source # | |
Defined in PowerDNS.API.Zones type Rep (ZonesAPI f) = D1 ('MetaData "ZonesAPI" "PowerDNS.API.Zones" "powerdns-0.4.4-4F1xBB6Mfb27BKd2dcmgst" 'False) (C1 ('MetaCons "ZonesAPI" 'PrefixI 'True) (((S1 ('MetaSel ('Just "apiListZones") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "List zones" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (QueryParam "zone" Text :> (QueryParam "dnssec" Bool :> Get '[JSON] [Zone])))))))) :*: S1 ('MetaSel ('Just "apiCreateZone") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Create zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (QueryParam "rrset" Bool :> (ReqBody '[JSON] Zone :> PostCreated '[JSON] Zone))))))))) :*: (S1 ('MetaSel ('Just "apiGetZone") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Get zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> (QueryParam "rrsets" Bool :> Get '[JSON] Zone)))))))) :*: (S1 ('MetaSel ('Just "apiDeleteZone") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Delete zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> DeleteNoContent))))))) :*: S1 ('MetaSel ('Just "apiUpdateRecords") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Update records" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> (ReqBody '[JSON] RRSets :> PatchNoContent))))))))))) :*: ((S1 ('MetaSel ('Just "apiUpdateZone") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Update zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> (ReqBody '[JSON] Zone :> PutNoContent)))))))) :*: S1 ('MetaSel ('Just "apiTriggerAxfr") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Trigger AXFR" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("axfr-retrieve" :> Put '[JSON] Result))))))))) :*: (S1 ('MetaSel ('Just "apiNotifySlaves") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Notify slaves" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("notify" :> Put '[JSON] Result)))))))) :*: (S1 ('MetaSel ('Just "apiGetZoneAxfr") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Get zone AXFR" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("export" :> Get '[JSON] Result)))))))) :*: S1 ('MetaSel ('Just "apiRectifyZone") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Rectify zone" :> ("servers" :> (Capture "server_id" Text :> ("zones" :> (Capture "zone_id" Text :> ("rectify" :> Put '[JSON] Result))))))))))))) |
Data types
Zone according to PowerDNS Documentation. 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
Constructors
Zone | |
Fields
|
Instances
Instances
FromJSON Kind Source # | |
Defined in PowerDNS.API.Zones | |
ToJSON Kind Source # | |
Data Kind Source # | |
Defined in PowerDNS.API.Zones Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Kind -> c Kind # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Kind # dataTypeOf :: Kind -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Kind) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Kind) # gmapT :: (forall b. Data b => b -> b) -> Kind -> Kind # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r # gmapQ :: (forall d. Data d => d -> u) -> Kind -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Kind -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Kind -> m Kind # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Kind -> m Kind # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Kind -> m Kind # | |
Generic Kind Source # | |
Read Kind Source # | |
Show Kind Source # | |
NFData Kind Source # | |
Defined in PowerDNS.API.Zones | |
Eq Kind Source # | |
Ord Kind Source # | |
type Rep Kind Source # | |
Defined in PowerDNS.API.Zones |
A list of RRSets
Instances
FromJSON RRSets Source # | |
Defined in PowerDNS.API.Zones | |
ToJSON RRSets Source # | |
Data RRSets Source # | |
Defined in PowerDNS.API.Zones Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> RRSets -> c RRSets # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c RRSets # toConstr :: RRSets -> Constr # dataTypeOf :: RRSets -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c RRSets) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSets) # gmapT :: (forall b. Data b => b -> b) -> RRSets -> RRSets # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r # gmapQ :: (forall d. Data d => d -> u) -> RRSets -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> RRSets -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> RRSets -> m RRSets # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> RRSets -> m RRSets # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> RRSets -> m RRSets # | |
Generic RRSets Source # | |
Read RRSets Source # | |
Show RRSets Source # | |
NFData RRSets Source # | |
Defined in PowerDNS.API.Zones | |
Eq RRSets Source # | |
Ord RRSets Source # | |
type Rep RRSets Source # | |
Defined in PowerDNS.API.Zones |
RRSet according to PowerDNS Documentation.
Note that Eq
and Ord
use limited case-sensitivity on rrset_name
as per RFC4343
Constructors
RRSet | |
Fields
|
Instances
FromJSON RRSet Source # | |
Defined in PowerDNS.API.Zones | |
ToJSON RRSet Source # | |
Data RRSet Source # | |
Defined in PowerDNS.API.Zones Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> RRSet -> c RRSet # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c RRSet # dataTypeOf :: RRSet -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c RRSet) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSet) # gmapT :: (forall b. Data b => b -> b) -> RRSet -> RRSet # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r # gmapQ :: (forall d. Data d => d -> u) -> RRSet -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> RRSet -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> RRSet -> m RRSet # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> RRSet -> m RRSet # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> RRSet -> m RRSet # | |
Generic RRSet Source # | |
Read RRSet Source # | |
Show RRSet Source # | |
NFData RRSet Source # | |
Defined in PowerDNS.API.Zones | |
Eq RRSet Source # | |
Ord RRSet Source # | |
type Rep RRSet Source # | |
Defined in PowerDNS.API.Zones type Rep RRSet = D1 ('MetaData "RRSet" "PowerDNS.API.Zones" "powerdns-0.4.4-4F1xBB6Mfb27BKd2dcmgst" 'False) (C1 ('MetaCons "RRSet" 'PrefixI 'True) ((S1 ('MetaSel ('Just "rrset_name") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CIText) :*: (S1 ('MetaSel ('Just "rrset_type") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RecordType) :*: S1 ('MetaSel ('Just "rrset_ttl") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Word32)))) :*: (S1 ('MetaSel ('Just "rrset_changetype") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe ChangeType)) :*: (S1 ('MetaSel ('Just "rrset_records") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe [Record])) :*: S1 ('MetaSel ('Just "rrset_comments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe [Comment])))))) |
Record according to PowerDNS Documentation
Constructors
Record | |
Fields |
Instances
FromJSON Record Source # | |
Defined in PowerDNS.API.Zones | |
ToJSON Record Source # | |
Data Record Source # | |
Defined in PowerDNS.API.Zones Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Record -> c Record # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Record # toConstr :: Record -> Constr # dataTypeOf :: Record -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Record) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Record) # gmapT :: (forall b. Data b => b -> b) -> Record -> Record # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r # gmapQ :: (forall d. Data d => d -> u) -> Record -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Record -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Record -> m Record # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Record -> m Record # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Record -> m Record # | |
Generic Record Source # | |
Read Record Source # | |
Show Record Source # | |
NFData Record Source # | |
Defined in PowerDNS.API.Zones | |
Eq Record Source # | |
Ord Record Source # | |
type Rep Record Source # | |
Defined in PowerDNS.API.Zones type Rep Record = D1 ('MetaData "Record" "PowerDNS.API.Zones" "powerdns-0.4.4-4F1xBB6Mfb27BKd2dcmgst" 'False) (C1 ('MetaCons "Record" 'PrefixI 'True) (S1 ('MetaSel ('Just "record_content") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "record_disabled") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool))) |
Comment according to PowerDNS Documentation
Constructors
Comment | |
Fields |
Instances
FromJSON Comment Source # | |
Defined in PowerDNS.API.Zones | |
ToJSON Comment Source # | |
Data Comment Source # | |
Defined in PowerDNS.API.Zones Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Comment -> c Comment # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Comment # toConstr :: Comment -> Constr # dataTypeOf :: Comment -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Comment) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment) # gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Comment -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Comment -> r # gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Comment -> m Comment # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment -> m Comment # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment -> m Comment # | |
Generic Comment Source # | |
Read Comment Source # | |
Show Comment Source # | |
NFData Comment Source # | |
Defined in PowerDNS.API.Zones | |
Eq Comment Source # | |
Ord Comment Source # | |
Empty Comment Source # | |
Defined in PowerDNS.API.Zones | |
type Rep Comment Source # | |
Defined in PowerDNS.API.Zones type Rep Comment = D1 ('MetaData "Comment" "PowerDNS.API.Zones" "powerdns-0.4.4-4F1xBB6Mfb27BKd2dcmgst" 'False) (C1 ('MetaCons "Comment" 'PrefixI 'True) (S1 ('MetaSel ('Just "comment_content") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: (S1 ('MetaSel ('Just "comment_account") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "comment_modified_at") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe POSIXTime))))) |
data ChangeType Source #
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.
Instances
data RecordType Source #
Constructors
Instances
Utilities
A wrapper for Text
implementing limited case-sensitivity as per RFC4343.
Use mkCIText
for construction.
See original
and caseFolded
for extracting a Text
back.
Instances
FromJSON CIText Source # | |
Defined in PowerDNS.API.Zones | |
ToJSON CIText Source # | |
Data CIText Source # | |
Defined in PowerDNS.API.Zones Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CIText -> c CIText # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CIText # toConstr :: CIText -> Constr # dataTypeOf :: CIText -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CIText) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CIText) # gmapT :: (forall b. Data b => b -> b) -> CIText -> CIText # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CIText -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CIText -> r # gmapQ :: (forall d. Data d => d -> u) -> CIText -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> CIText -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> CIText -> m CIText # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CIText -> m CIText # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CIText -> m CIText # | |
IsString CIText Source # | |
Defined in PowerDNS.API.Zones Methods fromString :: String -> CIText # | |
Monoid CIText Source # | |
Semigroup CIText Source # | |
Read CIText Source # | |
Show CIText Source # | |
NFData CIText Source # | |
Defined in PowerDNS.API.Zones | |
Eq CIText Source # | |
Ord CIText Source # | |
Hashable CIText Source # | |
Defined in PowerDNS.API.Zones |