hetzner 0.8.0.0 → 1.0.0.0

raw patch · 5 files changed

+283/−323 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• changelog.md +10/−0
• hetzner.cabal +2/−3
• readme.md +1/−2
• src/Hetzner/Cloud.hs +270/−15
• src/Hetzner/DNS.hs +0/−303

@@ -1,3 +1,13 @@+## 1.0.0.0+* Require `base >= 4.18`.+* Remove module `Hetzner.DNS`. Instead, the DNS API now lives under+  `Hetzner.Cloud`. It's also the new DNS API offered by Hetzner,+  which is incompatible with the previous one. Not complete yet.+* Make `WithKey` a newtype and add a `ToJSON` instance.+* Implement rescue mode enabling/disabling.+* Remove server type "deprecated" field. No longer returned by Hetzner.+* Fix `Image` parser.+ ## 0.8.0.0 * Remove data centers. These have been deprecated by Hetzner. 

@@ -2,7 +2,7 @@ category: Cloud synopsis: Hetzner Cloud and DNS library. description: Hetzner Cloud and DNS library. Check the readme and documentation for more details.-version: 0.8.0.0+version: 1.0.0.0 cabal-version: 1.18 build-type: Simple author: Daniel Casanueva (coding `at` danielcasanueva.eu)@@ -19,7 +19,6 @@   exposed-modules:     Hetzner.Cloud     Hetzner.Cloud.Fingerprint-    Hetzner.DNS   ghc-options: -Wall -Wunused-packages   default-extensions:       ImportQualifiedPost@@ -31,7 +30,7 @@     , TypeApplications     , CPP   build-depends:-      base >= 4.16 && < 4.23+      base >= 4.18 && < 4.23     , text, aeson, containers, conduit     , http-conduit, bytestring, yaml, time     , country, ip, megaparsec, scientific

@@ -2,8 +2,7 @@  ## Description -Client interface for the [Hetzner Cloud API](https://docs.hetzner.cloud)-and the [Hetzner DNS API](https://dns.hetzner.com/api-docs),+Client interface for the [Hetzner Cloud API](https://docs.hetzner.cloud). written in the [Haskell](https://www.haskell.org) programming language.  ## Completeness

