-- |
-- 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.Data (Data)
import           Data.Word (Word32)

import           Control.DeepSeq (NFData)
import           Data.Aeson (FromJSON(..), ToJSON(..), allNullaryToStringTag,
                             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
  { ZonesAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("zones"
               :> (QueryParam "zone" Text
                   :> (QueryParam "dnssec" Bool :> Get '[JSON] [Zone])))))
apiListZones     :: f :- "servers" :> Capture "server_id" T.Text :> "zones"
                          :> QueryParam "zone" T.Text
                          :> QueryParam "dnssec" Bool
                          :> Get '[JSON] [Zone]

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

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

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

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

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

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

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

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

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

  } deriving (forall x. ZonesAPI f -> Rep (ZonesAPI f) x)
-> (forall x. Rep (ZonesAPI f) x -> ZonesAPI f)
-> Generic (ZonesAPI f)
forall x. Rep (ZonesAPI f) x -> ZonesAPI f
forall x. ZonesAPI f -> Rep (ZonesAPI f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall f x. Rep (ZonesAPI f) x -> ZonesAPI f
forall f x. ZonesAPI f -> Rep (ZonesAPI f) x
$cto :: forall f x. Rep (ZonesAPI f) x -> ZonesAPI f
$cfrom :: forall f x. ZonesAPI f -> Rep (ZonesAPI f) x
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.
data Zone = Zone
  { Zone -> Maybe Text
zone_id :: Maybe T.Text
  , Zone -> Maybe Text
zone_name :: Maybe T.Text
  , Zone -> Maybe Text
zone_type :: Maybe T.Text
  , Zone -> Maybe Text
zone_url :: Maybe T.Text
  , Zone -> Maybe Kind
zone_kind :: Maybe Kind
  , Zone -> Maybe [RRSet]
zone_rrsets :: Maybe [RRSet]
  , Zone -> Maybe Integer
zone_serial :: Maybe Integer
  , Zone -> Maybe Integer
zone_notified_serial :: Maybe Integer
  , Zone -> Maybe Integer
zone_edited_serial :: Maybe Integer
  , Zone -> Maybe [Text]
zone_masters :: Maybe [T.Text]
  , Zone -> Maybe Bool
zone_dnssec :: Maybe Bool
  , Zone -> Maybe Text
zone_nsec3param :: Maybe T.Text
  , Zone -> Maybe Bool
zone_nsec3narrow :: Maybe Bool
  , Zone -> Maybe Bool
zone_presigned :: Maybe Bool
  , Zone -> Maybe Text
zone_soa_edit :: Maybe T.Text
  , Zone -> Maybe Text
zone_soa_edit_api :: Maybe T.Text
  , Zone -> Maybe Bool
zone_api_rectify :: Maybe Bool
  , Zone -> Maybe Text
zone_zone :: Maybe T.Text
  , Zone -> Maybe Text
zone_account :: Maybe T.Text
  , Zone -> Maybe [Text]
zone_nameservers :: Maybe [T.Text]
  , Zone -> Maybe [Text]
zone_master_tsig_key_ids :: Maybe [T.Text]
  , Zone -> Maybe [Text]
zone_slave_tsig_key_ids :: Maybe [T.Text]
  } deriving (Zone -> Zone -> Bool
(Zone -> Zone -> Bool) -> (Zone -> Zone -> Bool) -> Eq Zone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zone -> Zone -> Bool
$c/= :: Zone -> Zone -> Bool
== :: Zone -> Zone -> Bool
$c== :: Zone -> Zone -> Bool
Eq, Eq Zone
Eq Zone =>
(Zone -> Zone -> Ordering)
-> (Zone -> Zone -> Bool)
-> (Zone -> Zone -> Bool)
-> (Zone -> Zone -> Bool)
-> (Zone -> Zone -> Bool)
-> (Zone -> Zone -> Zone)
-> (Zone -> Zone -> Zone)
-> Ord Zone
Zone -> Zone -> Bool
Zone -> Zone -> Ordering
Zone -> Zone -> Zone
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Zone -> Zone -> Zone
$cmin :: Zone -> Zone -> Zone
max :: Zone -> Zone -> Zone
$cmax :: Zone -> Zone -> Zone
>= :: Zone -> Zone -> Bool
$c>= :: Zone -> Zone -> Bool
> :: Zone -> Zone -> Bool
$c> :: Zone -> Zone -> Bool
<= :: Zone -> Zone -> Bool
$c<= :: Zone -> Zone -> Bool
< :: Zone -> Zone -> Bool
$c< :: Zone -> Zone -> Bool
compare :: Zone -> Zone -> Ordering
$ccompare :: Zone -> Zone -> Ordering
$cp1Ord :: Eq Zone
Ord, Int -> Zone -> ShowS
[Zone] -> ShowS
Zone -> String
(Int -> Zone -> ShowS)
-> (Zone -> String) -> ([Zone] -> ShowS) -> Show Zone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Zone] -> ShowS
$cshowList :: [Zone] -> ShowS
show :: Zone -> String
$cshow :: Zone -> String
showsPrec :: Int -> Zone -> ShowS
$cshowsPrec :: Int -> Zone -> ShowS
Show, (forall x. Zone -> Rep Zone x)
-> (forall x. Rep Zone x -> Zone) -> Generic Zone
forall x. Rep Zone x -> Zone
forall x. Zone -> Rep Zone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Zone x -> Zone
$cfrom :: forall x. Zone -> Rep Zone x
Generic, Zone -> ()
(Zone -> ()) -> NFData Zone
forall a. (a -> ()) -> NFData a
rnf :: Zone -> ()
$crnf :: Zone -> ()
NFData, Typeable Zone
DataType
Constr
Typeable Zone =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Zone -> c Zone)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Zone)
-> (Zone -> Constr)
-> (Zone -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Zone))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zone))
-> ((forall b. Data b => b -> b) -> Zone -> Zone)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r)
-> (forall u. (forall d. Data d => d -> u) -> Zone -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Zone -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Zone -> m Zone)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Zone -> m Zone)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Zone -> m Zone)
-> Data Zone
Zone -> DataType
Zone -> Constr
(forall b. Data b => b -> b) -> Zone -> Zone
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zone -> c Zone
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zone
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Zone -> u
forall u. (forall d. Data d => d -> u) -> Zone -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Zone -> m Zone
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zone -> m Zone
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zone
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zone -> c Zone
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Zone)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zone)
$cZone :: Constr
$tZone :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Zone -> m Zone
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zone -> m Zone
gmapMp :: (forall d. Data d => d -> m d) -> Zone -> m Zone
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Zone -> m Zone
gmapM :: (forall d. Data d => d -> m d) -> Zone -> m Zone
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Zone -> m Zone
gmapQi :: Int -> (forall d. Data d => d -> u) -> Zone -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Zone -> u
gmapQ :: (forall d. Data d => d -> u) -> Zone -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Zone -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Zone -> r
gmapT :: (forall b. Data b => b -> b) -> Zone -> Zone
$cgmapT :: (forall b. Data b => b -> b) -> Zone -> Zone
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zone)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Zone)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Zone)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Zone)
dataTypeOf :: Zone -> DataType
$cdataTypeOf :: Zone -> DataType
toConstr :: Zone -> Constr
$ctoConstr :: Zone -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zone
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Zone
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zone -> c Zone
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Zone -> c Zone
$cp1Data :: Typeable Zone
Data, Zone
Zone -> Empty Zone
forall a. a -> Empty a
empty :: Zone
$cempty :: Zone
Empty)

