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

-- | Client for the Hetzner DNS API.
module Hetzner.DNS (
    -- * 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 (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Eq Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
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 :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
Ord)

instance IsString Token where
  fromString :: String -> Token
fromString = ByteString -> Token
Token forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | Lookup 'Token' from the environment variable @HETZNER_DNS_TOKEN@.
getTokenFromEnv :: IO (Maybe Token)
getTokenFromEnv :: IO (Maybe Token)
getTokenFromEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
System.lookupEnv String
"HETZNER_DNS_TOKEN"

-- | Exception produced while performing a request to Hetzner DNS.
data DNSException =
    DNSError (HTTP.Response ByteString)
  | JSONError (HTTP.Response ByteString) String
    deriving Int -> DNSException -> ShowS
[DNSException] -> ShowS
DNSException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DNSException] -> ShowS
$cshowList :: [DNSException] -> ShowS
show :: DNSException -> String
$cshow :: DNSException -> String
showsPrec :: Int -> DNSException -> ShowS
$cshowsPrec :: Int -> DNSException -> ShowS
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 :: forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
method ByteString
path Maybe body
mbody Query
query (Token ByteString
token) Maybe Int
mpage = do
  let req :: Request
req = ByteString -> Request -> Request
HTTP.setRequestMethod ByteString
method
          forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
"dns.hetzner.com"
          forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath (ByteString
"/api/v1" forall a. Semigroup a => a -> a -> a
<> ByteString
path)
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. ToJSON a => a -> Request -> Request
HTTP.setRequestBodyJSON Maybe body
mbody
          forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Auth-API-Token" ByteString
token
          forall a b. (a -> b) -> a -> b
$ Query -> Request -> Request
HTTP.addToRequestQueryString Query
query
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Int
page -> Query -> Request -> Request
HTTP.addToRequestQueryString
                                 [(ByteString
"page", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
page)]) Maybe Int
mpage
          forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let body :: ByteString
body = forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp) Int
100 of
    (Int
2,Int
m) ->
      let body' :: ByteString
body' = if Int
m forall a. Eq a => a -> a -> Bool
== Int
4 then ByteString
"{}" else ByteString
body
      in  case forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body' of
            Left String
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Response ByteString -> String -> DNSException
JSONError Response ByteString
resp String
err
            Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    (Int, Int)
_ -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Response ByteString -> DNSException
DNSError Response ByteString
resp

----------------------------------------------------------------------------------------------------
-- Time parser
----------------------------------------------------------------------------------------------------

newtype DNSTime = DNSTime { DNSTime -> ZonedTime
dnsTime :: ZonedTime }

instance FromJSON DNSTime where
  parseJSON :: Value -> Parser DNSTime
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"DNSTime" forall a b. (a -> b) -> a -> b
$
    let format :: String
format = String
"%F %T%Q %z %Z"
    in  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> DNSTime
DNSTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
format forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

----------------------------------------------------------------------------------------------------
-- Zones
----------------------------------------------------------------------------------------------------