@@ -44,8 +44,7 @@   , getMetadata     -- * Hetzner Cloud API -    -- | Sections are in the same order as in the-    --   [official documentation](https://docs.hetzner.cloud).+    -- | Sections appear in alphabetic order.      -- ** Actions   , ActionStatus (..)@@ -56,6 +55,27 @@   , waitForAction   , HasActions (..)   , waitForActions+    -- ** DNS+    -- *** Zones+  , ZoneID (..)+  , Zone (..)+  , getZones+  , getZone+  , downloadZoneFile+    -- *** RRSets+  , RRSetID (..)+  , RRSet (..)+  , RRSetType (..)+  , DNSRecord (..)+  , getRRSets+  , getRRSet+  , createRRSet+  , deleteRRSet+  , setRRSetTTL+  , setRRSetRecords+  , addRRSetRecords+  , updateRRSetRecords+  , deleteRRSetRecords     -- ** Firewalls   , FirewallID (..)   , TrafficDirection (..)@@ -94,12 +114,6 @@   , Location (..)   , getLocations   , getLocation-    -- ** Primary IPs-  , PrimaryIPID (..)-  , PrimaryIP (..)-  , getPrimaryIPs-  , getPrimaryIP-  , setReverseDNS     -- ** Networks   , NetworkID (..)   , Route (..)@@ -116,6 +130,12 @@     -- ** Pricing   , Price (..)   , PriceInLocation (..)+    -- ** Primary IPs+  , PrimaryIPID (..)+  , PrimaryIP (..)+  , getPrimaryIPs+  , getPrimaryIP+  , setReverseDNS     -- ** Servers   , ServerStatus (..)   , ServerID (..)@@ -135,6 +155,9 @@   , shutdownServer   , rebootServer   , changeServerType+  , RescueModeEnabled (..)+  , enableRescueMode+  , disableRescueMode     -- ** Server types   , Architecture (..)   , StorageType (..)@@ -214,7 +237,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Foldable (forM_) import Data.Traversable (forM)-import Data.Maybe (isNothing, fromMaybe)+import Data.Maybe (isNothing) import System.Environment qualified as System import Data.List.NonEmpty (NonEmpty ((:|))) -- ip@@ -227,6 +250,7 @@ -- text import Data.Text (Text) import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text -- aeson import Data.Aeson   ( FromJSON, ToJSON@@ -236,6 +260,7 @@ import Data.Aeson qualified as JSON import Data.Aeson.Types qualified as JSON import Data.Aeson.Key qualified as JSONKey+import Data.Aeson.KeyMap qualified as JSONKeyMap import Data.Aeson.Encoding qualified as JSONEncoding -- yaml import Data.Yaml qualified as Yaml@@ -685,7 +710,7 @@ streamToList = Conduit.sourceToList  -- | Wrap a value with the key of the value within a JSON object.-data WithKey (key :: Symbol) a = WithKey { withoutKey :: a } deriving Show+newtype WithKey (key :: Symbol) a = WithKey { withoutKey :: a } deriving Show  instance Functor (WithKey key) where   fmap f (WithKey x) = WithKey (f x)@@ -699,6 +724,9 @@     in  JSON.withObject ("WithKey:" ++ key) $ \o ->           WithKey <$> o .: fromString key +instance (KnownSymbol key, ToJSON a) => ToJSON (WithKey key a) where+  toJSON (WithKey a) = JSON.object [ fromString (symbolVal (Proxy @key)) .= a ]+ -- | A value together with response metadata. --   The type is annotated with the JSON key of the value. data WithMeta (key :: Symbol) a = WithMeta@@ -780,6 +808,15 @@   | CreateVolume   | AttachVolume   | ChangeDNSPtr+  | CreateRRSet+  | DeleteRRSet+  | SetRRSetTTL+  | SetRRSetRecords+  | AddRRSetRecords+  | UpdateRRSetRecords+  | DeleteRRSetRecords+  | EnableRescue+  | DisableRescue     deriving Show  instance FromJSON ActionCommand where@@ -795,6 +832,15 @@     "create_volume" -> pure CreateVolume     "attach_volume" -> pure AttachVolume     "change_dns_ptr" -> pure ChangeDNSPtr+    "create_rrset" -> pure CreateRRSet+    "delete_rrset" -> pure DeleteRRSet+    "change_rrset_ttl" -> pure SetRRSetTTL+    "set_rrset_records" -> pure SetRRSetRecords+    "add_rrset_records" -> pure AddRRSetRecords+    "update_rrset_records" -> pure UpdateRRSetRecords+    "remove_rrset_records" -> pure DeleteRRSetRecords+    "enable_rescue" -> pure EnableRescue+    "disable_rescue" -> pure DisableRescue     _ -> fail $ "Unknown action command " ++ Text.unpack t  -- | Action identifier.@@ -812,6 +858,8 @@   | ResourceFirewallID FirewallID     -- | Image ID.   | ResourceImageID ImageID+    -- | Zone ID.+  | ResourceZoneID ZoneID     deriving Show  instance FromJSON ResourceID where@@ -823,6 +871,7 @@       "primary_ip" -> ResourcePrimaryIPID <$> o .: "id"       "firewall" -> ResourceFirewallID <$> o .: "id"       "image" -> ResourceImageID <$> o .: "id"+      "zone" -> ResourceZoneID <$> o .: "id"       _ -> fail $ "Unknown resource type: " ++ Text.unpack t  -- | Action.@@ -893,6 +942,180 @@   actionsOf = foldMap actionsOf  ----------------------------------------------------------------------------------------------------+-- DNS+----------------------------------------------------------------------------------------------------++-- | DNS zone identifier.+newtype ZoneID = ZoneID Int deriving (Eq, Ord, Show, FromJSON, ToJSON)++-- | DNS zone.+data Zone = Zone+  { zoneID :: ZoneID+  , zoneLabels :: LabelMap+  , zoneName :: Text+  , zoneRecordCount :: Int+  , zoneDefaultTTL :: Int+    } deriving Show++instance FromJSON Zone where+  parseJSON = JSON.withObject "Zone" $ \o -> Zone+    <$> o .: "id"+    <*> o .: "labels"+    <*> o .: "name"+    <*> o .: "record_count"+    <*> o .: "ttl"++getZones :: Token -> Maybe Int -> IO (WithMeta "zones" [Zone])+getZones = cloudQuery "GET" "/zones" noBody++getZone :: Token -> ZoneID -> IO Zone+getZone token (ZoneID i) = withoutKey @"zone" <$>+  cloudQuery "GET" ("/zones/" <> fromString (show i)) noBody token Nothing++-- | Download zone file in BIND format.+downloadZoneFile :: Token -> ZoneID -> IO Text+downloadZoneFile token (ZoneID i) = withoutKey @"zonefile" <$>+  cloudQuery "GET" ("/zones/" <> fromString (show i) <> "/zonefile") noBody token Nothing++data RRSetType =+  A | AAAA | CAA | CNAME | DS | HINFO | HTTPS | MX | NS | PTR | RP | SOA | SRV | SVCB | TLSA | TXT+  deriving (Eq, Show)++instance FromJSON RRSetType where+  parseJSON = JSON.withText "RRSetType" $ \t ->+    case t of+      "A" -> pure A+      "AAAA" -> pure AAAA+      "CAA" -> pure CAA+      "CNAME" -> pure CNAME+      "DS" -> pure DS+      "HINFO" -> pure HINFO+      "HTTPS" -> pure HTTPS+      "MX" -> pure MX+      "NS" -> pure NS+      "PTR" -> pure PTR+      "RP" -> pure RP+      "SOA" -> pure SOA+      "SRV" -> pure SRV+      "SVCB" -> pure SVCB+      "TLSA" -> pure TLSA+      "TXT" -> pure TXT+      _ -> fail $ "Invalid RRSetType: " <> Text.unpack t++instance ToJSON RRSetType where+  toJSON = JSON.toJSON . show++data RRSetID = RRSetID Text RRSetType deriving (Eq, Show)++data DNSRecord = DNSRecord+  { dnsRecordValue :: Text+  , dnsRecordComment :: Text+    } deriving Show++instance FromJSON DNSRecord where+  parseJSON = JSON.withObject "DNSRecord" $ \o ->+    liftA2 DNSRecord (o .: "value") (o .: "comment")++instance ToJSON DNSRecord where+  toJSON (DNSRecord v c) = JSON.object [ "value" .= v, "comment" .= c ]++data RRSet = RRSet+  { rrSetID :: RRSetID+  , rrSetZoneID :: ZoneID+  , rrSetRecords :: [DNSRecord]+  , rrSetTTL :: Maybe Int+  , rrSetLabels :: LabelMap+    } deriving Show++instance FromJSON RRSet where+  parseJSON = JSON.withObject "RRSet" $ \o -> RRSet+    <$> liftA2 RRSetID (o .: "name") (o .: "type")+    <*> o .: "zone"+    <*> o .: "records"+    <*> o .:? "ttl"+    <*> o .: "labels"++instance ToJSON RRSet where+  toJSON rrset =+    let RRSetID name typ = rrSetID rrset+    in  JSON.object+          [ "name" .= name+          , "type" .= typ+          , "zone" .= rrSetZoneID rrset+          , "records" .= rrSetRecords rrset+          , "ttl" .= rrSetTTL rrset+          , "labels" .= rrSetLabels rrset+            ]++-- | Get RRSets from a zone.+getRRSets :: Token -> ZoneID -> Maybe Int -> IO (WithMeta "rrsets" [RRSet])+getRRSets token (ZoneID i) =+  cloudQuery "GET" ("/zones/" <> fromString (show i) <> "/rrsets") noBody token++-- | Get an RRSet.+getRRSet :: Token -> ZoneID -> RRSetID -> IO RRSet+getRRSet token (ZoneID i) (RRSetID name typ) = withoutKey @"rrset" <$>+  cloudQuery "GET"+    ("/zones/" <> fromString (show i)+               <> "/rrsets/" <> Text.encodeUtf8 name+               <> "/" <> fromString (show typ)) noBody token Nothing++-- | Create an RRSet.+createRRSet :: Token -> RRSet -> IO Action+createRRSet token rrset = withoutKey @"action" <$> do+  body <-+    case JSON.toJSON rrset of+      JSON.Object km -> pure $ JSON.Object $ JSONKeyMap.delete "zone" km+      _ -> fail "toJSON rrset returned a non-object!"+  let ZoneID i = rrSetZoneID rrset+      path = "/zones/" <> fromString (show i) <> "/rrsets"+  cloudQuery "POST" path (Just body) token Nothing++-- | Delete an RRSet.+deleteRRSet :: Token -> ZoneID -> RRSetID -> IO Action+deleteRRSet token (ZoneID i) (RRSetID name typ) = withoutKey @"action" <$>+  let path = "/zones/" <> fromString (show i)+          <> "/rrsets/" <> Text.encodeUtf8 name+          <> "/" <> fromString (show typ)+  in  cloudQuery "DELETE" path noBody token Nothing++genericRRSetUpdate+  :: forall key a+   . (KnownSymbol key, ToJSON a)+  => ByteString -- ^ Route name+  -> Proxy key+  -> Token -> ZoneID -> RRSetID -> a -> IO Action+genericRRSetUpdate rname _ token (ZoneID i) (RRSetID name typ) a = withoutKey @"action" <$>+  let path = "/zones/" <> fromString (show i)+          <> "/rrsets/" <> Text.encodeUtf8 name+          <> "/" <> fromString (show typ)+          <> "/actions/" <> rname+  in  cloudQuery "POST" path (Just $ WithKey @key a) token Nothing++-- | Set the TTL of an RRSet.+setRRSetTTL :: Token -> ZoneID -> RRSetID -> Int -> IO Action+setRRSetTTL = genericRRSetUpdate "change_ttl" (Proxy @"ttl")++-- | Set the DNS records of an RRSet. Any previoulsy held records are deleted.+setRRSetRecords :: Token -> ZoneID -> RRSetID -> [DNSRecord] -> IO Action+setRRSetRecords = genericRRSetUpdate "set_records" (Proxy @"records")++-- | Add DNS records to an RRSet. If the RRSet does not exist, it's created.+addRRSetRecords :: Token -> ZoneID -> RRSetID -> [DNSRecord] -> IO Action+addRRSetRecords = genericRRSetUpdate "add_records" (Proxy @"records")++-- | Update DNS records from an RRSet.+updateRRSetRecords :: Token -> ZoneID -> RRSetID -> [DNSRecord] -> IO Action+updateRRSetRecords = genericRRSetUpdate "update_records" (Proxy @"records")++-- | Delete DNS records from an RRSet. If after deleting the records the+--   RRSet becomes empty, the RRSet is deleted as well.+deleteRRSetRecords :: Token -> ZoneID -> RRSetID -> [Text] -> IO Action+deleteRRSetRecords token zid rid xs =+  genericRRSetUpdate "remove_records" (Proxy @"records") token zid rid $+    WithKey @"value" <$> xs++---------------------------------------------------------------------------------------------------- -- Firewalls ---------------------------------------------------------------------------------------------------- @@ -1299,7 +1522,7 @@       <*> o .: "disk_size"       <*> o .: "created"       <*> o .: "deleted"-      <*> o .: "deprecated"+      <*> (fmap (withoutKey @"unavailable_after") <$> o .: "deprecation")       <*> o .: "labels"  -- | Get images.@@ -1414,7 +1637,11 @@       <*> o .: "created"       <*> o .: "id"       <*> (case iptype :: Text of-             "ipv4" -> Left <$> (o .: "dns_ptr" >>= JSON.parseJSON . head)+             "ipv4" -> do+               xs <- o .: "dns_ptr"+               case xs of+                 [] -> fail "Empty dns_ptr list."+                 x : _ -> Left <$> JSON.parseJSON x              "ipv6" -> Right <$> JSON.parseJSON (JSON.Object o)              _ -> fail $ "Invalid ip type: " ++ Text.unpack iptype              )@@ -1779,7 +2006,7 @@   , newServerNetworks = []   , newServerEnableIPv4 = True   , newServerEnableIPv6 = True-  , newServerType = ServerTypeID 114 -- CX23+  , newServerType = ServerTypeID 118 -- CPX02   , newServerSSHKeys = []   , newServerStart = True   , newServerVolumes = []@@ -1900,6 +2127,36 @@         ("/servers/" <> fromString (show i) <> "/actions/change_type")         (Just body) token Nothing +-- | Values returned when enabling rescue mode on as server.+data RescueModeEnabled = RescueModeEnabled+  { -- | A password that can be used to access the rescue system.+    rescueModePassword :: Text+    -- | The action of enabling rescue mode.+  , rescueModeAction :: Action+    }++instance FromJSON RescueModeEnabled where+  parseJSON = JSON.withObject "RescueModeEnabled" $ \o ->+    liftA2 RescueModeEnabled (o .: "root_password") (o .: "action")++-- | Enable rescue mode on a server. Once enabled, the next time the server boots,+--   it will do so into the rescue system.+enableRescueMode :: Token -> ServerID -> [SSHKeyID] -> IO RescueModeEnabled+enableRescueMode token (ServerID i) keys =+  cloudQuery "POST"+    ("/servers/" <> fromString (show i) <> "/actions/enable_rescue")+    (Just $ WithKey @"ssh-keys" keys) token Nothing++-- | Disable rescue mode so that next time the server boots it does so from disk.+--+--   Note that rescue mode is automatically disabled after 60 minutes or after+--   booting into the rescue system.+disableRescueMode :: Token -> ServerID -> IO Action+disableRescueMode token (ServerID i) = withoutKey @"action" <$>+  cloudQuery "POST"+    ("/servers/" <> fromString (show i) <> "/actions/disable_rescue")+    noBody token Nothing+ ---------------------------------------------------------------------------------------------------- -- Server Types ----------------------------------------------------------------------------------------------------@@ -1939,7 +2196,6 @@   { serverArchitecture :: Architecture   , serverCores :: Int   , serverCPUType :: CPUType-  , serverDeprecated :: Bool   , serverTypeDescription :: Text     -- | Disk size a server of this type has in GB.   , serverDisk :: Int@@ -1956,7 +2212,6 @@     <$> o .: "architecture"     <*> o .: "cores"     <*> o .: "cpu_type"-    <*> (fromMaybe False <$> o .: "deprecated")     <*> o .: "description"     <*> o .: "disk"     <*> o .: "id"

@@ -1,303 +0,0 @@--------------------------------------------------------------------------------------------------------- | Client for the Hetzner DNS API.------   /This module is currently outdated. Hetzner deprecated this API./---   /Its replacement has not been implemented in this library as of yet./---   /Contributions are welcome./-module Hetzner.DNS {-# DEPRECATED "DNS functionality moved to Cloud." #-} (-    -- * Tokens-    Token (..)-  , getTokenFromEnv-    -- * Hetzner DNS-    -- ** Zones-  , ZoneID (..)-  , ZoneStatus (..)-  , Zone (..)-  , getZones-  , getZone-  , updateZone-  , deleteZone-    -- ** Records-  , RecordID (..)-  , RecordType (..)-  , allRecordTypes-  , Record (..)-  , getRecords-  , getRecord-  , createRecord-  , updateRecord-  , deleteRecord-    -- * Exceptions-  , DNSException (..)-    -- * Streaming-  , streamPages-  , streamToList-    -- * Generic interface-    -- ** Generic queries-  , dnsQuery-  , noBody-    -- ** JSON Wrappers-  , WithKey (..)-  , WithMeta (..)-    -- ** Response metadata-  , ResponseMeta (..)-  , Pagination (..)-  ) where--import Hetzner.Cloud-  ( WithKey (..), WithMeta (..)-  , ResponseMeta (..), Pagination (..), noBody-  , streamPages, streamToList-    )--- base-import Data.String (IsString, fromString)-import Data.Maybe (maybeToList)-import System.Environment qualified as System-import Control.Exception (Exception, throwIO)-import Data.Foldable (find)--- bytestring-import Data.ByteString (ByteString)--- aeson-import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.!=), (.=))-import Data.Aeson qualified as JSON--- http-conduit-import Network.HTTP.Simple as HTTP--- time-import Data.Time (ZonedTime, parseTimeM, defaultTimeLocale)--- text-import Data.Text (Text)-import Data.Text qualified as Text-import Data.Text.Encoding (encodeUtf8)---- | A token used to authenticate requests.------   You can create one in the [Hetzner DNS Console](https://dns.hetzner.com/settings/api-token).-newtype Token = Token ByteString deriving (Show, Eq, Ord)--instance IsString Token where-  fromString = Token . fromString---- | Lookup 'Token' from the environment variable @HETZNER_DNS_TOKEN@.-getTokenFromEnv :: IO (Maybe Token)-getTokenFromEnv = fmap fromString <$> System.lookupEnv "HETZNER_DNS_TOKEN"---- | Exception produced while performing a request to Hetzner DNS.-data DNSException =-    DNSError (HTTP.Response ByteString)-  | JSONError (HTTP.Response ByteString) String-    deriving Show--instance Exception DNSException---- | Generic Hetzner DNS query.-dnsQuery-  :: (ToJSON body, FromJSON a)-  => ByteString -- ^ Method.-  -> ByteString -- ^ Path.-  -> Maybe body -- ^ Request body. You may use 'noBody' to skip.-  -> HTTP.Query -- ^ Additional query options.-  -> Token -- ^ Authorization token.-  -> Maybe Int -- ^ Page.-  -> IO a-dnsQuery method path mbody query (Token token) mpage = do-  let req = HTTP.setRequestMethod method-          $ HTTP.setRequestSecure True-          $ HTTP.setRequestHost "dns.hetzner.com"-          $ HTTP.setRequestPort 443-          $ HTTP.setRequestPath ("/api/v1" <> path)-          $ maybe id HTTP.setRequestBodyJSON mbody-          $ HTTP.addRequestHeader "Auth-API-Token" token-          $ HTTP.addToRequestQueryString query-          $ maybe id (\page -> HTTP.addToRequestQueryString-                                 [("page", Just $ fromString $ show page)]) mpage-          $ HTTP.defaultRequest-  resp <- HTTP.httpBS req-  let body = HTTP.getResponseBody resp-  case divMod (HTTP.getResponseStatusCode resp) 100 of-    (2,m) ->-      let body' = if m == 4 then "{}" else body-      in  case JSON.eitherDecodeStrict body' of-            Left err -> throwIO $ JSONError resp err-            Right x -> pure x-    _ -> throwIO $ DNSError resp--------------------------------------------------------------------------------------------------------- Time parser-------------------------------------------------------------------------------------------------------newtype DNSTime = DNSTime { dnsTime :: ZonedTime }--instance FromJSON DNSTime where-  parseJSON = JSON.withText "DNSTime" $-    let format = "%F %T%Q %z %Z"-    in  fmap DNSTime . parseTimeM False defaultTimeLocale format . Text.unpack--------------------------------------------------------------------------------------------------------- Zones--------------------------------------------------------------------------------------------------------- | Zone identifier.-newtype ZoneID = ZoneID Text deriving (Eq, Ord, Show, FromJSON, ToJSON)---- | Status of a 'Zone'.-data ZoneStatus = Verified | Failed | Pending deriving Show--instance FromJSON ZoneStatus where-  parseJSON = JSON.withText "ZoneStatus" $ \t -> case t of-    "verified" -> pure Verified-    "failed" -> pure Failed-    "pending" -> pure Pending-    _ -> fail $ "Invalid zone status: " ++ Text.unpack t---- | DNS zone.-data Zone = Zone-  { zoneCreated :: ZonedTime-  , zoneModified :: ZonedTime-  , zoneID :: ZoneID-  , zoneName :: Text-  , zoneIsSecondary :: Bool-  , zoneStatus :: ZoneStatus-  , zoneRecordCount :: Int-  , zoneTTL :: Int-    } deriving Show--instance FromJSON Zone where-  parseJSON = JSON.withObject "Zone" $ \o -> Zone-    <$> (dnsTime <$> o .: "created")-    <*> (dnsTime <$> o .: "modified")-    <*> o .: "id"-    <*> o .: "name"-    <*> o .: "is_secondary_dns"-    <*> o .: "status"-    <*> o .: "records_count"-    <*> o .: "ttl"---- | Get zones.-getZones :: Token -> Maybe Int -> IO (WithMeta "zones" [Zone])-getZones = dnsQuery "GET" "/zones" noBody []---- | Get a single zone.-getZone :: Token -> ZoneID -> IO Zone-getZone token (ZoneID i) = withoutKey @"zone" <$>-  dnsQuery "GET" ("/zones/" <> encodeUtf8 i) noBody [] token Nothing---- | Update a zone's name and TTL.-updateZone-  :: Token-  -> ZoneID -- ^ ID of zone to update.-  -> Text -- ^ New zone name.-  -> Maybe Int -- ^ New TTL. If not provided, it won't change.-  -> IO Zone-updateZone token (ZoneID i) name mttl = withoutKey @"zone" <$>-  let body = JSON.object $ ("name" .= name) : maybeToList (fmap ("ttl" .=) mttl)-  in  dnsQuery "PUT" ("/zones/" <> encodeUtf8 i) (Just body) [] token Nothing---- | Delete a zone.-deleteZone :: Token -> ZoneID -> IO ()-deleteZone token (ZoneID i) = dnsQuery "DELETE" ("/zones/" <> encodeUtf8 i) noBody [] token Nothing--------------------------------------------------------------------------------------------------------- Records--------------------------------------------------------------------------------------------------------- | A record identifier.-newtype RecordID = RecordID Text deriving (Eq, Ord, Show, FromJSON, ToJSON)---- | Record type.-data RecordType =-  A | AAAA | CAA | CNAME | DANE | DS | HINFO | MX | NS | PTR | RP | SOA | SRV | TLS | TXT-  deriving (Eq, Show, Enum)---- | List with all supported record types.-allRecordTypes :: [RecordType]-allRecordTypes = [A ..]--instance FromJSON RecordType where-  parseJSON = JSON.withText "RecordType" $ \t ->-    case find ((==) t . Text.pack . show) allRecordTypes of-      Just rtype -> pure rtype-      _ -> fail $ "Invalid record type: " ++ Text.unpack t--instance ToJSON RecordType where-  toJSON = JSON.String . Text.pack . show---- | A DNS record.-data Record = Record-  { recordCreated :: ZonedTime-  , recordModified :: ZonedTime-  , recordID :: RecordID-  , recordName :: Text-  , recordType :: RecordType-  , recordValue :: Text-  , recordTTL :: Int-    -- | ID of the zone this record is associated with.-  , recordZone :: ZoneID-    } deriving Show--instance FromJSON Record where-  parseJSON = JSON.withObject "Record" $ \o -> Record-    <$> (dnsTime <$> o .: "created")-    <*> (dnsTime <$> o .: "modified")-    <*> o .: "id"-    <*> o .: "name"-    <*> o .: "type"-    <*> o .: "value"-    <*> o .:? "ttl" .!= 86400-    <*> o .: "zone_id"---- | Get DNS records.-getRecords-  :: Token-  -> Maybe ZoneID -- ^ Optionally filter by zone.-  -> IO [Record]-getRecords token mzone = withoutKey @"records" <$>-  let query = maybe [] (\(ZoneID zone) -> [("zone_id", Just $ encodeUtf8 zone)]) mzone-  in  dnsQuery "GET" "/records" noBody query token Nothing---- | Get a single DNS record.-getRecord :: Token -> RecordID -> IO Record-getRecord token (RecordID i) = withoutKey @"record" <$>-  dnsQuery "GET" ("/records/" <> encodeUtf8 i) noBody [] token Nothing---- | Create a DNS record.-createRecord-  :: Token-  -> ZoneID -- ^ Zone to add the record to.-  -> Text -- ^ Record name.-  -> RecordType -- ^ Record type.-  -> Text -- ^ Record value.-  -> Maybe Int -- ^ Optional TTL.-  -> IO Record-createRecord token zone name rtype value mttl = withoutKey @"record" <$>-  let body = JSON.object $-        [ "zone_id" .= zone-        , "name" .= name-        , "type" .= rtype-        , "value" .= value-          ] ++ maybe [] (pure . ("ttl" .=)) mttl-  in  dnsQuery "POST" "/records" (Just body) [] token Nothing---- | Update a DNS record.-updateRecord-  :: Token-  -> RecordID -- ^ Record to update.-  -> ZoneID -- ^ Zone for the record.-  -> Text -- ^ New record name.-  -> RecordType -- ^ New recored type.-  -> Text -- ^ New record value.-  -> Maybe Int -- ^ Optinally, a new TTL.-  -> IO Record-updateRecord token (RecordID i) zone name rtype value mttl = withoutKey @"record" <$>-  let body = JSON.object $-        [ "zone_id" .= zone-        , "name" .= name-        , "type" .= rtype-        , "value" .= value-          ] ++ maybe [] (pure . ("ttl" .=)) mttl-  in  dnsQuery "PUT" ("/records/" <> encodeUtf8 i) (Just body) [] token Nothing---- | Delete a DNS record.-deleteRecord :: Token -> RecordID -> IO ()-deleteRecord token (RecordID i) =-  dnsQuery "DELETE" ("/records/" <> encodeUtf8 i) noBody [] token Nothing