instance ToJSON Zone where
  toJSON :: Zone -> Value
toJSON = Options -> Zone -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "zone_"}

instance FromJSON Zone where
  parseJSON :: Value -> Parser Zone
parseJSON = Options -> Value -> Parser Zone
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "zone_"}

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

data Kind = Native | Master | Slave
  deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c== :: Kind -> Kind -> Bool
Eq, Eq Kind
Eq Kind =>
(Kind -> Kind -> Ordering)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Kind)
-> (Kind -> Kind -> Kind)
-> Ord Kind
Kind -> Kind -> Bool
Kind -> Kind -> Ordering
Kind -> Kind -> Kind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Kind -> Kind -> Kind
$cmin :: Kind -> Kind -> Kind
max :: Kind -> Kind -> Kind
$cmax :: Kind -> Kind -> Kind
>= :: Kind -> Kind -> Bool
$c>= :: Kind -> Kind -> Bool
> :: Kind -> Kind -> Bool
$c> :: Kind -> Kind -> Bool
<= :: Kind -> Kind -> Bool
$c<= :: Kind -> Kind -> Bool
< :: Kind -> Kind -> Bool
$c< :: Kind -> Kind -> Bool
compare :: Kind -> Kind -> Ordering
$ccompare :: Kind -> Kind -> Ordering
$cp1Ord :: Eq Kind
Ord, Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kind] -> ShowS
$cshowList :: [Kind] -> ShowS
show :: Kind -> String
$cshow :: Kind -> String
showsPrec :: Int -> Kind -> ShowS
$cshowsPrec :: Int -> Kind -> ShowS
Show, (forall x. Kind -> Rep Kind x)
-> (forall x. Rep Kind x -> Kind) -> Generic Kind
forall x. Rep Kind x -> Kind
forall x. Kind -> Rep Kind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Kind x -> Kind
$cfrom :: forall x. Kind -> Rep Kind x
Generic, Kind -> ()
(Kind -> ()) -> NFData Kind
forall a. (a -> ()) -> NFData a
rnf :: Kind -> ()
$crnf :: Kind -> ()
NFData, Typeable Kind
DataType
Constr
Typeable Kind =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Kind -> c Kind)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Kind)
-> (Kind -> Constr)
-> (Kind -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Kind))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Kind))
-> ((forall b. Data b => b -> b) -> Kind -> Kind)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r)
-> (forall u. (forall d. Data d => d -> u) -> Kind -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Kind -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Kind -> m Kind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Kind -> m Kind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Kind -> m Kind)
-> Data Kind
Kind -> DataType
Kind -> Constr
(forall b. Data b => b -> b) -> Kind -> Kind
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Kind -> c Kind
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Kind
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Kind -> u
forall u. (forall d. Data d => d -> u) -> Kind -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Kind -> m Kind
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Kind -> m Kind
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Kind
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Kind -> c Kind
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Kind)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Kind)
$cSlave :: Constr
$cMaster :: Constr
$cNative :: Constr
$tKind :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Kind -> m Kind
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Kind -> m Kind
gmapMp :: (forall d. Data d => d -> m d) -> Kind -> m Kind
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Kind -> m Kind
gmapM :: (forall d. Data d => d -> m d) -> Kind -> m Kind
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Kind -> m Kind
gmapQi :: Int -> (forall d. Data d => d -> u) -> Kind -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Kind -> u
gmapQ :: (forall d. Data d => d -> u) -> Kind -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Kind -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Kind -> r
gmapT :: (forall b. Data b => b -> b) -> Kind -> Kind
$cgmapT :: (forall b. Data b => b -> b) -> Kind -> Kind
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Kind)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Kind)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Kind)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Kind)
dataTypeOf :: Kind -> DataType
$cdataTypeOf :: Kind -> DataType
toConstr :: Kind -> Constr
$ctoConstr :: Kind -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Kind
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Kind
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Kind -> c Kind
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Kind -> c Kind
$cp1Data :: Typeable Kind
Data)