-- | Zone identifier.
newtype ZoneID = ZoneID Text deriving (ZoneID -> ZoneID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZoneID -> ZoneID -> Bool
$c/= :: ZoneID -> ZoneID -> Bool
== :: ZoneID -> ZoneID -> Bool
$c== :: ZoneID -> ZoneID -> Bool
Eq, Eq ZoneID
ZoneID -> ZoneID -> Bool
ZoneID -> ZoneID -> Ordering
ZoneID -> ZoneID -> ZoneID
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 :: ZoneID -> ZoneID -> ZoneID
$cmin :: ZoneID -> ZoneID -> ZoneID
max :: ZoneID -> ZoneID -> ZoneID
$cmax :: ZoneID -> ZoneID -> ZoneID
>= :: ZoneID -> ZoneID -> Bool
$c>= :: ZoneID -> ZoneID -> Bool
> :: ZoneID -> ZoneID -> Bool
$c> :: ZoneID -> ZoneID -> Bool
<= :: ZoneID -> ZoneID -> Bool
$c<= :: ZoneID -> ZoneID -> Bool
< :: ZoneID -> ZoneID -> Bool
$c< :: ZoneID -> ZoneID -> Bool
compare :: ZoneID -> ZoneID -> Ordering
$ccompare :: ZoneID -> ZoneID -> Ordering
Ord, Int -> ZoneID -> ShowS
[ZoneID] -> ShowS
ZoneID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZoneID] -> ShowS
$cshowList :: [ZoneID] -> ShowS
show :: ZoneID -> String
$cshow :: ZoneID -> String
showsPrec :: Int -> ZoneID -> ShowS
$cshowsPrec :: Int -> ZoneID -> ShowS
Show, Value -> Parser [ZoneID]
Value -> Parser ZoneID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ZoneID]
$cparseJSONList :: Value -> Parser [ZoneID]
parseJSON :: Value -> Parser ZoneID
$cparseJSON :: Value -> Parser ZoneID
FromJSON, [ZoneID] -> Encoding
[ZoneID] -> Value
ZoneID -> Encoding
ZoneID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ZoneID] -> Encoding
$ctoEncodingList :: [ZoneID] -> Encoding
toJSONList :: [ZoneID] -> Value
$ctoJSONList :: [ZoneID] -> Value
toEncoding :: ZoneID -> Encoding
$ctoEncoding :: ZoneID -> Encoding
toJSON :: ZoneID -> Value
$ctoJSON :: ZoneID -> Value
ToJSON)

-- | Status of a 'Zone'.
data ZoneStatus = Verified | Failed | Pending deriving Int -> ZoneStatus -> ShowS
[ZoneStatus] -> ShowS
ZoneStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZoneStatus] -> ShowS
$cshowList :: [ZoneStatus] -> ShowS
show :: ZoneStatus -> String
$cshow :: ZoneStatus -> String
showsPrec :: Int -> ZoneStatus -> ShowS
$cshowsPrec :: Int -> ZoneStatus -> ShowS
Show

instance FromJSON ZoneStatus where
  parseJSON :: Value -> Parser ZoneStatus
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"ZoneStatus" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"verified" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ZoneStatus
Verified
    Text
"failed" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ZoneStatus
Failed
    Text
"pending" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ZoneStatus
Pending
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid zone status: " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | DNS zone.
data Zone = Zone
  { Zone -> ZonedTime
zoneCreated :: ZonedTime
  , Zone -> ZonedTime
zoneModified :: ZonedTime
  , Zone -> ZoneID
zoneID :: ZoneID
  , Zone -> Text
zoneName :: Text
  , Zone -> Bool
zoneIsSecondary :: Bool
  , Zone -> ZoneStatus
zoneStatus :: ZoneStatus
  , Zone -> Int
zoneRecordCount :: Int
  , Zone -> Int
zoneTTL :: Int
    } deriving Int -> Zone -> ShowS
[Zone] -> ShowS
Zone -> String
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

instance FromJSON Zone where
  parseJSON :: Value -> Parser Zone
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Zone" forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> ZonedTime
-> ZoneID
-> Text
-> Bool
-> ZoneStatus
-> Int
-> Int
-> Zone
Zone
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DNSTime -> ZonedTime
dnsTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DNSTime -> ZonedTime
dnsTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modified")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"is_secondary_dns"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"records_count"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ttl"

-- | Get zones.
getZones :: Token -> Maybe Int -> IO (WithMeta "zones" [Zone])
getZones :: Token -> Maybe Int -> IO (WithMeta "zones" [Zone])
getZones = forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"GET" ByteString
"/zones" Maybe Void
noBody []

-- | Get a single zone.
getZone :: Token -> ZoneID -> IO Zone
getZone :: Token -> ZoneID -> IO Zone
getZone Token
token (ZoneID Text
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"zone" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"GET" (ByteString
"/zones/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
i) Maybe Void
noBody [] Token
token forall a. Maybe a
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 -> Text -> Maybe Int -> IO Zone
updateZone Token
token (ZoneID Text
i) Text
name Maybe Int
mttl = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"zone" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$ (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name) forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"ttl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe Int
mttl)
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"PUT" (ByteString
"/zones/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
i) (forall a. a -> Maybe a
Just Value
body) [] Token
token forall a. Maybe a
Nothing

