{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}
module Network.Cloudflare.Zone where

import           Control.Lens             hiding ((.=))
import           Data.Aeson
import           Data.Text                (Text)
import qualified Data.Text.Encoding       as Text
import           Data.Time
import           Network.Cloudflare.Types
import           Network.Wreq
import           Network.Wreq.Types       (Auth (OAuth2Bearer))

listZones :: CloudflareAuth
          -> IO (Either String (ResultWithInfo [Zone]))
listZones :: CloudflareAuth -> IO (Either String (ResultWithInfo [Zone]))
listZones CloudflareAuth
authInfo = do
  let opts :: Options
opts = Options
defaults forall a b. a -> (a -> b) -> b
&
              Lens' Options (Maybe Auth)
auth forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (ByteString -> Auth
OAuth2Bearer (Text -> ByteString
Text.encodeUtf8 (CloudflareAuth -> Text
cloudflareAuthToken CloudflareAuth
authInfo)))
  Response ByteString
r <- Options -> String -> IO (Response ByteString)
getWith Options
opts String
"https://api.cloudflare.com/client/v4/zones"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Response ByteString
r forall s a. s -> Getting a s a -> a
^. forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. FromJSON a => ByteString -> Either String a
eitherDecode

data Zone = Zone {
  Zone -> Account
zoneAccount :: Account
, Zone -> UTCTime
zoneActivatedOn :: UTCTime
, Zone -> UTCTime
zoneCreatedOn :: UTCTime
, Zone -> Int
zoneDevelopmentMode :: Int
, Zone -> Text
zoneId :: Text -- TODO maybe make this a specific type
, Zone -> Object
zoneMeta :: Object -- TODO maybe make this a specific type
, Zone -> UTCTime
zoneModifiedOn :: UTCTime
, Zone -> Text
zoneName :: Text
, Zone -> Maybe Text
zoneOriginalDNSHost :: Maybe Text -- This is marked as required but can be Null?
, Zone -> Maybe [Text]
zoneOriginalNameServers :: Maybe [Text] -- This is marked as required but can be Null?
, Zone -> Maybe Text
zoneOriginalRegistrar :: Maybe Text
, Zone -> Object
zoneOwner :: Object -- TODO maybe make this a specific type
, Zone -> Maybe [Text]
zoneVanityNameServers :: Maybe [Text]
} deriving (Zone -> Zone -> Bool
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
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
Ord, 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
withObject String
"Zone" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Account
account <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account"
    UTCTime
activatedOn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"activated_on"
    UTCTime
createdOn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_on"
    Int
developmentMode <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"development_mode"
    Text
id' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Object
meta <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"meta"
    UTCTime
modifiedOn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modified_on"
    Text
name <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe Text
originalDNSHost <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_dnshost"
    Maybe [Text]
originalNameServers <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_name_servers"
    Maybe Text
originalRegistrar <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_registrar"
    Object
owner <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner"
    Maybe [Text]
vanityNameServers <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"vanity_name_servers"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Account
-> UTCTime
-> UTCTime
-> Int
-> Text
-> Object
-> UTCTime
-> Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Object
-> Maybe [Text]
-> Zone
Zone Account
account UTCTime
activatedOn UTCTime
createdOn Int
developmentMode Text
id' Object
meta UTCTime
modifiedOn Text
name Maybe Text
originalDNSHost Maybe [Text]
originalNameServers Maybe Text
originalRegistrar Object
owner Maybe [Text]
vanityNameServers