instance ToJSON Kind where
  toJSON :: Kind -> Value
toJSON = Options -> Kind -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper
                                        , allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }

instance FromJSON Kind where
  parseJSON :: Value -> Parser Kind
parseJSON = Options -> Value -> Parser Kind
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper
                                              , allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }

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

-- | A list of RRSets
data RRSets = RRSets
  { RRSets -> [RRSet]
rrsets :: [RRSet]
  } deriving (RRSets -> RRSets -> Bool
(RRSets -> RRSets -> Bool)
-> (RRSets -> RRSets -> Bool) -> Eq RRSets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RRSets -> RRSets -> Bool
$c/= :: RRSets -> RRSets -> Bool
== :: RRSets -> RRSets -> Bool
$c== :: RRSets -> RRSets -> Bool
Eq, Eq RRSets
Eq RRSets =>
(RRSets -> RRSets -> Ordering)
-> (RRSets -> RRSets -> Bool)
-> (RRSets -> RRSets -> Bool)
-> (RRSets -> RRSets -> Bool)
-> (RRSets -> RRSets -> Bool)
-> (RRSets -> RRSets -> RRSets)
-> (RRSets -> RRSets -> RRSets)
-> Ord RRSets
RRSets -> RRSets -> Bool
RRSets -> RRSets -> Ordering
RRSets -> RRSets -> RRSets
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RRSets -> RRSets -> RRSets
$cmin :: RRSets -> RRSets -> RRSets
max :: RRSets -> RRSets -> RRSets
$cmax :: RRSets -> RRSets -> RRSets
>= :: RRSets -> RRSets -> Bool
$c>= :: RRSets -> RRSets -> Bool
> :: RRSets -> RRSets -> Bool
$c> :: RRSets -> RRSets -> Bool
<= :: RRSets -> RRSets -> Bool
$c<= :: RRSets -> RRSets -> Bool
< :: RRSets -> RRSets -> Bool
$c< :: RRSets -> RRSets -> Bool
compare :: RRSets -> RRSets -> Ordering
$ccompare :: RRSets -> RRSets -> Ordering
$cp1Ord :: Eq RRSets
Ord, Int -> RRSets -> ShowS
[RRSets] -> ShowS
RRSets -> String
(Int -> RRSets -> ShowS)
-> (RRSets -> String) -> ([RRSets] -> ShowS) -> Show RRSets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RRSets] -> ShowS
$cshowList :: [RRSets] -> ShowS
show :: RRSets -> String
$cshow :: RRSets -> String
showsPrec :: Int -> RRSets -> ShowS
$cshowsPrec :: Int -> RRSets -> ShowS
Show, (forall x. RRSets -> Rep RRSets x)
-> (forall x. Rep RRSets x -> RRSets) -> Generic RRSets
forall x. Rep RRSets x -> RRSets
forall x. RRSets -> Rep RRSets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RRSets x -> RRSets
$cfrom :: forall x. RRSets -> Rep RRSets x
Generic, RRSets -> ()
(RRSets -> ()) -> NFData RRSets
forall a. (a -> ()) -> NFData a
rnf :: RRSets -> ()
$crnf :: RRSets -> ()
NFData, Typeable RRSets
DataType
Constr
Typeable RRSets =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RRSets -> c RRSets)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RRSets)
-> (RRSets -> Constr)
-> (RRSets -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RRSets))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSets))
-> ((forall b. Data b => b -> b) -> RRSets -> RRSets)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RRSets -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RRSets -> r)
-> (forall u. (forall d. Data d => d -> u) -> RRSets -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RRSets -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RRSets -> m RRSets)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RRSets -> m RRSets)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RRSets -> m RRSets)
-> Data RRSets
RRSets -> DataType
RRSets -> Constr
(forall b. Data b => b -> b) -> RRSets -> RRSets
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSets -> c RRSets
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSets
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RRSets -> u
forall u. (forall d. Data d => d -> u) -> RRSets -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RRSets -> m RRSets
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RRSets -> m RRSets
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSets
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSets -> c RRSets
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RRSets)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSets)
$cRRSets :: Constr
$tRRSets :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RRSets -> m RRSets
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RRSets -> m RRSets
gmapMp :: (forall d. Data d => d -> m d) -> RRSets -> m RRSets
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RRSets -> m RRSets
gmapM :: (forall d. Data d => d -> m d) -> RRSets -> m RRSets
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RRSets -> m RRSets
gmapQi :: Int -> (forall d. Data d => d -> u) -> RRSets -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RRSets -> u
gmapQ :: (forall d. Data d => d -> u) -> RRSets -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RRSets -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSets -> r
gmapT :: (forall b. Data b => b -> b) -> RRSets -> RRSets
$cgmapT :: (forall b. Data b => b -> b) -> RRSets -> RRSets
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSets)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSets)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RRSets)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RRSets)
dataTypeOf :: RRSets -> DataType
$cdataTypeOf :: RRSets -> DataType
toConstr :: RRSets -> Constr
$ctoConstr :: RRSets -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSets
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSets
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSets -> c RRSets
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSets -> c RRSets
$cp1Data :: Typeable RRSets
Data)