-- | Delete a zone.
deleteZone :: Token -> ZoneID -> IO ()
deleteZone :: Token -> ZoneID -> IO ()
deleteZone Token
token (ZoneID Text
i) = forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"DELETE" (ByteString
"/zones/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
i) Maybe Void
noBody [] Token
token forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Records
----------------------------------------------------------------------------------------------------

-- | A record identifier.
newtype RecordID = RecordID Text deriving (RecordID -> RecordID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordID -> RecordID -> Bool
$c/= :: RecordID -> RecordID -> Bool
== :: RecordID -> RecordID -> Bool
$c== :: RecordID -> RecordID -> Bool
Eq, Eq RecordID
RecordID -> RecordID -> Bool
RecordID -> RecordID -> Ordering
RecordID -> RecordID -> RecordID
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 :: RecordID -> RecordID -> RecordID
$cmin :: RecordID -> RecordID -> RecordID
max :: RecordID -> RecordID -> RecordID
$cmax :: RecordID -> RecordID -> RecordID
>= :: RecordID -> RecordID -> Bool
$c>= :: RecordID -> RecordID -> Bool
> :: RecordID -> RecordID -> Bool
$c> :: RecordID -> RecordID -> Bool
<= :: RecordID -> RecordID -> Bool
$c<= :: RecordID -> RecordID -> Bool
< :: RecordID -> RecordID -> Bool
$c< :: RecordID -> RecordID -> Bool
compare :: RecordID -> RecordID -> Ordering
$ccompare :: RecordID -> RecordID -> Ordering
Ord, Int -> RecordID -> ShowS
[RecordID] -> ShowS
RecordID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordID] -> ShowS
$cshowList :: [RecordID] -> ShowS
show :: RecordID -> String
$cshow :: RecordID -> String
showsPrec :: Int -> RecordID -> ShowS
$cshowsPrec :: Int -> RecordID -> ShowS
Show, Value -> Parser [RecordID]
Value -> Parser RecordID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RecordID]
$cparseJSONList :: Value -> Parser [RecordID]
parseJSON :: Value -> Parser RecordID
$cparseJSON :: Value -> Parser RecordID
FromJSON, [RecordID] -> Encoding
[RecordID] -> Value
RecordID -> Encoding
RecordID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RecordID] -> Encoding
$ctoEncodingList :: [RecordID] -> Encoding
toJSONList :: [RecordID] -> Value
$ctoJSONList :: [RecordID] -> Value
toEncoding :: RecordID -> Encoding
$ctoEncoding :: RecordID -> Encoding
toJSON :: RecordID -> Value
$ctoJSON :: RecordID -> Value
ToJSON)

-- | Record type.
data RecordType =
  A | AAAA | CAA | CNAME | DANE | DS | HINFO | MX | NS | PTR | RP | SOA | SRV | TLS | TXT
  deriving (RecordType -> RecordType -> Bool
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, Int -> RecordType -> ShowS
[RecordType] -> ShowS
RecordType -> String
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, Int -> RecordType
RecordType -> Int
RecordType -> [RecordType]
RecordType -> RecordType
RecordType -> RecordType -> [RecordType]
RecordType -> RecordType -> RecordType -> [RecordType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RecordType -> RecordType -> RecordType -> [RecordType]
$cenumFromThenTo :: RecordType -> RecordType -> RecordType -> [RecordType]
enumFromTo :: RecordType -> RecordType -> [RecordType]
$cenumFromTo :: RecordType -> RecordType -> [RecordType]
enumFromThen :: RecordType -> RecordType -> [RecordType]
$cenumFromThen :: RecordType -> RecordType -> [RecordType]
enumFrom :: RecordType -> [RecordType]
$cenumFrom :: RecordType -> [RecordType]
fromEnum :: RecordType -> Int
$cfromEnum :: RecordType -> Int
toEnum :: Int -> RecordType
$ctoEnum :: Int -> RecordType
pred :: RecordType -> RecordType
$cpred :: RecordType -> RecordType
succ :: RecordType -> RecordType
$csucc :: RecordType -> RecordType
Enum)

-- | List with all supported record types.
allRecordTypes :: [RecordType]
allRecordTypes :: [RecordType]
allRecordTypes = [RecordType
A ..]

instance FromJSON RecordType where
  parseJSON :: Value -> Parser RecordType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"RecordType" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) Text
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [RecordType]
allRecordTypes of
      Just RecordType