instance ToJSON RRSets
instance FromJSON RRSets

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

-- | RRSet according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#rrset).
data RRSet = RRSet
  { RRSet -> Text
rrset_name :: T.Text
  , RRSet -> RecordType
rrset_type :: RecordType
  , RRSet -> Word32
rrset_ttl :: Word32
  , RRSet -> Maybe ChangeType
rrset_changetype :: Maybe ChangeType
  , RRSet -> Maybe [Record]
rrset_records :: Maybe [Record]
  , RRSet -> Maybe [Comment]
rrset_comments :: Maybe [Comment]
  } deriving (RRSet -> RRSet -> Bool
(RRSet -> RRSet -> Bool) -> (RRSet -> RRSet -> Bool) -> Eq RRSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RRSet -> RRSet -> Bool
$c/= :: RRSet -> RRSet -> Bool
== :: RRSet -> RRSet -> Bool
$c== :: RRSet -> RRSet -> Bool
Eq, Eq RRSet
Eq RRSet =>
(RRSet -> RRSet -> Ordering)
-> (RRSet -> RRSet -> Bool)
-> (RRSet -> RRSet -> Bool)
-> (RRSet -> RRSet -> Bool)
-> (RRSet -> RRSet -> Bool)
-> (RRSet -> RRSet -> RRSet)
-> (RRSet -> RRSet -> RRSet)
-> Ord RRSet
RRSet -> RRSet -> Bool
RRSet -> RRSet -> Ordering
RRSet -> RRSet -> RRSet
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RRSet -> RRSet -> RRSet
$cmin :: RRSet -> RRSet -> RRSet
max :: RRSet -> RRSet -> RRSet
$cmax :: RRSet -> RRSet -> RRSet
>= :: RRSet -> RRSet -> Bool
$c>= :: RRSet -> RRSet -> Bool
> :: RRSet -> RRSet -> Bool
$c> :: RRSet -> RRSet -> Bool
<= :: RRSet -> RRSet -> Bool
$c<= :: RRSet -> RRSet -> Bool
< :: RRSet -> RRSet -> Bool
$c< :: RRSet -> RRSet -> Bool
compare :: RRSet -> RRSet -> Ordering
$ccompare :: RRSet -> RRSet -> Ordering
$cp1Ord :: Eq RRSet
Ord, Int -> RRSet -> ShowS
[RRSet] -> ShowS
RRSet -> String
(Int -> RRSet -> ShowS)
-> (RRSet -> String) -> ([RRSet] -> ShowS) -> Show RRSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RRSet] -> ShowS
$cshowList :: [RRSet] -> ShowS
show :: RRSet -> String
$cshow :: RRSet -> String
showsPrec :: Int -> RRSet -> ShowS
$cshowsPrec :: Int -> RRSet -> ShowS
Show, (forall x. RRSet -> Rep RRSet x)
-> (forall x. Rep RRSet x -> RRSet) -> Generic RRSet
forall x. Rep RRSet x -> RRSet
forall x. RRSet -> Rep RRSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RRSet x -> RRSet
$cfrom :: forall x. RRSet -> Rep RRSet x
Generic, RRSet -> ()
(RRSet -> ()) -> NFData RRSet
forall a. (a -> ()) -> NFData a
rnf :: RRSet -> ()
$crnf :: RRSet -> ()
NFData, Typeable RRSet
DataType
Constr
Typeable RRSet =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RRSet -> c RRSet)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RRSet)
-> (RRSet -> Constr)
-> (RRSet -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RRSet))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSet))
-> ((forall b. Data b => b -> b) -> RRSet -> RRSet)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r)
-> (forall u. (forall d. Data d => d -> u) -> RRSet -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RRSet -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RRSet -> m RRSet)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RRSet -> m RRSet)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RRSet -> m RRSet)
-> Data RRSet
RRSet -> DataType
RRSet -> Constr
(forall b. Data b => b -> b) -> RRSet -> RRSet
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSet -> c RRSet
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSet
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RRSet -> u
forall u. (forall d. Data d => d -> u) -> RRSet -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RRSet -> m RRSet
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RRSet -> m RRSet
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSet
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSet -> c RRSet
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RRSet)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSet)
$cRRSet :: Constr
$tRRSet :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RRSet -> m RRSet
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RRSet -> m RRSet
gmapMp :: (forall d. Data d => d -> m d) -> RRSet -> m RRSet
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RRSet -> m RRSet
gmapM :: (forall d. Data d => d -> m d) -> RRSet -> m RRSet
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RRSet -> m RRSet
gmapQi :: Int -> (forall d. Data d => d -> u) -> RRSet -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RRSet -> u
gmapQ :: (forall d. Data d => d -> u) -> RRSet -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RRSet -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RRSet -> r
gmapT :: (forall b. Data b => b -> b) -> RRSet -> RRSet
$cgmapT :: (forall b. Data b => b -> b) -> RRSet -> RRSet
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSet)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RRSet)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RRSet)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RRSet)
dataTypeOf :: RRSet -> DataType
$cdataTypeOf :: RRSet -> DataType
toConstr :: RRSet -> Constr
$ctoConstr :: RRSet -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSet
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RRSet
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSet -> c RRSet
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RRSet -> c RRSet
$cp1Data :: Typeable RRSet
Data)

instance ToJSON RRSet where
  toJSON :: RRSet -> Value
toJSON = Options -> RRSet -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "rrset_"
                                        , omitNothingFields :: Bool
omitNothingFields = Bool
True }

instance FromJSON RRSet where
  parseJSON :: Value -> Parser RRSet
parseJSON = Options -> Value -> Parser RRSet
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "rrset_"
                                              , omitNothingFields :: Bool
omitNothingFields = Bool
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 (RecordType -> RecordType -> Bool
(RecordType -> RecordType -> Bool)
-> (RecordType -> RecordType -> Bool) -> Eq RecordType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordType -> RecordType -> Bool
$c/= :: RecordType -> RecordType -> Bool
== :: RecordType -> RecordType -> Bool
$c== :: RecordType -> RecordType -> Bool
Eq, Eq RecordType
Eq RecordType =>
(RecordType -> RecordType -> Ordering)
-> (RecordType -> RecordType -> Bool)
-> (RecordType -> RecordType -> Bool)
-> (RecordType -> RecordType -> Bool)
-> (RecordType -> RecordType -> Bool)
-> (RecordType -> RecordType -> RecordType)
-> (RecordType -> RecordType -> RecordType)
-> Ord RecordType
RecordType -> RecordType -> Bool
RecordType -> RecordType -> Ordering
RecordType -> RecordType -> RecordType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RecordType -> RecordType -> RecordType
$cmin :: RecordType -> RecordType -> RecordType
max :: RecordType -> RecordType -> RecordType
$cmax :: RecordType -> RecordType -> RecordType
>= :: RecordType -> RecordType -> Bool
$c>= :: RecordType -> RecordType -> Bool
> :: RecordType -> RecordType -> Bool
$c> :: RecordType -> RecordType -> Bool
<= :: RecordType -> RecordType -> Bool
$c<= :: RecordType -> RecordType -> Bool
< :: RecordType -> RecordType -> Bool
$c< :: RecordType -> RecordType -> Bool
compare :: RecordType -> RecordType -> Ordering
$ccompare :: RecordType -> RecordType -> Ordering
$cp1Ord :: Eq RecordType
Ord, Int -> RecordType -> ShowS
[RecordType] -> ShowS
RecordType -> String
(Int -> RecordType -> ShowS)
-> (RecordType -> String)
-> ([RecordType] -> ShowS)
-> Show RecordType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordType] -> ShowS
$cshowList :: [RecordType] -> ShowS
show :: RecordType -> String
$cshow :: RecordType -> String
showsPrec :: Int -> RecordType -> ShowS
$cshowsPrec :: Int -> RecordType -> ShowS
Show, (forall x. RecordType -> Rep RecordType x)
-> (forall x. Rep RecordType x -> RecordType) -> Generic RecordType
forall x. Rep RecordType x -> RecordType
forall x. RecordType -> Rep RecordType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecordType x -> RecordType
$cfrom :: forall x. RecordType -> Rep RecordType x
Generic, RecordType -> ()
(RecordType -> ()) -> NFData RecordType
forall a. (a -> ()) -> NFData a
rnf :: RecordType -> ()
$crnf :: RecordType -> ()
NFData, Typeable RecordType
DataType
Constr
Typeable RecordType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RecordType -> c RecordType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecordType)
-> (RecordType -> Constr)
-> (RecordType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecordType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecordType))
-> ((forall b. Data b => b -> b) -> RecordType -> RecordType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecordType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecordType -> r)
-> (forall u. (forall d. Data d => d -> u) -> RecordType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecordType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RecordType -> m RecordType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecordType -> m RecordType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecordType -> m RecordType)
-> Data RecordType
RecordType -> DataType
RecordType -> Constr
(forall b. Data b => b -> b) -> RecordType -> RecordType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecordType -> c RecordType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecordType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RecordType -> u
forall u. (forall d. Data d => d -> u) -> RecordType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecordType -> m RecordType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecordType -> m RecordType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecordType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecordType -> c RecordType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecordType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RecordType)
$cWKS :: Constr
$cSIG :: Constr
$cRKEY :: Constr
$cMR :: Constr
$cMINFO :: Constr
$cMAILB :: Constr
$cMAILA :: Constr
$cKX :: Constr
$cIPSECKEY :: Constr
$cEUI64 :: Constr
$cEUI48 :: Constr
$cDLV :: Constr
$cDHCID :: Constr
$cA6 :: Constr
$cURI :: Constr
$cTXT :: Constr
$cSMIMEA :: Constr
$cTLSA :: Constr
$cTSIG :: Constr
$cTKEY :: Constr
$cSRV :: Constr
$cSSHFP :: Constr
$cSPF :: Constr
$cSOA :: Constr
$cRRSIG :: Constr
$cRP :: Constr
$cPTR :: Constr
$cOPENPGPKEY :: Constr
$cNSEC3PARAM :: Constr
$cNSEC3 :: Constr
$cNSEC :: Constr
$cNS :: Constr
$cNAPTR :: Constr
$cMX :: Constr
$cLOC :: Constr
$cKEY :: Constr
$cHINFO :: Constr
$cDS :: Constr
$cDNAME :: Constr
$cDNSKEY :: Constr
$cCNAME :: Constr
$cCDS :: Constr
$cCDNSKEY :: Constr
$cCERT :: Constr
$cCAA :: Constr
$cAPL :: Constr
$cALIAS :: Constr
$cAFSDB :: Constr
$cAAAA :: Constr
$cA :: Constr
$tRecordType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RecordType -> m RecordType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecordType -> m RecordType
gmapMp :: (forall d. Data d => d -> m d) -> RecordType -> m RecordType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecordType -> m RecordType
gmapM :: (forall d. Data d => d -> m d) -> RecordType -> m RecordType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecordType -> m RecordType
gmapQi :: Int -> (forall d. Data d => d -> u) -> RecordType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecordType -> u
gmapQ :: (forall d. Data d => d -> u) -> RecordType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecordType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordType -> r
gmapT :: (forall b. Data b => b -> b) -> RecordType -> RecordType
$cgmapT :: (forall b. Data b => b -> b) -> RecordType -> RecordType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RecordType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RecordType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RecordType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecordType)
dataTypeOf :: RecordType -> DataType
$cdataTypeOf :: RecordType -> DataType
toConstr :: RecordType -> Constr
$ctoConstr :: RecordType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecordType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecordType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecordType -> c RecordType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecordType -> c RecordType
$cp1Data :: Typeable RecordType
Data)