rtype -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RecordType
rtype
      Maybe RecordType
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid record type: " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

instance ToJSON RecordType where
  toJSON :: RecordType -> Value
toJSON = Text -> Value
JSON.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | A DNS record.
data Record = Record
  { Record -> ZonedTime
recordCreated :: ZonedTime
  , Record -> ZonedTime
recordModified :: ZonedTime
  , Record -> RecordID
recordID :: RecordID
  , Record -> Text
recordName :: Text
  , Record -> RecordType
recordType :: RecordType
  , Record -> Text
recordValue :: Text
  , Record -> Int
recordTTL :: Int
    -- | ID of the zone this record is associated with.
  , Record -> ZoneID
recordZone :: ZoneID
    } deriving Int -> Record -> ShowS
[Record] -> ShowS
Record -> String
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

instance FromJSON Record where
  parseJSON :: Value -> Parser Record
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Record" forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> ZonedTime
-> RecordID
-> Text
-> RecordType
-> Text
-> Int
-> ZoneID
-> Record
Record
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DNSTime -> ZonedTime
dnsTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DNSTime -> ZonedTime
dnsTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modified")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ttl" forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
86400
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"zone_id"

-- | Get DNS records.
getRecords
  :: Token
  -> Maybe ZoneID -- ^ Optionally filter by zone.
  -> IO [Record]
getRecords :: Token -> Maybe ZoneID -> IO [Record]
getRecords Token
token Maybe ZoneID
mzone = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"records" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let query :: Query
query = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(ZoneID Text
zone) -> [(ByteString
"zone_id", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
zone)]) Maybe ZoneID
mzone
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"GET" ByteString
"/records" Maybe Void
noBody Query
query Token
token forall a. Maybe a
Nothing

-- | Get a single DNS record.
getRecord :: Token -> RecordID -> IO Record
getRecord :: Token -> RecordID -> IO Record
getRecord Token
token (RecordID Text
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"record" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"GET" (ByteString
"/records/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
i) Maybe Void
noBody [] Token
token forall a. Maybe a
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
-> ZoneID -> Text -> RecordType -> Text -> Maybe Int -> IO Record
createRecord Token
token ZoneID
zone Text
name RecordType
rtype Text
value Maybe Int
mttl = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"record" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$
        [ Key
"zone_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ZoneID
zone
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
        , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RecordType
rtype
        , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
value
          ] forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"ttl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) Maybe Int
mttl
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"POST" ByteString
"/records" (forall a. a -> Maybe a
Just Value
body) [] Token
token forall a. Maybe a
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
-> ZoneID
-> Text
-> RecordType
-> Text
-> Maybe Int
-> IO Record
updateRecord Token
token (RecordID Text
i) ZoneID
zone Text
name RecordType
rtype Text
value Maybe Int
mttl = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"record" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$
        [ Key
"zone_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ZoneID
zone
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
        , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RecordType
rtype
        , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
value
          ] forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"ttl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) Maybe Int
mttl
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"PUT" (ByteString
"/records/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
i) (forall a. a -> Maybe a
Just Value
body) [] Token
token forall a. Maybe a
Nothing

-- | Delete a DNS record.
deleteRecord :: Token -> RecordID -> IO ()
deleteRecord :: Token -> RecordID -> IO ()
deleteRecord Token
token (RecordID Text
i) =
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Query -> Token -> Maybe Int -> IO a
dnsQuery ByteString
"DELETE" (ByteString
"/records/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
i) Maybe Void
noBody [] Token
token forall a. Maybe a
Nothing