instance ToJSON RecordType where
  toJSON :: RecordType -> Value
toJSON = Options -> RecordType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True
                                        }

instance FromJSON RecordType where
  parseJSON :: Value -> Parser RecordType
parseJSON = Options -> Value -> Parser RecordType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
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 (ChangeType -> ChangeType -> Bool
(ChangeType -> ChangeType -> Bool)
-> (ChangeType -> ChangeType -> Bool) -> Eq ChangeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeType -> ChangeType -> Bool
$c/= :: ChangeType -> ChangeType -> Bool
== :: ChangeType -> ChangeType -> Bool
$c== :: ChangeType -> ChangeType -> Bool
Eq, Eq ChangeType
Eq ChangeType =>
(ChangeType -> ChangeType -> Ordering)
-> (ChangeType -> ChangeType -> Bool)
-> (ChangeType -> ChangeType -> Bool)
-> (ChangeType -> ChangeType -> Bool)
-> (ChangeType -> ChangeType -> Bool)
-> (ChangeType -> ChangeType -> ChangeType)
-> (ChangeType -> ChangeType -> ChangeType)
-> Ord ChangeType
ChangeType -> ChangeType -> Bool
ChangeType -> ChangeType -> Ordering
ChangeType -> ChangeType -> ChangeType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChangeType -> ChangeType -> ChangeType
$cmin :: ChangeType -> ChangeType -> ChangeType
max :: ChangeType -> ChangeType -> ChangeType
$cmax :: ChangeType -> ChangeType -> ChangeType
>= :: ChangeType -> ChangeType -> Bool
$c>= :: ChangeType -> ChangeType -> Bool
> :: ChangeType -> ChangeType -> Bool
$c> :: ChangeType -> ChangeType -> Bool
<= :: ChangeType -> ChangeType -> Bool
$c<= :: ChangeType -> ChangeType -> Bool
< :: ChangeType -> ChangeType -> Bool
$c< :: ChangeType -> ChangeType -> Bool
compare :: ChangeType -> ChangeType -> Ordering
$ccompare :: ChangeType -> ChangeType -> Ordering
$cp1Ord :: Eq ChangeType
Ord, Int -> ChangeType -> ShowS
[ChangeType] -> ShowS
ChangeType -> String
(Int -> ChangeType -> ShowS)
-> (ChangeType -> String)
-> ([ChangeType] -> ShowS)
-> Show ChangeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeType] -> ShowS
$cshowList :: [ChangeType] -> ShowS
show :: ChangeType -> String
$cshow :: ChangeType -> String
showsPrec :: Int -> ChangeType -> ShowS
$cshowsPrec :: Int -> ChangeType -> ShowS
Show, (forall x. ChangeType -> Rep ChangeType x)
-> (forall x. Rep ChangeType x -> ChangeType) -> Generic ChangeType
forall x. Rep ChangeType x -> ChangeType
forall x. ChangeType -> Rep ChangeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangeType x -> ChangeType
$cfrom :: forall x. ChangeType -> Rep ChangeType x
Generic, ChangeType -> ()
(ChangeType -> ()) -> NFData ChangeType
forall a. (a -> ()) -> NFData a
rnf :: ChangeType -> ()
$crnf :: ChangeType -> ()
NFData, Typeable ChangeType
DataType
Constr
Typeable ChangeType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ChangeType -> c ChangeType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChangeType)
-> (ChangeType -> Constr)
-> (ChangeType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ChangeType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChangeType))
-> ((forall b. Data b => b -> b) -> ChangeType -> ChangeType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ChangeType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ChangeType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ChangeType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ChangeType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ChangeType -> m ChangeType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ChangeType -> m ChangeType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ChangeType -> m ChangeType)
-> Data ChangeType
ChangeType -> DataType
ChangeType -> Constr
(forall b. Data b => b -> b) -> ChangeType -> ChangeType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChangeType -> c ChangeType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangeType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ChangeType -> u
forall u. (forall d. Data d => d -> u) -> ChangeType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChangeType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChangeType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangeType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChangeType -> c ChangeType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChangeType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ChangeType)
$cDelete :: Constr
$cReplace :: Constr
$tChangeType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
gmapMp :: (forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
gmapM :: (forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ChangeType -> m ChangeType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ChangeType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ChangeType -> u
gmapQ :: (forall d. Data d => d -> u) -> ChangeType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ChangeType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChangeType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChangeType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChangeType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChangeType -> r
gmapT :: (forall b. Data b => b -> b) -> ChangeType -> ChangeType
$cgmapT :: (forall b. Data b => b -> b) -> ChangeType -> ChangeType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ChangeType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ChangeType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ChangeType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChangeType)
dataTypeOf :: ChangeType -> DataType
$cdataTypeOf :: ChangeType -> DataType
toConstr :: ChangeType -> Constr
$ctoConstr :: ChangeType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangeType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChangeType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChangeType -> c ChangeType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChangeType -> c ChangeType
$cp1Data :: Typeable ChangeType
Data)

instance ToJSON ChangeType where
  toJSON :: ChangeType -> Value
toJSON = Options -> ChangeType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper
                                        , allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }

instance FromJSON ChangeType where
  parseJSON :: Value -> Parser ChangeType
parseJSON = Options -> Value -> Parser ChangeType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper
                                              , allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True }

----------------------------------------------------------------------------------------
-- | Record according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#record)
data Record = Record
  { Record -> Text
record_content :: T.Text
  , Record -> Bool
record_disabled :: Bool
  } deriving (Record -> Record -> Bool
(Record -> Record -> Bool)
-> (Record -> Record -> Bool) -> Eq Record
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Record -> Record -> Bool
$c/= :: Record -> Record -> Bool
== :: Record -> Record -> Bool
$c== :: Record -> Record -> Bool
Eq, Eq Record
Eq Record =>
(Record -> Record -> Ordering)
-> (Record -> Record -> Bool)
-> (Record -> Record -> Bool)
-> (Record -> Record -> Bool)
-> (Record -> Record -> Bool)
-> (Record -> Record -> Record)
-> (Record -> Record -> Record)
-> Ord Record
Record -> Record -> Bool
Record -> Record -> Ordering
Record -> Record -> Record
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Record -> Record -> Record
$cmin :: Record -> Record -> Record
max :: Record -> Record -> Record
$cmax :: Record -> Record -> Record
>= :: Record -> Record -> Bool
$c>= :: Record -> Record -> Bool
> :: Record -> Record -> Bool
$c> :: Record -> Record -> Bool
<= :: Record -> Record -> Bool
$c<= :: Record -> Record -> Bool
< :: Record -> Record -> Bool
$c< :: Record -> Record -> Bool
compare :: Record -> Record -> Ordering
$ccompare :: Record -> Record -> Ordering
$cp1Ord :: Eq Record
Ord, Int -> Record -> ShowS
[Record] -> ShowS
Record -> String
(Int -> Record -> ShowS)
-> (Record -> String) -> ([Record] -> ShowS) -> Show Record
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Record] -> ShowS
$cshowList :: [Record] -> ShowS
show :: Record -> String
$cshow :: Record -> String
showsPrec :: Int -> Record -> ShowS
$cshowsPrec :: Int -> Record -> ShowS
Show, (forall x. Record -> Rep Record x)
-> (forall x. Rep Record x -> Record) -> Generic Record
forall x. Rep Record x -> Record
forall x. Record -> Rep Record x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Record x -> Record
$cfrom :: forall x. Record -> Rep Record x
Generic, Record -> ()
(Record -> ()) -> NFData Record
forall a. (a -> ()) -> NFData a
rnf :: Record -> ()
$crnf :: Record -> ()
NFData, Typeable Record
DataType
Constr
Typeable Record =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Record -> c Record)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Record)
-> (Record -> Constr)
-> (Record -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Record))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Record))
-> ((forall b. Data b => b -> b) -> Record -> Record)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Record -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Record -> r)
-> (forall u. (forall d. Data d => d -> u) -> Record -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Record -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Record -> m Record)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Record -> m Record)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Record -> m Record)
-> Data Record
Record -> DataType
Record -> Constr
(forall b. Data b => b -> b) -> Record -> Record
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Record -> c Record
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Record
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Record -> u
forall u. (forall d. Data d => d -> u) -> Record -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Record -> m Record
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Record -> m Record
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Record
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Record -> c Record
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Record)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Record)
$cRecord :: Constr
$tRecord :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Record -> m Record
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Record -> m Record
gmapMp :: (forall d. Data d => d -> m d) -> Record -> m Record
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Record -> m Record
gmapM :: (forall d. Data d => d -> m d) -> Record -> m Record
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Record -> m Record
gmapQi :: Int -> (forall d. Data d => d -> u) -> Record -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Record -> u
gmapQ :: (forall d. Data d => d -> u) -> Record -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Record -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Record -> r
gmapT :: (forall b. Data b => b -> b) -> Record -> Record
$cgmapT :: (forall b. Data b => b -> b) -> Record -> Record
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Record)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Record)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Record)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Record)
dataTypeOf :: Record -> DataType
$cdataTypeOf :: Record -> DataType
toConstr :: Record -> Constr
$ctoConstr :: Record -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Record
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Record
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Record -> c Record
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Record -> c Record
$cp1Data :: Typeable Record
Data)

instance ToJSON Record where
  toJSON :: Record -> Value
toJSON = Options -> Record -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "record_"
                                        , omitNothingFields :: Bool
omitNothingFields = Bool
True }

instance FromJSON Record where
  parseJSON :: Value -> Parser Record
parseJSON = Options -> Value -> Parser Record
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "record_"
                                              , omitNothingFields :: Bool
omitNothingFields = Bool
True }

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

-- | Comment according to [PowerDNS Documentation](https://doc.powerdns.com/authoritative/http-api/zone.html#comment)
data Comment = Comment
  { Comment -> Maybe Text
comment_content :: Maybe T.Text
  , Comment -> Maybe Text
comment_account :: Maybe T.Text
  , Comment -> Maybe POSIXTime
commant_modified_at :: Maybe POSIXTime
  } deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq, Eq Comment
Eq Comment =>
(Comment -> Comment -> Ordering)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Comment)
-> (Comment -> Comment -> Comment)
-> Ord Comment
Comment -> Comment -> Bool
Comment -> Comment -> Ordering
Comment -> Comment -> Comment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Comment -> Comment -> Comment
$cmin :: Comment -> Comment -> Comment
max :: Comment -> Comment -> Comment
$cmax :: Comment -> Comment -> Comment
>= :: Comment -> Comment -> Bool
$c>= :: Comment -> Comment -> Bool
> :: Comment -> Comment -> Bool
$c> :: Comment -> Comment -> Bool
<= :: Comment -> Comment -> Bool
$c<= :: Comment -> Comment -> Bool
< :: Comment -> Comment -> Bool
$c< :: Comment -> Comment -> Bool
compare :: Comment -> Comment -> Ordering
$ccompare :: Comment -> Comment -> Ordering
$cp1Ord :: Eq Comment
Ord, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Comment x -> Comment
$cfrom :: forall x. Comment -> Rep Comment x
Generic, Comment -> ()
(Comment -> ()) -> NFData Comment
forall a. (a -> ()) -> NFData a
rnf :: Comment -> ()
$crnf :: Comment -> ()
NFData, Typeable Comment
DataType
Constr
Typeable Comment =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Comment -> c Comment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment)
-> (Comment -> Constr)
-> (Comment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment))
-> ((forall b. Data b => b -> b) -> Comment -> Comment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Comment -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> Data Comment
Comment -> DataType
Comment -> Constr
(forall b. Data b => b -> b) -> Comment -> Comment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
forall u. (forall d. Data d => d -> u) -> Comment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cComment :: Constr
$tComment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMp :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapM :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
$cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Comment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
dataTypeOf :: Comment -> DataType
$cdataTypeOf :: Comment -> DataType
toConstr :: Comment -> Constr
$ctoConstr :: Comment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cp1Data :: Typeable Comment
Data, Comment
Comment -> Empty Comment
forall a. a -> Empty a
empty :: Comment
$cempty :: Comment
Empty)

instance ToJSON Comment where
  toJSON :: Comment -> Value
toJSON = Options -> Comment -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "comment_" }

instance FromJSON Comment where
  parseJSON :: Value -> Parser Comment
parseJSON = Options -> Value -> Parser Comment
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
strip "comment_" }