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

-- | Hetzner Cloud API client.
--
--   More information can be found on the
--   [official documentation](https://docs.hetzner.cloud).
--
--   Although not necessary, this module was designed with
--   qualified imports in mind. For example:
--
-- > import qualified Hetzner.Cloud as Hetzner
--
--   == Pagination
--
--   Some requests use pagination. These take a page argument of
--   type @'Maybe' 'Int'@. You can use 'streamPages' to get all pages
--   through a conduit-based stream. For example, to get all servers
--   as a stream:
--
-- > streamPages $ getServers token :: ConduitT i Server m ()
--
--   Or to get all volumes as a stream:
--
-- > streamPages $ getVolumes token :: ConduitT i Volume m ()
--
--   If you are not interested in the streaming functionality, you
--   can simply use 'streamToList' to turn the stream into a list:
--
-- > streamToList $ streamPages $ getServers token :: m [Server]
--
--   == Exceptions
--
--   This library makes extensive use of exceptions. Exceptions from
--   this module have type 'CloudException'. All functions that perform
--   requests to Hetzner Cloud can throw this type of exception.
--
module Hetzner.Cloud
  ( -- * Tokens
    Token (..)
  , getTokenFromEnv
    -- * Server metadata
  , Metadata (..)
  , getMetadata
    -- * Hetzner Cloud API

    -- | Sections are in the same order as in the
    --   [official documentation](https://docs.hetzner.cloud).

    -- ** Actions
  , ActionStatus (..)
  , ActionCommand (..)
  , ActionID (..)
  , Action (..)
  , getAction
  , waitForAction
    -- ** Datacenters
  , DatacenterID (..)
  , DatacenterServers (..)
  , Datacenter (..)
  , DatacentersWithRecommendation (..)
  , getDatacenters
  , getDatacenter
    -- ** Firewalls
  , FirewallID (..)
  , TrafficDirection (..)
  , PortRange (..)
  , FirewallRuleProtocol (..)
  , FirewallRule (..)
  , anyIPv4
  , anyIPv6
  , Firewall (..)
  , NewFirewall (..)
  , defaultNewFirewall
  , CreatedFirewall (..)
  , getFirewalls
  , getFirewall
  , createFirewall
  , deleteFirewall
  , updateFirewall
    -- *** Firewall actions
  , applyFirewall
  , removeFirewall
    -- ** Floating IPs
  , FloatingIPID (..)
    -- ** Images
  , OSFlavor (..)
  , ImageType (..)
  , ImageID (..)
  , Image (..)
  , getImages
  , getImage
    -- ** Load Balancers
  , LoadBalancerID (..)
    -- ** Locations
  , City (..)
  , LocationID (..)
  , Location (..)
  , getLocations
  , getLocation
    -- ** Primary IPs
  , PrimaryIPID (..)
  , PrimaryIP (..)
  , getPrimaryIPs
  , getPrimaryIP
  , setReverseDNS
    -- ** Networks
  , NetworkID (..)
  , Route (..)
  , SubnetType (..)
  , Subnet (..)
  , Network (..)
  , NewNetwork (..)
  , defaultNewNetwork
  , getNetworks
  , getNetwork
  , createNetwork
  , deleteNetwork
  , updateNetwork
    -- ** Pricing
  , Price (..)
  , PriceInLocation (..)
    -- ** Servers
  , ServerStatus (..)
  , ServerID (..)
  , Server (..)
  , NewServer (..)
  , defaultNewServer
  , CreatedServer (..)
  , getServers
  , getServer
  , createServer
  , deleteServer
    -- *** Server actions
  , setServerReverseDNS
  , powerOnServer
  , powerOffServer
  , shutdownServer
  , rebootServer
  , changeServerType
    -- ** Server types
  , Architecture (..)
  , StorageType (..)
  , CPUType (..)
  , ServerTypeID (..)
  , ServerType (..)
  , getServerTypes
    -- ** SSH Keys
  , SSHKeyID (..)
  , SSHKey (..)
  , getSSHKeys
  , getSSHKey
  , createSSHKey
  , deleteSSHKey
  , updateSSHKey
    -- ** Volumes
  , VolumeID (..)
  , VolumeFormat (..)
  , VolumeStatus (..)
  , Volume (..)
  , AttachToServer (..)
  , NewVolume (..)
  , CreatedVolume (..)
  , getVolumes
  , getVolume
  , createVolume
  , deleteVolume
  , updateVolume
    -- * Exceptions
  , Error (..)
  , CloudException (..)
    -- * Labels
  , LabelKey (..)
  , Label (..)
  , LabelMap
  , toLabelMap
  , fromLabelMap
  , LabelSelector (..)
  , LabelSelectorAll (..)
    -- * Other types
    -- ** Regions
  , Region (..)
    -- ** Resources
  , ResourceID (..)
    -- ** Public networks
  , FirewallStatus (..)
  , PublicIPInfo (..)
  , PublicNetwork (..)
    -- * Streaming
  , streamPages
  , streamToList
    -- * Generic interface
    -- ** Generic queries
  , cloudQuery
  , noBody
    -- ** JSON Wrappers
  , WithKey (..)
  , WithMeta (..)
    -- ** Response metadata
  , ResponseMeta (..)
  , Pagination (..)
    ) where

import Hetzner.Cloud.Fingerprint (Fingerprint, fingerprint)
-- base
import Control.Exception (Exception, throwIO)
import Control.Concurrent (threadDelay)
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Data.Proxy
import Data.String (IsString, fromString)
import Data.Void
import Data.Either (partitionEithers)
#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Applicative ((<|>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Foldable (forM_)
import Data.Traversable (forM)
import Data.Maybe (isNothing, fromMaybe)
import System.Environment qualified as System
import Data.List.NonEmpty (NonEmpty ((:|)))
-- ip
import Net.IPv4 (IPv4, IPv4Range)
import Net.IPv4 qualified as IPv4
import Net.IPv6 (IPv6, IPv6Range)
import Net.IPv6 qualified as IPv6
-- bytestring
import Data.ByteString (ByteString)
-- text
import Data.Text (Text)
import Data.Text qualified as Text
-- aeson
import Data.Aeson
  ( FromJSON, ToJSON
  , (.:), (.:?), (.=)
  , FromJSONKey, ToJSONKey
    )
import Data.Aeson qualified as JSON
import Data.Aeson.Types qualified as JSON
import Data.Aeson.Key qualified as JSONKey
import Data.Aeson.Encoding qualified as JSONEncoding
-- yaml
import Data.Yaml qualified as Yaml
-- http-conduit
import Network.HTTP.Simple qualified as HTTP
-- time
import Data.Time (ZonedTime)
-- country
import Country (Country)
-- megaparsec
import Text.Megaparsec qualified as Parser
import Text.Megaparsec.Char qualified as Parser
import Text.Megaparsec.Char.Lexer qualified as Parser
-- containers
import Data.Map (Map)
import Data.Map qualified as Map
-- scientific
import Data.Scientific (Scientific)
-- conduit
import Data.Conduit (ConduitT)
import Data.Conduit qualified as Conduit

-- | A token used to authenticate requests. All requests made with a token
--   will have as scope the project where the token was made.
--
--   You can obtain one through the [Hetzner Cloud Console](https://console.hetzner.cloud).
newtype Token = Token ByteString deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Eq Token
Eq Token =>
(Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord 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
$ccompare :: Token -> Token -> Ordering
compare :: Token -> Token -> Ordering
$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
>= :: Token -> Token -> Bool
$cmax :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
min :: Token -> Token -> Token
Ord)

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

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

-- | An error returned by Hetzner.
data Error = Error
  { -- | Error code.
    Error -> Text
errorCode :: Text
    -- | Error message.
  , Error -> Text
errorMessage :: Text
    } deriving Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show

instance FromJSON Error where
  parseJSON :: Value -> Parser Error
parseJSON = String -> (Object -> Parser Error) -> Value -> Parser Error
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Error" ((Object -> Parser Error) -> Value -> Parser Error)
-> (Object -> Parser Error) -> Value -> Parser Error
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Error
Error (Text -> Text -> Error) -> Parser Text -> Parser (Text -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code" Parser (Text -> Error) -> Parser Text -> Parser Error
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"

instance ToJSON Error where
  toJSON :: Error -> Value
toJSON Error
err = [Pair] -> Value
JSON.object [ Key
"code" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Error -> Text
errorCode Error
err, Key
"message" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Error -> Text
errorMessage Error
err ]

-- | Label key.
data LabelKey = LabelKey
  { -- | Optional prefix.
    LabelKey -> Maybe Text
labelKeyPrefix :: Maybe Text
    -- | Key name.
  , LabelKey -> Text
labelKeyName :: Text
    } deriving (LabelKey -> LabelKey -> Bool
(LabelKey -> LabelKey -> Bool)
-> (LabelKey -> LabelKey -> Bool) -> Eq LabelKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelKey -> LabelKey -> Bool
== :: LabelKey -> LabelKey -> Bool
$c/= :: LabelKey -> LabelKey -> Bool
/= :: LabelKey -> LabelKey -> Bool
Eq, Eq LabelKey
Eq LabelKey =>
(LabelKey -> LabelKey -> Ordering)
-> (LabelKey -> LabelKey -> Bool)
-> (LabelKey -> LabelKey -> Bool)
-> (LabelKey -> LabelKey -> Bool)
-> (LabelKey -> LabelKey -> Bool)
-> (LabelKey -> LabelKey -> LabelKey)
-> (LabelKey -> LabelKey -> LabelKey)
-> Ord LabelKey
LabelKey -> LabelKey -> Bool
LabelKey -> LabelKey -> Ordering
LabelKey -> LabelKey -> LabelKey
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
$ccompare :: LabelKey -> LabelKey -> Ordering
compare :: LabelKey -> LabelKey -> Ordering
$c< :: LabelKey -> LabelKey -> Bool
< :: LabelKey -> LabelKey -> Bool
$c<= :: LabelKey -> LabelKey -> Bool
<= :: LabelKey -> LabelKey -> Bool
$c> :: LabelKey -> LabelKey -> Bool
> :: LabelKey -> LabelKey -> Bool
$c>= :: LabelKey -> LabelKey -> Bool
>= :: LabelKey -> LabelKey -> Bool
$cmax :: LabelKey -> LabelKey -> LabelKey
max :: LabelKey -> LabelKey -> LabelKey
$cmin :: LabelKey -> LabelKey -> LabelKey
min :: LabelKey -> LabelKey -> LabelKey
Ord, Int -> LabelKey -> ShowS
[LabelKey] -> ShowS
LabelKey -> String
(Int -> LabelKey -> ShowS)
-> (LabelKey -> String) -> ([LabelKey] -> ShowS) -> Show LabelKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelKey -> ShowS
showsPrec :: Int -> LabelKey -> ShowS
$cshow :: LabelKey -> String
show :: LabelKey -> String
$cshowList :: [LabelKey] -> ShowS
showList :: [LabelKey] -> ShowS
Show)

type Parser = Parser.Parsec Void Text

labelKeyPrefixParser :: Parser Text
labelKeyPrefixParser :: Parser Text
labelKeyPrefixParser = do
  [Text]
xs <- Parser Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 (String -> Text
Text.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Parser.some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'.')
  Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'/'
  Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"." [Text]
xs

labelKeyNameParser :: Parser Text
labelKeyNameParser :: Parser Text
labelKeyNameParser = do
  Char
x <- ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar
  let loop :: Bool -> Parser [Char]
      loop :: Bool -> ParsecT Void Text Identity String
loop Bool
afterSymbol = [ParsecT Void Text Identity String]
-> ParsecT Void Text Identity String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
        [ (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
False
        , (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'-' ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
True
        , (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'_' ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
True
        , (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'.' ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
True
        , if Bool
afterSymbol
             then String -> ParsecT Void Text Identity String
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Label key name must end in alphanumeric character."
             else String -> ParsecT Void Text Identity String
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          ]
  String
xs <- Bool -> ParsecT Void Text Identity String
loop Bool
False
  Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

labelKeyParser :: Parser LabelKey
labelKeyParser :: Parser LabelKey
labelKeyParser = do
  Maybe Text
prefix <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parser.optional (Parser Text -> ParsecT Void Text Identity (Maybe Text))
-> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Parser.try Parser Text
labelKeyPrefixParser
  Text
name <- Parser Text
labelKeyNameParser
  LabelKey -> Parser LabelKey
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LabelKey -> Parser LabelKey) -> LabelKey -> Parser LabelKey
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> LabelKey
LabelKey Maybe Text
prefix Text
name

labelKeyRender :: LabelKey -> Text
labelKeyRender :: LabelKey -> Text
labelKeyRender LabelKey
k = case LabelKey -> Maybe Text
labelKeyPrefix LabelKey
k of
  Just Text
prefix -> [Text] -> Text
Text.concat [ Text
prefix, Text
"/", LabelKey -> Text
labelKeyName LabelKey
k ]
  Maybe Text
_ -> LabelKey -> Text
labelKeyName LabelKey
k

instance FromJSON LabelKey where
  parseJSON :: Value -> Parser LabelKey
parseJSON = String -> (Text -> Parser LabelKey) -> Value -> Parser LabelKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"LabelKey" ((Text -> Parser LabelKey) -> Value -> Parser LabelKey)
-> (Text -> Parser LabelKey) -> Value -> Parser LabelKey
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (ParseErrorBundle Text Void -> Parser LabelKey)
-> (LabelKey -> Parser LabelKey)
-> Either (ParseErrorBundle Text Void) LabelKey
-> Parser LabelKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser LabelKey
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LabelKey)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Parser LabelKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) LabelKey -> Parser LabelKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) LabelKey -> Parser LabelKey)
-> Either (ParseErrorBundle Text Void) LabelKey -> Parser LabelKey
forall a b. (a -> b) -> a -> b
$
      Parser LabelKey
-> String -> Text -> Either (ParseErrorBundle Text Void) LabelKey
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser Parser LabelKey
labelKeyParser String
"JSON" Text
t

instance ToJSON LabelKey where
   toJSON :: LabelKey -> Value
toJSON = Text -> Value
JSON.String (Text -> Value) -> (LabelKey -> Text) -> LabelKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelKey -> Text
labelKeyRender

instance FromJSONKey LabelKey where
  fromJSONKey :: FromJSONKeyFunction LabelKey
fromJSONKey = (Text -> Parser LabelKey) -> FromJSONKeyFunction LabelKey
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
JSON.FromJSONKeyTextParser ((Text -> Parser LabelKey) -> FromJSONKeyFunction LabelKey)
-> (Text -> Parser LabelKey) -> FromJSONKeyFunction LabelKey
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (ParseErrorBundle Text Void -> Parser LabelKey)
-> (LabelKey -> Parser LabelKey)
-> Either (ParseErrorBundle Text Void) LabelKey
-> Parser LabelKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser LabelKey
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LabelKey)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Parser LabelKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) LabelKey -> Parser LabelKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) LabelKey -> Parser LabelKey)
-> Either (ParseErrorBundle Text Void) LabelKey -> Parser LabelKey
forall a b. (a -> b) -> a -> b
$
      Parser LabelKey
-> String -> Text -> Either (ParseErrorBundle Text Void) LabelKey
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (Parser LabelKey
labelKeyParser Parser LabelKey -> ParsecT Void Text Identity () -> Parser LabelKey
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Parser.eof) String
"JSON key" Text
t

instance ToJSONKey LabelKey where
  toJSONKey :: ToJSONKeyFunction LabelKey
toJSONKey =
    (LabelKey -> Key)
-> (LabelKey -> Encoding' Key) -> ToJSONKeyFunction LabelKey
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
JSON.ToJSONKeyText
      (Text -> Key
JSONKey.fromText (Text -> Key) -> (LabelKey -> Text) -> LabelKey -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelKey -> Text
labelKeyRender)
      (Text -> Encoding' Key
forall a. Text -> Encoding' a
JSONEncoding.text (Text -> Encoding' Key)
-> (LabelKey -> Text) -> LabelKey -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelKey -> Text
labelKeyRender)

-- | Labels are key-value pairs that can be attached to all resources.
data Label = Label
  { Label -> LabelKey
labelKey :: LabelKey
  , Label -> Text
labelValue :: Text
    } deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
Eq, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> String
show :: Label -> String
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
Show)

labelValueParser :: Parser Text
labelValueParser :: Parser Text
labelValueParser = do
  let loop :: Bool -> Parser [Char]
      loop :: Bool -> ParsecT Void Text Identity String
loop Bool
afterSymbol = [ParsecT Void Text Identity String]
-> ParsecT Void Text Identity String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
        [ (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
False
        , (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'-' ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
True
        , (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'_' ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
True
        , (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'.' ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ParsecT Void Text Identity String
loop Bool
True
        , if Bool
afterSymbol
             then String -> ParsecT Void Text Identity String
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Label value must end in alphanumeric character."
             else String -> ParsecT Void Text Identity String
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          ]
  Maybe Char
mx <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parser.optional ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar
  case Maybe Char
mx of
    Just Char
x -> String -> Text
Text.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
x (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ParsecT Void Text Identity String
loop Bool
False
    Maybe Char
_ -> Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty

-- | A label map maps label keys to values.
type LabelMap = Map LabelKey Text

-- | Build a label map from a list of labels.
toLabelMap :: [Label] -> LabelMap
toLabelMap :: [Label] -> LabelMap
toLabelMap = (Label -> LabelMap -> LabelMap) -> LabelMap -> [Label] -> LabelMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Label
label -> LabelKey -> Text -> LabelMap -> LabelMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Label -> LabelKey
labelKey Label
label) (Text -> LabelMap -> LabelMap) -> Text -> LabelMap -> LabelMap
forall a b. (a -> b) -> a -> b
$ Label -> Text
labelValue Label
label) LabelMap
forall k a. Map k a
Map.empty

-- | Get a list of labels from a label map.
fromLabelMap :: LabelMap -> [Label]
fromLabelMap :: LabelMap -> [Label]
fromLabelMap = (LabelKey -> Text -> [Label] -> [Label])
-> [Label] -> LabelMap -> [Label]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\LabelKey
k Text
v [Label]
xs -> LabelKey -> Text -> Label
Label LabelKey
k Text
v Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
: [Label]
xs) []

-- | Label selectors can be used to filter resources.
data LabelSelector =
    -- | Select when label is equal.
    LabelEqual Label
    -- | Select when label is not equal.
  | LabelNotEqual Label
    -- | Select when key is present.
  | KeyPresent LabelKey
    -- | Select when key is not present.
  | KeyNotPresent LabelKey
    -- | Select when label has one of the values.
  | KeyValueIn LabelKey [Text]
    -- | Select when label has none of the values.
  | KeyValueNotIn LabelKey [Text]
    deriving Int -> LabelSelector -> ShowS
[LabelSelector] -> ShowS
LabelSelector -> String
(Int -> LabelSelector -> ShowS)
-> (LabelSelector -> String)
-> ([LabelSelector] -> ShowS)
-> Show LabelSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelSelector -> ShowS
showsPrec :: Int -> LabelSelector -> ShowS
$cshow :: LabelSelector -> String
show :: LabelSelector -> String
$cshowList :: [LabelSelector] -> ShowS
showList :: [LabelSelector] -> ShowS
Show

-- | Label selector parser.
labelSelectorParser :: Parser LabelSelector
labelSelectorParser :: Parser LabelSelector
labelSelectorParser = [Parser LabelSelector] -> Parser LabelSelector
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
  [ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'!' ParsecT Void Text Identity (Token Text)
-> Parser LabelSelector -> Parser LabelSelector
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (LabelKey -> LabelSelector
KeyNotPresent (LabelKey -> LabelSelector)
-> Parser LabelKey -> Parser LabelSelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LabelKey
labelKeyParser)
  , do LabelKey
k <- Parser LabelKey
labelKeyParser
       [Parser LabelSelector] -> Parser LabelSelector
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
         [ do Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'='
              Maybe (Token Text)
_ <- ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parser.optional (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity (Maybe (Token Text)))
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Maybe (Token Text))
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'='
              Text
v <- Parser Text
labelValueParser
              LabelSelector -> Parser LabelSelector
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LabelSelector -> Parser LabelSelector)
-> LabelSelector -> Parser LabelSelector
forall a b. (a -> b) -> a -> b
$ Label -> LabelSelector
LabelEqual (Label -> LabelSelector) -> Label -> LabelSelector
forall a b. (a -> b) -> a -> b
$ LabelKey -> Text -> Label
Label LabelKey
k Text
v
         , do Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'!'
              Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'='
              Text
v <- Parser Text
labelValueParser
              LabelSelector -> Parser LabelSelector
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LabelSelector -> Parser LabelSelector)
-> LabelSelector -> Parser LabelSelector
forall a b. (a -> b) -> a -> b
$ Label -> LabelSelector
LabelNotEqual (Label -> LabelSelector) -> Label -> LabelSelector
forall a b. (a -> b) -> a -> b
$ LabelKey -> Text -> Label
Label LabelKey
k Text
v
         , do Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
' '
              [Parser LabelSelector] -> Parser LabelSelector
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
                [ do Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parser.chunk Tokens Text
"in ("
                     [Text]
vs <- Parser Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 Parser Text
labelValueParser (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [Text])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Text]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
','
                     Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
')'
                     LabelSelector -> Parser LabelSelector
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LabelSelector -> Parser LabelSelector)
-> LabelSelector -> Parser LabelSelector
forall a b. (a -> b) -> a -> b
$ LabelKey -> [Text] -> LabelSelector
KeyValueIn LabelKey
k [Text]
vs
                , do Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parser.chunk Tokens Text
"notin ("
                     [Text]
vs <- Parser Text
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 Parser Text
labelValueParser (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [Text])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Text]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
','
                     Token Text
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
')'
                     LabelSelector -> Parser LabelSelector
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LabelSelector -> Parser LabelSelector)
-> LabelSelector -> Parser LabelSelector
forall a b. (a -> b) -> a -> b
$ LabelKey -> [Text] -> LabelSelector
KeyValueNotIn LabelKey
k [Text]
vs
                  ]
         , LabelSelector -> Parser LabelSelector
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LabelSelector -> Parser LabelSelector)
-> LabelSelector -> Parser LabelSelector
forall a b. (a -> b) -> a -> b
$ LabelKey -> LabelSelector
KeyPresent LabelKey
k
           ]
    ]

renderLabelSelector :: LabelSelector -> Text
renderLabelSelector :: LabelSelector -> Text
renderLabelSelector (LabelEqual Label
l) =
  LabelKey -> Text
labelKeyRender (Label -> LabelKey
labelKey Label
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"==" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
labelValue Label
l
renderLabelSelector (LabelNotEqual Label
l) =
  LabelKey -> Text
labelKeyRender (Label -> LabelKey
labelKey Label
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
labelValue Label
l
renderLabelSelector (KeyPresent LabelKey
k) = LabelKey -> Text
labelKeyRender LabelKey
k
renderLabelSelector (KeyNotPresent LabelKey
k) = Text
"!" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LabelKey -> Text
labelKeyRender LabelKey
k
renderLabelSelector (KeyValueIn LabelKey
k [Text]
vs) =
  LabelKey -> Text
labelKeyRender LabelKey
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
vs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderLabelSelector (KeyValueNotIn LabelKey
k [Text]
vs) =
  LabelKey -> Text
labelKeyRender LabelKey
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" notin (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
vs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Combine a list of label selectors, giving you a selector that
--   selects labels that match /all/ selectors in the list.
newtype LabelSelectorAll = LabelSelectorAll [LabelSelector] deriving Int -> LabelSelectorAll -> ShowS
[LabelSelectorAll] -> ShowS
LabelSelectorAll -> String
(Int -> LabelSelectorAll -> ShowS)
-> (LabelSelectorAll -> String)
-> ([LabelSelectorAll] -> ShowS)
-> Show LabelSelectorAll
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelSelectorAll -> ShowS
showsPrec :: Int -> LabelSelectorAll -> ShowS
$cshow :: LabelSelectorAll -> String
show :: LabelSelectorAll -> String
$cshowList :: [LabelSelectorAll] -> ShowS
showList :: [LabelSelectorAll] -> ShowS
Show

instance FromJSON LabelSelectorAll where
  parseJSON :: Value -> Parser LabelSelectorAll
parseJSON = String
-> (Text -> Parser LabelSelectorAll)
-> Value
-> Parser LabelSelectorAll
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"LabelSelector" ((Text -> Parser LabelSelectorAll)
 -> Value -> Parser LabelSelectorAll)
-> (Text -> Parser LabelSelectorAll)
-> Value
-> Parser LabelSelectorAll
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (ParseErrorBundle Text Void -> Parser LabelSelectorAll)
-> (LabelSelectorAll -> Parser LabelSelectorAll)
-> Either (ParseErrorBundle Text Void) LabelSelectorAll
-> Parser LabelSelectorAll
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser LabelSelectorAll
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LabelSelectorAll)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Parser LabelSelectorAll
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) LabelSelectorAll -> Parser LabelSelectorAll
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) LabelSelectorAll
 -> Parser LabelSelectorAll)
-> Either (ParseErrorBundle Text Void) LabelSelectorAll
-> Parser LabelSelectorAll
forall a b. (a -> b) -> a -> b
$
      let parser :: ParsecT Void Text Identity LabelSelectorAll
parser = ([LabelSelector] -> LabelSelectorAll)
-> ParsecT Void Text Identity [LabelSelector]
-> ParsecT Void Text Identity LabelSelectorAll
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LabelSelector] -> LabelSelectorAll
LabelSelectorAll (ParsecT Void Text Identity [LabelSelector]
 -> ParsecT Void Text Identity LabelSelectorAll)
-> ParsecT Void Text Identity [LabelSelector]
-> ParsecT Void Text Identity LabelSelectorAll
forall a b. (a -> b) -> a -> b
$ Parser LabelSelector
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [LabelSelector]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 Parser LabelSelector
labelSelectorParser (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [LabelSelector])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [LabelSelector]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
','
      in  ParsecT Void Text Identity LabelSelectorAll
-> String
-> Text
-> Either (ParseErrorBundle Text Void) LabelSelectorAll
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (ParsecT Void Text Identity LabelSelectorAll
parser ParsecT Void Text Identity LabelSelectorAll
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity LabelSelectorAll
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Parser.eof) String
"JSON" Text
t

instance ToJSON LabelSelectorAll where
  toJSON :: LabelSelectorAll -> Value
toJSON (LabelSelectorAll [LabelSelector]
xs) = Text -> Value
JSON.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
    Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (LabelSelector -> Text) -> [LabelSelector] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LabelSelector -> Text
renderLabelSelector [LabelSelector]
xs

-- | Pagination information.
data Pagination = Pagination
  { Pagination -> Int
currentPage :: Int
  , Pagination -> Int
itemsPerPage :: Int
  , Pagination -> Maybe Int
previousPage :: Maybe Int
  , Pagination -> Maybe Int
nextPage :: Maybe Int
  , Pagination -> Maybe Int
lastPage :: Maybe Int
  , Pagination -> Maybe Int
totalEntries :: Maybe Int
    } deriving Int -> Pagination -> ShowS
[Pagination] -> ShowS
Pagination -> String
(Int -> Pagination -> ShowS)
-> (Pagination -> String)
-> ([Pagination] -> ShowS)
-> Show Pagination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pagination -> ShowS
showsPrec :: Int -> Pagination -> ShowS
$cshow :: Pagination -> String
show :: Pagination -> String
$cshowList :: [Pagination] -> ShowS
showList :: [Pagination] -> ShowS
Show

instance FromJSON Pagination where
  parseJSON :: Value -> Parser Pagination
parseJSON = String
-> (Object -> Parser Pagination) -> Value -> Parser Pagination
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Pagination" ((Object -> Parser Pagination) -> Value -> Parser Pagination)
-> (Object -> Parser Pagination) -> Value -> Parser Pagination
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Pagination
Pagination
    (Int
 -> Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Pagination)
-> Parser Int
-> Parser
     (Int
      -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Pagination)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"page"
    Parser
  (Int
   -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Pagination)
-> Parser Int
-> Parser
     (Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Pagination)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"per_page"
    Parser
  (Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> Pagination)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> Maybe Int -> Pagination)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previous_page"
    Parser (Maybe Int -> Maybe Int -> Maybe Int -> Pagination)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> Pagination)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next_page"
    Parser (Maybe Int -> Maybe Int -> Pagination)
-> Parser (Maybe Int) -> Parser (Maybe Int -> Pagination)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_page"
    Parser (Maybe Int -> Pagination)
-> Parser (Maybe Int) -> Parser Pagination
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_entries"

-- | Network zones.
data Region =
    -- | Nuremberg, Falkenstein, Helsinki.
    EUCentral
    -- | Hillsboro (OR).
  | USWest
    -- | Ashburn (VA).
  | USEast deriving (Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
/= :: Region -> Region -> Bool
Eq, Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Region -> ShowS
showsPrec :: Int -> Region -> ShowS
$cshow :: Region -> String
show :: Region -> String
$cshowList :: [Region] -> ShowS
showList :: [Region] -> ShowS
Show)

instance FromJSON Region where
  parseJSON :: Value -> Parser Region
parseJSON = String -> (Text -> Parser Region) -> Value -> Parser Region
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"Region" ((Text -> Parser Region) -> Value -> Parser Region)
-> (Text -> Parser Region) -> Value -> Parser Region
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"eu-central" -> Region -> Parser Region
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
EUCentral
    Text
"us-west" -> Region -> Parser Region
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
USWest
    Text
"us-east" -> Region -> Parser Region
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
USEast
    Text
_ -> String -> Parser Region
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Region) -> String -> Parser Region
forall a b. (a -> b) -> a -> b
$ String
"Unknown region: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

instance ToJSON Region where
  toJSON :: Region -> Value
toJSON Region
r = case Region
r of
    Region
EUCentral -> Value
"eu-central"
    Region
USWest -> Value
"us-west"
    Region
USEast -> Value
"us-east"

-- | Metadata that any server in the Hetzner cloud can discover
--   about itself.
data Metadata = Metadata
  { -- | Server name.
    Metadata -> Text
metadataName :: Text
    -- | ID of the server.
  , Metadata -> ServerID
metadataServerID :: ServerID
    -- | Primary public IPv4 address.
  , Metadata -> IPv4
metadataPublicIPv4 :: IPv4
    -- | Datacenter.
  , Metadata -> Text
metadataDatacenter :: Text
    -- | Network zone.
  , Metadata -> Region
metadataRegion :: Region
    } deriving Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show

instance FromJSON Metadata where
  parseJSON :: Value -> Parser Metadata
parseJSON = String -> (Object -> Parser Metadata) -> Value -> Parser Metadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Metadata" ((Object -> Parser Metadata) -> Value -> Parser Metadata)
-> (Object -> Parser Metadata) -> Value -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> ServerID -> IPv4 -> Text -> Region -> Metadata
Metadata
    (Text -> ServerID -> IPv4 -> Text -> Region -> Metadata)
-> Parser Text
-> Parser (ServerID -> IPv4 -> Text -> Region -> Metadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hostname"
    Parser (ServerID -> IPv4 -> Text -> Region -> Metadata)
-> Parser ServerID -> Parser (IPv4 -> Text -> Region -> Metadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ServerID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"instance-id"
    Parser (IPv4 -> Text -> Region -> Metadata)
-> Parser IPv4 -> Parser (Text -> Region -> Metadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser IPv4
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public-ipv4"
    Parser (Text -> Region -> Metadata)
-> Parser Text -> Parser (Region -> Metadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"availability-zone"
    Parser (Region -> Metadata) -> Parser Region -> Parser Metadata
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Region
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"region"

-- | Generic metadata query.
metadataQuery
  :: FromJSON a
  => ByteString -- ^ Path
  -> IO a
metadataQuery :: forall a. FromJSON a => ByteString -> IO a
metadataQuery ByteString
path =
  let req :: Request
req = ByteString -> Request -> Request
HTTP.setRequestMethod ByteString
"GET"
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
False
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
"169.254.169.254"
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
80
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath (ByteString
"/hetzner/v1/metadata" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
path)
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  in  Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req IO (Response ByteString) -> (Response ByteString -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO a
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Yaml.decodeThrow (ByteString -> IO a)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall a. Response a -> a
HTTP.getResponseBody

-- | Obtain metadata from running server.
--   It doesn't need a 'Token' but must be
--   run from a server in Hetzner Cloud.
getMetadata :: IO Metadata
getMetadata :: IO Metadata
getMetadata = ByteString -> IO Metadata
forall a. FromJSON a => ByteString -> IO a
metadataQuery ByteString
forall a. Monoid a => a
mempty

-- | Exception produced while performing a request to Hetzner Cloud.
data CloudException =
    CloudError Error
  | JSONError (HTTP.Response ByteString) String
    deriving Int -> CloudException -> ShowS
[CloudException] -> ShowS
CloudException -> String
(Int -> CloudException -> ShowS)
-> (CloudException -> String)
-> ([CloudException] -> ShowS)
-> Show CloudException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloudException -> ShowS
showsPrec :: Int -> CloudException -> ShowS
$cshow :: CloudException -> String
show :: CloudException -> String
$cshowList :: [CloudException] -> ShowS
showList :: [CloudException] -> ShowS
Show

instance Exception CloudException

-- | A firewall ID and whether the firewall is applied or not.
data FirewallStatus = FirewallStatus
  { FirewallStatus -> FirewallID
firewallStatusID :: FirewallID
  , FirewallStatus -> Bool
firewallIsApplied :: Bool
    } deriving Int -> FirewallStatus -> ShowS
[FirewallStatus] -> ShowS
FirewallStatus -> String
(Int -> FirewallStatus -> ShowS)
-> (FirewallStatus -> String)
-> ([FirewallStatus] -> ShowS)
-> Show FirewallStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirewallStatus -> ShowS
showsPrec :: Int -> FirewallStatus -> ShowS
$cshow :: FirewallStatus -> String
show :: FirewallStatus -> String
$cshowList :: [FirewallStatus] -> ShowS
showList :: [FirewallStatus] -> ShowS
Show

instance FromJSON FirewallStatus where
  parseJSON :: Value -> Parser FirewallStatus
parseJSON = String
-> (Object -> Parser FirewallStatus)
-> Value
-> Parser FirewallStatus
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"FirewallStatus" ((Object -> Parser FirewallStatus)
 -> Value -> Parser FirewallStatus)
-> (Object -> Parser FirewallStatus)
-> Value
-> Parser FirewallStatus
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
status <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
    (FirewallID -> Bool -> FirewallStatus)
-> Parser FirewallID -> Parser Bool -> Parser FirewallStatus
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FirewallID -> Bool -> FirewallStatus
FirewallStatus (Object
o Object -> Key -> Parser FirewallID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id") (Parser Bool -> Parser FirewallStatus)
-> Parser Bool -> Parser FirewallStatus
forall a b. (a -> b) -> a -> b
$ case Text
status of
      Text
"applied" -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Text
"pending" -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Text
_ -> String -> Parser Bool
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Bool) -> String -> Parser Bool
forall a b. (a -> b) -> a -> b
$ String
"Invalid firewall status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
status

-- | Public IP information.
data PublicIPInfo dnsptr ip = PublicIPInfo
  { -- | Reverse DNS PTR entry/entries.
    forall dnsptr ip. PublicIPInfo dnsptr ip -> dnsptr
reverseDNS :: dnsptr
    -- | IP address/range.
  , forall dnsptr ip. PublicIPInfo dnsptr ip -> ip
publicIP :: ip
    } deriving Int -> PublicIPInfo dnsptr ip -> ShowS
[PublicIPInfo dnsptr ip] -> ShowS
PublicIPInfo dnsptr ip -> String
(Int -> PublicIPInfo dnsptr ip -> ShowS)
-> (PublicIPInfo dnsptr ip -> String)
-> ([PublicIPInfo dnsptr ip] -> ShowS)
-> Show (PublicIPInfo dnsptr ip)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall dnsptr ip.
(Show dnsptr, Show ip) =>
Int -> PublicIPInfo dnsptr ip -> ShowS
forall dnsptr ip.
(Show dnsptr, Show ip) =>
[PublicIPInfo dnsptr ip] -> ShowS
forall dnsptr ip.
(Show dnsptr, Show ip) =>
PublicIPInfo dnsptr ip -> String
$cshowsPrec :: forall dnsptr ip.
(Show dnsptr, Show ip) =>
Int -> PublicIPInfo dnsptr ip -> ShowS
showsPrec :: Int -> PublicIPInfo dnsptr ip -> ShowS
$cshow :: forall dnsptr ip.
(Show dnsptr, Show ip) =>
PublicIPInfo dnsptr ip -> String
show :: PublicIPInfo dnsptr ip -> String
$cshowList :: forall dnsptr ip.
(Show dnsptr, Show ip) =>
[PublicIPInfo dnsptr ip] -> ShowS
showList :: [PublicIPInfo dnsptr ip] -> ShowS
Show

instance (FromJSON dnsptr, FromJSON ip) => FromJSON (PublicIPInfo dnsptr ip) where
  parseJSON :: Value -> Parser (PublicIPInfo dnsptr ip)
parseJSON = String
-> (Object -> Parser (PublicIPInfo dnsptr ip))
-> Value
-> Parser (PublicIPInfo dnsptr ip)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"PublicIPInfo" ((Object -> Parser (PublicIPInfo dnsptr ip))
 -> Value -> Parser (PublicIPInfo dnsptr ip))
-> (Object -> Parser (PublicIPInfo dnsptr ip))
-> Value
-> Parser (PublicIPInfo dnsptr ip)
forall a b. (a -> b) -> a -> b
$ \Object
o -> dnsptr -> ip -> PublicIPInfo dnsptr ip
forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo
    (dnsptr -> ip -> PublicIPInfo dnsptr ip)
-> Parser dnsptr -> Parser (ip -> PublicIPInfo dnsptr ip)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser dnsptr
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dns_ptr"
    Parser (ip -> PublicIPInfo dnsptr ip)
-> Parser ip -> Parser (PublicIPInfo dnsptr ip)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ip
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip"

instance (ToJSON dnsptr, ToJSON ip) => ToJSON (PublicIPInfo dnsptr ip) where
  toJSON :: PublicIPInfo dnsptr ip -> Value
toJSON (PublicIPInfo dnsptr
dns ip
ip) = [Pair] -> Value
JSON.object [ Key
"dns_ptr" Key -> dnsptr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= dnsptr
dns, Key
"ip" Key -> ip -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ip
ip ]

instance Functor (PublicIPInfo dnsptr) where
  fmap :: forall a b.
(a -> b) -> PublicIPInfo dnsptr a -> PublicIPInfo dnsptr b
fmap a -> b
f (PublicIPInfo dnsptr
dns a
ip) = dnsptr -> b -> PublicIPInfo dnsptr b
forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo dnsptr
dns (a -> b
f a
ip)

instance Foldable (PublicIPInfo dnsptr) where
  foldMap :: forall m a. Monoid m => (a -> m) -> PublicIPInfo dnsptr a -> m
foldMap a -> m
f (PublicIPInfo dnsptr
_ a
ip) = a -> m
f a
ip

instance Traversable (PublicIPInfo dnsptr) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PublicIPInfo dnsptr a -> f (PublicIPInfo dnsptr b)
traverse a -> f b
f (PublicIPInfo dnsptr
dns a
ip) = dnsptr -> b -> PublicIPInfo dnsptr b
forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo dnsptr
dns (b -> PublicIPInfo dnsptr b) -> f b -> f (PublicIPInfo dnsptr b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
ip

-- | Public network information associated with a 'Server'.
data PublicNetwork = PublicNetwork
  { PublicNetwork -> [FirewallStatus]
publicNetworkFirewalls :: [FirewallStatus]
  , PublicNetwork -> [FloatingIPID]
publicNetworkFloatingIPs :: [FloatingIPID]
  , PublicNetwork -> Maybe (PublicIPInfo Text IPv4)
publicIPv4 :: Maybe (PublicIPInfo Text IPv4)
  , PublicNetwork
-> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
publicIPv6 :: Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
    } deriving Int -> PublicNetwork -> ShowS
[PublicNetwork] -> ShowS
PublicNetwork -> String
(Int -> PublicNetwork -> ShowS)
-> (PublicNetwork -> String)
-> ([PublicNetwork] -> ShowS)
-> Show PublicNetwork
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicNetwork -> ShowS
showsPrec :: Int -> PublicNetwork -> ShowS
$cshow :: PublicNetwork -> String
show :: PublicNetwork -> String
$cshowList :: [PublicNetwork] -> ShowS
showList :: [PublicNetwork] -> ShowS
Show

instance FromJSON PublicNetwork where
  parseJSON :: Value -> Parser PublicNetwork
parseJSON = String
-> (Object -> Parser PublicNetwork)
-> Value
-> Parser PublicNetwork
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"PublicNetwork" ((Object -> Parser PublicNetwork) -> Value -> Parser PublicNetwork)
-> (Object -> Parser PublicNetwork)
-> Value
-> Parser PublicNetwork
forall a b. (a -> b) -> a -> b
$ \Object
o -> [FirewallStatus]
-> [FloatingIPID]
-> Maybe (PublicIPInfo Text IPv4)
-> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
-> PublicNetwork
PublicNetwork
    ([FirewallStatus]
 -> [FloatingIPID]
 -> Maybe (PublicIPInfo Text IPv4)
 -> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
 -> PublicNetwork)
-> Parser [FirewallStatus]
-> Parser
     ([FloatingIPID]
      -> Maybe (PublicIPInfo Text IPv4)
      -> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> PublicNetwork)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [FirewallStatus]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"firewalls"
    Parser
  ([FloatingIPID]
   -> Maybe (PublicIPInfo Text IPv4)
   -> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> PublicNetwork)
-> Parser [FloatingIPID]
-> Parser
     (Maybe (PublicIPInfo Text IPv4)
      -> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> PublicNetwork)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [FloatingIPID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"floating_ips"
    Parser
  (Maybe (PublicIPInfo Text IPv4)
   -> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> PublicNetwork)
-> Parser (Maybe (PublicIPInfo Text IPv4))
-> Parser
     (Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> PublicNetwork)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (PublicIPInfo Text IPv4))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ipv4"
    Parser
  (Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> PublicNetwork)
-> Parser (Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
-> Parser PublicNetwork
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key
-> Parser (Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ipv6"

-- | Generic Hetzner Cloud query.
--
--   This function is used to implement Hetzner Cloud queries.
--
--   If there is any issue while performing the request, a
--   'CloudException' will be thrown.
--
--   The page argument determines which page will be requested.
--   If not provided, it will request the first page.
--   If a page is requested outside the valid range, an empty
--   list will be returned, not a failure.
--
cloudQuery
  :: (ToJSON body, FromJSON a)
  => ByteString -- ^ Method
  -> ByteString -- ^ Path
  -> Maybe body -- ^ Request body. You may use 'noBody' to skip.
  -> Token -- ^ Authorization token
  -> Maybe Int -- ^ Page
  -> IO a
cloudQuery :: forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
method ByteString
path Maybe body
mbody (Token ByteString
token) Maybe Int
mpage = do
  let req :: Request
req = ByteString -> Request -> Request
HTTP.setRequestMethod ByteString
method
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
"api.hetzner.cloud"
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath (ByteString
"/v1" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
path)
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ (Request -> Request)
-> (body -> Request -> Request) -> Maybe body -> Request -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id body -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
HTTP.setRequestBodyJSON Maybe body
mbody
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Authorization" (ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token)
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ (Request -> Request)
-> (Int -> Request -> Request) -> Maybe Int -> Request -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id (\Int
page -> Query -> Request -> Request
HTTP.addToRequestQueryString
                                 [(ByteString
"page", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
page)]) Maybe Int
mpage
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let body :: ByteString
body = Response ByteString -> ByteString
forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Response ByteString -> Int
forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp) Int
100 of
    (Int
2,Int
m) ->
      let body' :: ByteString
body' = if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 then ByteString
"{}" else ByteString
body
      in  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body' of
            Left String
err -> CloudException -> IO a
forall e a. Exception e => e -> IO a
throwIO (CloudException -> IO a) -> CloudException -> IO a
forall a b. (a -> b) -> a -> b
$ Response ByteString -> String -> CloudException
JSONError Response ByteString
resp String
err
            Right a
x -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    (Int, Int)
_ -> case ByteString -> Either String (WithKey "error" Error)
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body of
           Left String
err -> CloudException -> IO a
forall e a. Exception e => e -> IO a
throwIO (CloudException -> IO a) -> CloudException -> IO a
forall a b. (a -> b) -> a -> b
$ Response ByteString -> String -> CloudException
JSONError Response ByteString
resp String
err
           Right WithKey "error" Error
x -> CloudException -> IO a
forall e a. Exception e => e -> IO a
throwIO (CloudException -> IO a) -> CloudException -> IO a
forall a b. (a -> b) -> a -> b
$ Error -> CloudException
CloudError (Error -> CloudException) -> Error -> CloudException
forall a b. (a -> b) -> a -> b
$ forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"error" WithKey "error" Error
x

-- | Used to send requests without a body.
noBody :: Maybe Void
noBody :: Maybe Void
noBody = Maybe Void
forall a. Maybe a
Nothing

-- | Stream results using a function that takes a page number,
--   going through all the pages.
streamPages
  :: forall key f a i m
   . (Foldable f, MonadIO m)
  -- | Function that takes page number and returns result.
  => (Maybe Int -> IO (WithMeta key (f a)))
  -- | Conduit-based stream that yields results downstream.
  -> ConduitT i a m ()
streamPages :: forall (key :: Symbol) (f :: * -> *) a i (m :: * -> *).
(Foldable f, MonadIO m) =>
(Maybe Int -> IO (WithMeta key (f a))) -> ConduitT i a m ()
streamPages Maybe Int -> IO (WithMeta key (f a))
f = Maybe Int -> ConduitT i a m ()
go Maybe Int
forall a. Maybe a
Nothing
  where
    go :: Maybe Int -> ConduitT i a m ()
    go :: Maybe Int -> ConduitT i a m ()
go Maybe Int
page = do
      WithMeta key (f a)
resp <- IO (WithMeta key (f a)) -> ConduitT i a m (WithMeta key (f a))
forall a. IO a -> ConduitT i a m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (WithMeta key (f a)) -> ConduitT i a m (WithMeta key (f a)))
-> IO (WithMeta key (f a)) -> ConduitT i a m (WithMeta key (f a))
forall a b. (a -> b) -> a -> b
$ Maybe Int -> IO (WithMeta key (f a))
f Maybe Int
page
      -- Yield results from response
      WithMeta key (f a)
-> (f a -> ConduitT i a m ()) -> ConduitT i a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ WithMeta key (f a)
resp ((f a -> ConduitT i a m ()) -> ConduitT i a m ())
-> (f a -> ConduitT i a m ()) -> ConduitT i a m ()
forall a b. (a -> b) -> a -> b
$ (a -> ConduitT i a m ()) -> f a -> ConduitT i a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield
      -- Continue if not in last page
      let pag :: Pagination
pag = ResponseMeta -> Pagination
pagination (ResponseMeta -> Pagination) -> ResponseMeta -> Pagination
forall a b. (a -> b) -> a -> b
$ WithMeta key (f a) -> ResponseMeta
forall (key :: Symbol) a. WithMeta key a -> ResponseMeta
responseMeta WithMeta key (f a)
resp
          cur :: Int
cur = Pagination -> Int
currentPage Pagination
pag
      let next :: Maybe Int
next = case Pagination -> Maybe Int
lastPage Pagination
pag of
                   Just Int
l -> if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cur
                                then Maybe Int
forall a. Maybe a
Nothing
                                else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                   Maybe Int
_ -> Pagination -> Maybe Int
nextPage Pagination
pag
      if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
next then () -> ConduitT i a m ()
forall a. a -> ConduitT i a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else Maybe Int -> ConduitT i a m ()
go Maybe Int
next

-- | Convenient function to turn streams into lists.
streamToList :: Monad m => ConduitT () a m () -> m [a]
streamToList :: forall (m :: * -> *) a. Monad m => ConduitT () a m () -> m [a]
streamToList = ConduitT () a m () -> m [a]
forall (m :: * -> *) a. Monad m => ConduitT () a m () -> m [a]
Conduit.sourceToList

-- | Wrap a value with the key of the value within a JSON object.
data WithKey (key :: Symbol) a = WithKey { forall (key :: Symbol) a. WithKey key a -> a
withoutKey :: a } deriving Int -> WithKey key a -> ShowS
[WithKey key a] -> ShowS
WithKey key a -> String
(Int -> WithKey key a -> ShowS)
-> (WithKey key a -> String)
-> ([WithKey key a] -> ShowS)
-> Show (WithKey key a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (key :: Symbol) a. Show a => Int -> WithKey key a -> ShowS
forall (key :: Symbol) a. Show a => [WithKey key a] -> ShowS
forall (key :: Symbol) a. Show a => WithKey key a -> String
$cshowsPrec :: forall (key :: Symbol) a. Show a => Int -> WithKey key a -> ShowS
showsPrec :: Int -> WithKey key a -> ShowS
$cshow :: forall (key :: Symbol) a. Show a => WithKey key a -> String
show :: WithKey key a -> String
$cshowList :: forall (key :: Symbol) a. Show a => [WithKey key a] -> ShowS
showList :: [WithKey key a] -> ShowS
Show

instance Functor (WithKey key) where
  fmap :: forall a b. (a -> b) -> WithKey key a -> WithKey key b
fmap a -> b
f (WithKey a
x) = b -> WithKey key b
forall (key :: Symbol) a. a -> WithKey key a
WithKey (a -> b
f a
x)

instance Foldable (WithKey key) where
  foldMap :: forall m a. Monoid m => (a -> m) -> WithKey key a -> m
foldMap a -> m
f = a -> m
f (a -> m) -> (WithKey key a -> a) -> WithKey key a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithKey key a -> a
forall (key :: Symbol) a. WithKey key a -> a
withoutKey

instance (KnownSymbol key, FromJSON a) => FromJSON (WithKey key a) where
  parseJSON :: Value -> Parser (WithKey key a)
parseJSON =
    let key :: String
key = Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @key)
    in  String
-> (Object -> Parser (WithKey key a))
-> Value
-> Parser (WithKey key a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject (String
"WithKey:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key) ((Object -> Parser (WithKey key a))
 -> Value -> Parser (WithKey key a))
-> (Object -> Parser (WithKey key a))
-> Value
-> Parser (WithKey key a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
          a -> WithKey key a
forall (key :: Symbol) a. a -> WithKey key a
WithKey (a -> WithKey key a) -> Parser a -> Parser (WithKey key a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
key

-- | A value together with response metadata.
--   The type is annotated with the JSON key of the value.
data WithMeta (key :: Symbol) a = WithMeta
  { -- | Response metadata.
    forall (key :: Symbol) a. WithMeta key a -> ResponseMeta
responseMeta :: ResponseMeta
    -- | The value alone, without the metadata.
  , forall (key :: Symbol) a. WithMeta key a -> a
withoutMeta :: a
    } deriving Int -> WithMeta key a -> ShowS
[WithMeta key a] -> ShowS
WithMeta key a -> String
(Int -> WithMeta key a -> ShowS)
-> (WithMeta key a -> String)
-> ([WithMeta key a] -> ShowS)
-> Show (WithMeta key a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (key :: Symbol) a. Show a => Int -> WithMeta key a -> ShowS
forall (key :: Symbol) a. Show a => [WithMeta key a] -> ShowS
forall (key :: Symbol) a. Show a => WithMeta key a -> String
$cshowsPrec :: forall (key :: Symbol) a. Show a => Int -> WithMeta key a -> ShowS
showsPrec :: Int -> WithMeta key a -> ShowS
$cshow :: forall (key :: Symbol) a. Show a => WithMeta key a -> String
show :: WithMeta key a -> String
$cshowList :: forall (key :: Symbol) a. Show a => [WithMeta key a] -> ShowS
showList :: [WithMeta key a] -> ShowS
Show

instance Functor (WithMeta key) where
  fmap :: forall a b. (a -> b) -> WithMeta key a -> WithMeta key b
fmap a -> b
f WithMeta key a
x = WithMeta key a
x { withoutMeta = f $ withoutMeta x }

instance Foldable (WithMeta key) where
  foldMap :: forall m a. Monoid m => (a -> m) -> WithMeta key a -> m
foldMap a -> m
f = a -> m
f (a -> m) -> (WithMeta key a -> a) -> WithMeta key a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMeta key a -> a
forall (key :: Symbol) a. WithMeta key a -> a
withoutMeta

instance (KnownSymbol key, FromJSON a) => FromJSON (WithMeta key a) where
  parseJSON :: Value -> Parser (WithMeta key a)
parseJSON =
    let key :: String
key = Proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @key)
    in  String
-> (Object -> Parser (WithMeta key a))
-> Value
-> Parser (WithMeta key a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject (String
"WithMeta:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key) ((Object -> Parser (WithMeta key a))
 -> Value -> Parser (WithMeta key a))
-> (Object -> Parser (WithMeta key a))
-> Value
-> Parser (WithMeta key a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
          ResponseMeta -> a -> WithMeta key a
forall (key :: Symbol) a. ResponseMeta -> a -> WithMeta key a
WithMeta (ResponseMeta -> a -> WithMeta key a)
-> Parser ResponseMeta -> Parser (a -> WithMeta key a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ResponseMeta
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"meta" Parser (a -> WithMeta key a) -> Parser a -> Parser (WithMeta key a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
key

-- | Metadata attached to a response.
data ResponseMeta = ResponseMeta
  { ResponseMeta -> Pagination
pagination :: Pagination
    } deriving Int -> ResponseMeta -> ShowS
[ResponseMeta] -> ShowS
ResponseMeta -> String
(Int -> ResponseMeta -> ShowS)
-> (ResponseMeta -> String)
-> ([ResponseMeta] -> ShowS)
-> Show ResponseMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseMeta -> ShowS
showsPrec :: Int -> ResponseMeta -> ShowS
$cshow :: ResponseMeta -> String
show :: ResponseMeta -> String
$cshowList :: [ResponseMeta] -> ShowS
showList :: [ResponseMeta] -> ShowS
Show

instance FromJSON ResponseMeta where
  parseJSON :: Value -> Parser ResponseMeta
parseJSON = String
-> (Object -> Parser ResponseMeta) -> Value -> Parser ResponseMeta
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"ResponseMeta" ((Object -> Parser ResponseMeta) -> Value -> Parser ResponseMeta)
-> (Object -> Parser ResponseMeta) -> Value -> Parser ResponseMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Pagination -> ResponseMeta
ResponseMeta (Pagination -> ResponseMeta)
-> Parser Pagination -> Parser ResponseMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Pagination
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pagination"

-- | Equivalent to 'Either', but with a different json serialization.
data EitherParser a b = LeftParser a | RightParser b

-- | Equivalent of 'either' for 'EitherParser'.
eitherParser :: (a -> c) -> (b -> c) -> EitherParser a b -> c
eitherParser :: forall a c b. (a -> c) -> (b -> c) -> EitherParser a b -> c
eitherParser a -> c
f b -> c
_ (LeftParser a
a) = a -> c
f a
a
eitherParser a -> c
_ b -> c
g (RightParser b
b) = b -> c
g b
b

instance (FromJSON a, FromJSON b) => FromJSON (EitherParser a b) where
  parseJSON :: Value -> Parser (EitherParser a b)
parseJSON Value
v = (a -> EitherParser a b) -> Parser a -> Parser (EitherParser a b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> EitherParser a b
forall a b. a -> EitherParser a b
LeftParser (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON Value
v) Parser (EitherParser a b)
-> Parser (EitherParser a b) -> Parser (EitherParser a b)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b -> EitherParser a b) -> Parser b -> Parser (EitherParser a b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> EitherParser a b
forall a b. b -> EitherParser a b
RightParser (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON Value
v)

instance (ToJSON a, ToJSON b) => ToJSON (EitherParser a b) where
  toJSON :: EitherParser a b -> Value
toJSON (LeftParser a
a) = a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON a
a
  toJSON (RightParser b
b) = b -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON b
b

toEitherParser :: Either a b -> EitherParser a b
toEitherParser :: forall a b. Either a b -> EitherParser a b
toEitherParser = (a -> EitherParser a b)
-> (b -> EitherParser a b) -> Either a b -> EitherParser a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> EitherParser a b
forall a b. a -> EitherParser a b
LeftParser b -> EitherParser a b
forall a b. b -> EitherParser a b
RightParser

fromEitherParser :: EitherParser a b -> Either a b
fromEitherParser :: forall a b. EitherParser a b -> Either a b
fromEitherParser = (a -> Either a b)
-> (b -> Either a b) -> EitherParser a b -> Either a b
forall a c b. (a -> c) -> (b -> c) -> EitherParser a b -> c
eitherParser a -> Either a b
forall a b. a -> Either a b
Left b -> Either a b
forall a b. b -> Either a b
Right

----------------------------------------------------------------------------------------------------
-- Actions
----------------------------------------------------------------------------------------------------

-- | Status of an action.
data ActionStatus =
    -- | Action is still running. The 'Int' argument is the
    --   progress percentage.
    ActionRunning Int
    -- | Action finished successfully. The finishing time is
    --   provided.
  | ActionSuccess ZonedTime
    -- | Action finished with an error. The finishing time is
    --   provided, together with the error message.
  | ActionError ZonedTime Error
    deriving Int -> ActionStatus -> ShowS
[ActionStatus] -> ShowS
ActionStatus -> String
(Int -> ActionStatus -> ShowS)
-> (ActionStatus -> String)
-> ([ActionStatus] -> ShowS)
-> Show ActionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionStatus -> ShowS
showsPrec :: Int -> ActionStatus -> ShowS
$cshow :: ActionStatus -> String
show :: ActionStatus -> String
$cshowList :: [ActionStatus] -> ShowS
showList :: [ActionStatus] -> ShowS
Show

-- | Command performed by an action.
data ActionCommand =
    CreateServer
  | DeleteServer
  | StartServer
  | StopServer
  | ShutdownServer
  | RebootServer
  | SetFirewallRules
  | ApplyFirewall
  | CreateVolume
  | AttachVolume
  | ChangeDNSPtr
    deriving Int -> ActionCommand -> ShowS
[ActionCommand] -> ShowS
ActionCommand -> String
(Int -> ActionCommand -> ShowS)
-> (ActionCommand -> String)
-> ([ActionCommand] -> ShowS)
-> Show ActionCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionCommand -> ShowS
showsPrec :: Int -> ActionCommand -> ShowS
$cshow :: ActionCommand -> String
show :: ActionCommand -> String
$cshowList :: [ActionCommand] -> ShowS
showList :: [ActionCommand] -> ShowS
Show

instance FromJSON ActionCommand where
  parseJSON :: Value -> Parser ActionCommand
parseJSON = String
-> (Text -> Parser ActionCommand) -> Value -> Parser ActionCommand
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"ActionCommand" ((Text -> Parser ActionCommand) -> Value -> Parser ActionCommand)
-> (Text -> Parser ActionCommand) -> Value -> Parser ActionCommand
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"create_server" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
CreateServer
    Text
"delete_server" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
DeleteServer
    Text
"start_server" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
StartServer
    Text
"stop_server" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
StopServer
    Text
"shutdown_server" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
ShutdownServer
    Text
"reboot_server" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
RebootServer
    Text
"set_firewall_rules" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
SetFirewallRules
    Text
"apply_firewall" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
ApplyFirewall
    Text
"create_volume" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
CreateVolume
    Text
"attach_volume" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
AttachVolume
    Text
"change_dns_ptr" -> ActionCommand -> Parser ActionCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionCommand
ChangeDNSPtr
    Text
_ -> String -> Parser ActionCommand
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActionCommand) -> String -> Parser ActionCommand
forall a b. (a -> b) -> a -> b
$ String
"Unknown action command " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | Action identifier.
newtype ActionID = ActionID Int deriving (ActionID -> ActionID -> Bool
(ActionID -> ActionID -> Bool)
-> (ActionID -> ActionID -> Bool) -> Eq ActionID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionID -> ActionID -> Bool
== :: ActionID -> ActionID -> Bool
$c/= :: ActionID -> ActionID -> Bool
/= :: ActionID -> ActionID -> Bool
Eq, Eq ActionID
Eq ActionID =>
(ActionID -> ActionID -> Ordering)
-> (ActionID -> ActionID -> Bool)
-> (ActionID -> ActionID -> Bool)
-> (ActionID -> ActionID -> Bool)
-> (ActionID -> ActionID -> Bool)
-> (ActionID -> ActionID -> ActionID)
-> (ActionID -> ActionID -> ActionID)
-> Ord ActionID
ActionID -> ActionID -> Bool
ActionID -> ActionID -> Ordering
ActionID -> ActionID -> ActionID
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
$ccompare :: ActionID -> ActionID -> Ordering
compare :: ActionID -> ActionID -> Ordering
$c< :: ActionID -> ActionID -> Bool
< :: ActionID -> ActionID -> Bool
$c<= :: ActionID -> ActionID -> Bool
<= :: ActionID -> ActionID -> Bool
$c> :: ActionID -> ActionID -> Bool
> :: ActionID -> ActionID -> Bool
$c>= :: ActionID -> ActionID -> Bool
>= :: ActionID -> ActionID -> Bool
$cmax :: ActionID -> ActionID -> ActionID
max :: ActionID -> ActionID -> ActionID
$cmin :: ActionID -> ActionID -> ActionID
min :: ActionID -> ActionID -> ActionID
Ord, Int -> ActionID -> ShowS
[ActionID] -> ShowS
ActionID -> String
(Int -> ActionID -> ShowS)
-> (ActionID -> String) -> ([ActionID] -> ShowS) -> Show ActionID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionID -> ShowS
showsPrec :: Int -> ActionID -> ShowS
$cshow :: ActionID -> String
show :: ActionID -> String
$cshowList :: [ActionID] -> ShowS
showList :: [ActionID] -> ShowS
Show, Maybe ActionID
Value -> Parser [ActionID]
Value -> Parser ActionID
(Value -> Parser ActionID)
-> (Value -> Parser [ActionID])
-> Maybe ActionID
-> FromJSON ActionID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ActionID
parseJSON :: Value -> Parser ActionID
$cparseJSONList :: Value -> Parser [ActionID]
parseJSONList :: Value -> Parser [ActionID]
$comittedField :: Maybe ActionID
omittedField :: Maybe ActionID
FromJSON)

-- | A resource ID is an ID from one of the available resources.
data ResourceID =
    -- | Server ID.
    ResourceServerID ServerID
    -- | Volume ID.
  | ResourceVolumeID VolumeID
    -- | Primary IP ID.
  | ResourcePrimaryIPID PrimaryIPID
    -- | Firewall ID.
  | ResourceFirewallID FirewallID
    deriving Int -> ResourceID -> ShowS
[ResourceID] -> ShowS
ResourceID -> String
(Int -> ResourceID -> ShowS)
-> (ResourceID -> String)
-> ([ResourceID] -> ShowS)
-> Show ResourceID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceID -> ShowS
showsPrec :: Int -> ResourceID -> ShowS
$cshow :: ResourceID -> String
show :: ResourceID -> String
$cshowList :: [ResourceID] -> ShowS
showList :: [ResourceID] -> ShowS
Show

instance FromJSON ResourceID where
  parseJSON :: Value -> Parser ResourceID
parseJSON = String
-> (Object -> Parser ResourceID) -> Value -> Parser ResourceID
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"ResourceID" ((Object -> Parser ResourceID) -> Value -> Parser ResourceID)
-> (Object -> Parser ResourceID) -> Value -> Parser ResourceID
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case Text
t :: Text of
      Text
"server" -> ServerID -> ResourceID
ResourceServerID (ServerID -> ResourceID) -> Parser ServerID -> Parser ResourceID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ServerID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
"volume" -> VolumeID -> ResourceID
ResourceVolumeID (VolumeID -> ResourceID) -> Parser VolumeID -> Parser ResourceID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser VolumeID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
"primary_ip" -> PrimaryIPID -> ResourceID
ResourcePrimaryIPID (PrimaryIPID -> ResourceID)
-> Parser PrimaryIPID -> Parser ResourceID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser PrimaryIPID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
"firewall" -> FirewallID -> ResourceID
ResourceFirewallID (FirewallID -> ResourceID)
-> Parser FirewallID -> Parser ResourceID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser FirewallID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
_ -> String -> Parser ResourceID
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ResourceID) -> String -> Parser ResourceID
forall a b. (a -> b) -> a -> b
$ String
"Unknown resource type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | Action.
data Action = Action
  { Action -> ActionID
actionID :: ActionID
  , Action -> ActionCommand
actionCommand :: ActionCommand
  , Action -> ActionStatus
actionStatus :: ActionStatus
  , Action -> ZonedTime
actionStarted :: ZonedTime
    -- | Resources the action relates to.
  , Action -> [ResourceID]
actionResources :: [ResourceID]
    } deriving Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show

instance FromJSON Action where
  parseJSON :: Value -> Parser Action
parseJSON = String -> (Object -> Parser Action) -> Value -> Parser Action
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Action" ((Object -> Parser Action) -> Value -> Parser Action)
-> (Object -> Parser Action) -> Value -> Parser Action
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ActionStatus
status <- do Text
statusText <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
                 case Text
statusText :: Text of
                   Text
"running" -> Int -> ActionStatus
ActionRunning (Int -> ActionStatus) -> Parser Int -> Parser ActionStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"progress"
                   Text
"success" -> ZonedTime -> ActionStatus
ActionSuccess (ZonedTime -> ActionStatus)
-> Parser ZonedTime -> Parser ActionStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"finished"
                   Text
"error" -> ZonedTime -> Error -> ActionStatus
ActionError (ZonedTime -> Error -> ActionStatus)
-> Parser ZonedTime -> Parser (Error -> ActionStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"finished" Parser (Error -> ActionStatus)
-> Parser Error -> Parser ActionStatus
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Error
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
                   Text
_ -> String -> Parser ActionStatus
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActionStatus) -> String -> Parser ActionStatus
forall a b. (a -> b) -> a -> b
$ String
"Unknown action status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
statusText
    ActionID
-> ActionCommand
-> ActionStatus
-> ZonedTime
-> [ResourceID]
-> Action
Action
     (ActionID
 -> ActionCommand
 -> ActionStatus
 -> ZonedTime
 -> [ResourceID]
 -> Action)
-> Parser ActionID
-> Parser
     (ActionCommand
      -> ActionStatus -> ZonedTime -> [ResourceID] -> Action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ActionID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
     Parser
  (ActionCommand
   -> ActionStatus -> ZonedTime -> [ResourceID] -> Action)
-> Parser ActionCommand
-> Parser (ActionStatus -> ZonedTime -> [ResourceID] -> Action)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ActionCommand
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"command"
     Parser (ActionStatus -> ZonedTime -> [ResourceID] -> Action)
-> Parser ActionStatus
-> Parser (ZonedTime -> [ResourceID] -> Action)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionStatus -> Parser ActionStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionStatus
status
     Parser (ZonedTime -> [ResourceID] -> Action)
-> Parser ZonedTime -> Parser ([ResourceID] -> Action)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"started"
     Parser ([ResourceID] -> Action)
-> Parser [ResourceID] -> Parser Action
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ResourceID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resources"

-- | Get a single action.
getAction :: Token -> ActionID -> IO Action
getAction :: Token -> ActionID -> IO Action
getAction Token
token (ActionID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/actions/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Wait until an action is complete and returns the finishing time.
--   It throws a 'CloudException' if the action fails.
waitForAction :: Token -> ActionID -> IO ZonedTime
waitForAction :: Token -> ActionID -> IO ZonedTime
waitForAction Token
token ActionID
i = IO ZonedTime
go
  where
    go :: IO ZonedTime
    go :: IO ZonedTime
go = do Action
action <- Token -> ActionID -> IO Action
getAction Token
token ActionID
i
            case Action -> ActionStatus
actionStatus Action
action of
              ActionRunning Int
_ -> Int -> IO ()
threadDelay Int
250000 IO () -> IO ZonedTime -> IO ZonedTime
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ZonedTime
go
              ActionSuccess ZonedTime
t -> ZonedTime -> IO ZonedTime
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZonedTime
t
              ActionError ZonedTime
_ Error
err -> CloudException -> IO ZonedTime
forall e a. Exception e => e -> IO a
throwIO (CloudException -> IO ZonedTime) -> CloudException -> IO ZonedTime
forall a b. (a -> b) -> a -> b
$ Error -> CloudException
CloudError Error
err

----------------------------------------------------------------------------------------------------
-- Datacenters
----------------------------------------------------------------------------------------------------

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

-- | Server types available in a datacenter.
data DatacenterServers = DatacenterServers
  { DatacenterServers -> [ServerTypeID]
availableServers :: [ServerTypeID]
  , DatacenterServers -> [ServerTypeID]
migrationAvailableServers :: [ServerTypeID]
  , DatacenterServers -> [ServerTypeID]
supportedServers :: [ServerTypeID]
    } deriving Int -> DatacenterServers -> ShowS
[DatacenterServers] -> ShowS
DatacenterServers -> String
(Int -> DatacenterServers -> ShowS)
-> (DatacenterServers -> String)
-> ([DatacenterServers] -> ShowS)
-> Show DatacenterServers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatacenterServers -> ShowS
showsPrec :: Int -> DatacenterServers -> ShowS
$cshow :: DatacenterServers -> String
show :: DatacenterServers -> String
$cshowList :: [DatacenterServers] -> ShowS
showList :: [DatacenterServers] -> ShowS
Show

instance FromJSON DatacenterServers where
  parseJSON :: Value -> Parser DatacenterServers
parseJSON = String
-> (Object -> Parser DatacenterServers)
-> Value
-> Parser DatacenterServers
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"DatacenterServers" ((Object -> Parser DatacenterServers)
 -> Value -> Parser DatacenterServers)
-> (Object -> Parser DatacenterServers)
-> Value
-> Parser DatacenterServers
forall a b. (a -> b) -> a -> b
$ \Object
o -> [ServerTypeID]
-> [ServerTypeID] -> [ServerTypeID] -> DatacenterServers
DatacenterServers
    ([ServerTypeID]
 -> [ServerTypeID] -> [ServerTypeID] -> DatacenterServers)
-> Parser [ServerTypeID]
-> Parser ([ServerTypeID] -> [ServerTypeID] -> DatacenterServers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [ServerTypeID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available"
    Parser ([ServerTypeID] -> [ServerTypeID] -> DatacenterServers)
-> Parser [ServerTypeID]
-> Parser ([ServerTypeID] -> DatacenterServers)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ServerTypeID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available_for_migration"
    Parser ([ServerTypeID] -> DatacenterServers)
-> Parser [ServerTypeID] -> Parser DatacenterServers
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ServerTypeID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"supported"

-- | A datacenter within a location.
data Datacenter = Datacenter
  { Datacenter -> DatacenterID
datacenterID :: DatacenterID
  , Datacenter -> Text
datacenterName :: Text
  , Datacenter -> Text
datacenterDescription :: Text
  , Datacenter -> Location
datacenterLocation :: Location
  , Datacenter -> DatacenterServers
datacenterServers :: DatacenterServers
    } deriving Int -> Datacenter -> ShowS
[Datacenter] -> ShowS
Datacenter -> String
(Int -> Datacenter -> ShowS)
-> (Datacenter -> String)
-> ([Datacenter] -> ShowS)
-> Show Datacenter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Datacenter -> ShowS
showsPrec :: Int -> Datacenter -> ShowS
$cshow :: Datacenter -> String
show :: Datacenter -> String
$cshowList :: [Datacenter] -> ShowS
showList :: [Datacenter] -> ShowS
Show

instance FromJSON Datacenter where
  parseJSON :: Value -> Parser Datacenter
parseJSON = String
-> (Object -> Parser Datacenter) -> Value -> Parser Datacenter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Datacenter" ((Object -> Parser Datacenter) -> Value -> Parser Datacenter)
-> (Object -> Parser Datacenter) -> Value -> Parser Datacenter
forall a b. (a -> b) -> a -> b
$ \Object
o -> DatacenterID
-> Text -> Text -> Location -> DatacenterServers -> Datacenter
Datacenter
    (DatacenterID
 -> Text -> Text -> Location -> DatacenterServers -> Datacenter)
-> Parser DatacenterID
-> Parser
     (Text -> Text -> Location -> DatacenterServers -> Datacenter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser DatacenterID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (Text -> Text -> Location -> DatacenterServers -> Datacenter)
-> Parser Text
-> Parser (Text -> Location -> DatacenterServers -> Datacenter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser (Text -> Location -> DatacenterServers -> Datacenter)
-> Parser Text
-> Parser (Location -> DatacenterServers -> Datacenter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Parser (Location -> DatacenterServers -> Datacenter)
-> Parser Location -> Parser (DatacenterServers -> Datacenter)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Location
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location"
    Parser (DatacenterServers -> Datacenter)
-> Parser DatacenterServers -> Parser Datacenter
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser DatacenterServers
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server_types"

-- | Datacenter list with a datacenter recommendation for new servers.
data DatacentersWithRecommendation = DatacentersWithRecommendation
  { DatacentersWithRecommendation -> [Datacenter]
datacenters :: [Datacenter]
    -- | The datacenter which is recommended to be used to create
    --   new servers.
  , DatacentersWithRecommendation -> DatacenterID
datacenterRecommendation :: DatacenterID
    } deriving Int -> DatacentersWithRecommendation -> ShowS
[DatacentersWithRecommendation] -> ShowS
DatacentersWithRecommendation -> String
(Int -> DatacentersWithRecommendation -> ShowS)
-> (DatacentersWithRecommendation -> String)
-> ([DatacentersWithRecommendation] -> ShowS)
-> Show DatacentersWithRecommendation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatacentersWithRecommendation -> ShowS
showsPrec :: Int -> DatacentersWithRecommendation -> ShowS
$cshow :: DatacentersWithRecommendation -> String
show :: DatacentersWithRecommendation -> String
$cshowList :: [DatacentersWithRecommendation] -> ShowS
showList :: [DatacentersWithRecommendation] -> ShowS
Show

instance FromJSON DatacentersWithRecommendation where
  parseJSON :: Value -> Parser DatacentersWithRecommendation
parseJSON = String
-> (Object -> Parser DatacentersWithRecommendation)
-> Value
-> Parser DatacentersWithRecommendation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"DatacentersWithRecommendation" ((Object -> Parser DatacentersWithRecommendation)
 -> Value -> Parser DatacentersWithRecommendation)
-> (Object -> Parser DatacentersWithRecommendation)
-> Value
-> Parser DatacentersWithRecommendation
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Datacenter] -> DatacenterID -> DatacentersWithRecommendation
DatacentersWithRecommendation
    ([Datacenter] -> DatacenterID -> DatacentersWithRecommendation)
-> Parser [Datacenter]
-> Parser (DatacenterID -> DatacentersWithRecommendation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Datacenter]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"datacenters"
    Parser (DatacenterID -> DatacentersWithRecommendation)
-> Parser DatacenterID -> Parser DatacentersWithRecommendation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser DatacenterID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"recommendation"

-- | Get all datacenters.
getDatacenters :: Token -> IO DatacentersWithRecommendation
getDatacenters :: Token -> IO DatacentersWithRecommendation
getDatacenters Token
token = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO DatacentersWithRecommendation
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/datacenters" Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Get a single datacenter.
getDatacenter :: Token -> DatacenterID -> IO Datacenter
getDatacenter :: Token -> DatacenterID -> IO Datacenter
getDatacenter Token
token (DatacenterID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"datacenter" (WithKey "datacenter" Datacenter -> Datacenter)
-> IO (WithKey "datacenter" Datacenter) -> IO Datacenter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "datacenter" Datacenter)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/datacenters/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Firewalls
----------------------------------------------------------------------------------------------------

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

-- | Traffic direction, whether incoming ('TrafficIn') or outgoing ('TrafficOut').
data TrafficDirection = TrafficIn | TrafficOut deriving (TrafficDirection -> TrafficDirection -> Bool
(TrafficDirection -> TrafficDirection -> Bool)
-> (TrafficDirection -> TrafficDirection -> Bool)
-> Eq TrafficDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TrafficDirection -> TrafficDirection -> Bool
== :: TrafficDirection -> TrafficDirection -> Bool
$c/= :: TrafficDirection -> TrafficDirection -> Bool
/= :: TrafficDirection -> TrafficDirection -> Bool
Eq, Int -> TrafficDirection -> ShowS
[TrafficDirection] -> ShowS
TrafficDirection -> String
(Int -> TrafficDirection -> ShowS)
-> (TrafficDirection -> String)
-> ([TrafficDirection] -> ShowS)
-> Show TrafficDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrafficDirection -> ShowS
showsPrec :: Int -> TrafficDirection -> ShowS
$cshow :: TrafficDirection -> String
show :: TrafficDirection -> String
$cshowList :: [TrafficDirection] -> ShowS
showList :: [TrafficDirection] -> ShowS
Show)

instance FromJSON TrafficDirection where
  parseJSON :: Value -> Parser TrafficDirection
parseJSON = String
-> (Text -> Parser TrafficDirection)
-> Value
-> Parser TrafficDirection
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"TrafficDirection" ((Text -> Parser TrafficDirection)
 -> Value -> Parser TrafficDirection)
-> (Text -> Parser TrafficDirection)
-> Value
-> Parser TrafficDirection
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text
t of
      Text
"in" -> TrafficDirection -> Parser TrafficDirection
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrafficDirection
TrafficIn
      Text
"out" -> TrafficDirection -> Parser TrafficDirection
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrafficDirection
TrafficOut
      Text
_ -> String -> Parser TrafficDirection
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TrafficDirection)
-> String -> Parser TrafficDirection
forall a b. (a -> b) -> a -> b
$ String
"Invalid traffic direction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

instance ToJSON TrafficDirection where
  toJSON :: TrafficDirection -> Value
toJSON TrafficDirection
TrafficIn = Text -> Value
JSON.String Text
"in"
  toJSON TrafficDirection
TrafficOut = Text -> Value
JSON.String Text
"out"

-- | A port range. It can contain only one port if both ends are the same.
data PortRange = PortRange Int Int deriving Int -> PortRange -> ShowS
[PortRange] -> ShowS
PortRange -> String
(Int -> PortRange -> ShowS)
-> (PortRange -> String)
-> ([PortRange] -> ShowS)
-> Show PortRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PortRange -> ShowS
showsPrec :: Int -> PortRange -> ShowS
$cshow :: PortRange -> String
show :: PortRange -> String
$cshowList :: [PortRange] -> ShowS
showList :: [PortRange] -> ShowS
Show

-- | A port range containing a single port.
singlePort :: Int -> PortRange
singlePort :: Int -> PortRange
singlePort Int
p = Int -> Int -> PortRange
PortRange Int
p Int
p

portRangeParser :: Parser PortRange
portRangeParser :: Parser PortRange
portRangeParser = do
  Int
p1 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Parser.decimal
  Bool
hasSecondPart <- (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
Token Text
'-' ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> ParsecT Void Text Identity Bool
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ParsecT Void Text Identity Bool
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  if Bool
hasSecondPart
     then Int -> Int -> PortRange
PortRange Int
p1 (Int -> PortRange)
-> ParsecT Void Text Identity Int -> Parser PortRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Parser.decimal
     else PortRange -> Parser PortRange
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PortRange -> Parser PortRange) -> PortRange -> Parser PortRange
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PortRange
PortRange Int
p1 Int
p1

instance FromJSON PortRange where
  parseJSON :: Value -> Parser PortRange
parseJSON = String -> (Text -> Parser PortRange) -> Value -> Parser PortRange
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"PortRange" ((Text -> Parser PortRange) -> Value -> Parser PortRange)
-> (Text -> Parser PortRange) -> Value -> Parser PortRange
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (ParseErrorBundle Text Void -> Parser PortRange)
-> (PortRange -> Parser PortRange)
-> Either (ParseErrorBundle Text Void) PortRange
-> Parser PortRange
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser PortRange
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PortRange)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Parser PortRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) PortRange -> Parser PortRange
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) PortRange -> Parser PortRange)
-> Either (ParseErrorBundle Text Void) PortRange
-> Parser PortRange
forall a b. (a -> b) -> a -> b
$
      Parser PortRange
-> String -> Text -> Either (ParseErrorBundle Text Void) PortRange
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (Parser PortRange
portRangeParser Parser PortRange
-> ParsecT Void Text Identity () -> Parser PortRange
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Parser.eof) String
"JSON" Text
t

instance ToJSON PortRange where
  toJSON :: PortRange -> Value
toJSON (PortRange Int
p1 Int
p2) = String -> Value
forall a. IsString a => String -> a
fromString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$
    if Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2
       then Int -> String
forall a. Show a => a -> String
show Int
p1
       else Int -> String
forall a. Show a => a -> String
show Int
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
p2

-- | Protocol used in a 'FirewallRule'.
data FirewallRuleProtocol =
    -- | TCP protocol on the given port range.
    FirewallRuleTCP PortRange
    -- | UDP protocol on the given port range.
  | FirewallRuleUDP PortRange
    -- | ICMP protocol.
  | FirewallRuleICMP
    -- | ESP protocol.
  | FirewallRuleESP
    -- | GRE protocol.
  | FirewallRuleGRE
    deriving Int -> FirewallRuleProtocol -> ShowS
[FirewallRuleProtocol] -> ShowS
FirewallRuleProtocol -> String
(Int -> FirewallRuleProtocol -> ShowS)
-> (FirewallRuleProtocol -> String)
-> ([FirewallRuleProtocol] -> ShowS)
-> Show FirewallRuleProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirewallRuleProtocol -> ShowS
showsPrec :: Int -> FirewallRuleProtocol -> ShowS
$cshow :: FirewallRuleProtocol -> String
show :: FirewallRuleProtocol -> String
$cshowList :: [FirewallRuleProtocol] -> ShowS
showList :: [FirewallRuleProtocol] -> ShowS
Show

-- | A firewall rule.
data FirewallRule = FirewallRule
  { -- | Optional description of the rule.
    FirewallRule -> Maybe Text
firewallRuleDescription :: Maybe Text
    -- | Traffic direction the rule applies to.
  , FirewallRule -> TrafficDirection
firewallRuleDirection :: TrafficDirection
    -- | IPs the rule applies to. You can use 'anyIPv4' and/or
    --   'anyIPv6' to allow any IPs.
  , FirewallRule -> NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs :: NonEmpty (Either IPv4Range IPv6Range)
    -- | Protocol the rule applies to.
  , FirewallRule -> FirewallRuleProtocol
firewallRuleProtocol :: FirewallRuleProtocol
    } deriving Int -> FirewallRule -> ShowS
[FirewallRule] -> ShowS
FirewallRule -> String
(Int -> FirewallRule -> ShowS)
-> (FirewallRule -> String)
-> ([FirewallRule] -> ShowS)
-> Show FirewallRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirewallRule -> ShowS
showsPrec :: Int -> FirewallRule -> ShowS
$cshow :: FirewallRule -> String
show :: FirewallRule -> String
$cshowList :: [FirewallRule] -> ShowS
showList :: [FirewallRule] -> ShowS
Show

instance FromJSON FirewallRule where
  parseJSON :: Value -> Parser FirewallRule
parseJSON = String
-> (Object -> Parser FirewallRule) -> Value -> Parser FirewallRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"FirewallRule" ((Object -> Parser FirewallRule) -> Value -> Parser FirewallRule)
-> (Object -> Parser FirewallRule) -> Value -> Parser FirewallRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TrafficDirection
dir <- Object
o Object -> Key -> Parser TrafficDirection
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"direction"
    NonEmpty (EitherParser IPv4Range IPv6Range)
ips <-
      case TrafficDirection
dir of
        TrafficDirection
TrafficIn -> Object
o Object
-> Key -> Parser (NonEmpty (EitherParser IPv4Range IPv6Range))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source_ips"
        TrafficDirection
TrafficOut -> Object
o Object
-> Key -> Parser (NonEmpty (EitherParser IPv4Range IPv6Range))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"destination_ips"
    Text
protocolType <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocol"
    FirewallRuleProtocol
protocol <-
      case Text
protocolType of
        Text
"tcp" -> PortRange -> FirewallRuleProtocol
FirewallRuleTCP (PortRange -> FirewallRuleProtocol)
-> Parser PortRange -> Parser FirewallRuleProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser PortRange
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
        Text
"udp" -> PortRange -> FirewallRuleProtocol
FirewallRuleUDP (PortRange -> FirewallRuleProtocol)
-> Parser PortRange -> Parser FirewallRuleProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser PortRange
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
        Text
"icmp" -> FirewallRuleProtocol -> Parser FirewallRuleProtocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
FirewallRuleICMP
        Text
"esp" -> FirewallRuleProtocol -> Parser FirewallRuleProtocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
FirewallRuleESP
        Text
"gre" -> FirewallRuleProtocol -> Parser FirewallRuleProtocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
FirewallRuleGRE
        Text
_ -> String -> Parser FirewallRuleProtocol
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FirewallRuleProtocol)
-> String -> Parser FirewallRuleProtocol
forall a b. (a -> b) -> a -> b
$ String
"Invalid protocol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
protocolType
    Maybe Text
-> TrafficDirection
-> NonEmpty (Either IPv4Range IPv6Range)
-> FirewallRuleProtocol
-> FirewallRule
FirewallRule
      (Maybe Text
 -> TrafficDirection
 -> NonEmpty (Either IPv4Range IPv6Range)
 -> FirewallRuleProtocol
 -> FirewallRule)
-> Parser (Maybe Text)
-> Parser
     (TrafficDirection
      -> NonEmpty (Either IPv4Range IPv6Range)
      -> FirewallRuleProtocol
      -> FirewallRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser
  (TrafficDirection
   -> NonEmpty (Either IPv4Range IPv6Range)
   -> FirewallRuleProtocol
   -> FirewallRule)
-> Parser TrafficDirection
-> Parser
     (NonEmpty (Either IPv4Range IPv6Range)
      -> FirewallRuleProtocol -> FirewallRule)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TrafficDirection -> Parser TrafficDirection
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrafficDirection
dir
      Parser
  (NonEmpty (Either IPv4Range IPv6Range)
   -> FirewallRuleProtocol -> FirewallRule)
-> Parser (NonEmpty (Either IPv4Range IPv6Range))
-> Parser (FirewallRuleProtocol -> FirewallRule)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty (Either IPv4Range IPv6Range)
-> Parser (NonEmpty (Either IPv4Range IPv6Range))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EitherParser IPv4Range IPv6Range -> Either IPv4Range IPv6Range)
-> NonEmpty (EitherParser IPv4Range IPv6Range)
-> NonEmpty (Either IPv4Range IPv6Range)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EitherParser IPv4Range IPv6Range -> Either IPv4Range IPv6Range
forall a b. EitherParser a b -> Either a b
fromEitherParser NonEmpty (EitherParser IPv4Range IPv6Range)
ips)
      Parser (FirewallRuleProtocol -> FirewallRule)
-> Parser FirewallRuleProtocol -> Parser FirewallRule
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FirewallRuleProtocol -> Parser FirewallRuleProtocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
protocol

instance ToJSON FirewallRule where
  toJSON :: FirewallRule -> Value
toJSON FirewallRule
rule =
    let dir :: TrafficDirection
dir = FirewallRule -> TrafficDirection
firewallRuleDirection FirewallRule
rule
        ips :: NonEmpty (EitherParser IPv4Range IPv6Range)
ips = (Either IPv4Range IPv6Range -> EitherParser IPv4Range IPv6Range)
-> NonEmpty (Either IPv4Range IPv6Range)
-> NonEmpty (EitherParser IPv4Range IPv6Range)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IPv4Range IPv6Range -> EitherParser IPv4Range IPv6Range
forall a b. Either a b -> EitherParser a b
toEitherParser (NonEmpty (Either IPv4Range IPv6Range)
 -> NonEmpty (EitherParser IPv4Range IPv6Range))
-> NonEmpty (Either IPv4Range IPv6Range)
-> NonEmpty (EitherParser IPv4Range IPv6Range)
forall a b. (a -> b) -> a -> b
$ FirewallRule -> NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs FirewallRule
rule
    in  [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
t) (FirewallRule -> Maybe Text
firewallRuleDescription FirewallRule
rule)
            [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [ Key
"direction" Key -> TrafficDirection -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TrafficDirection
dir
               , case TrafficDirection
dir of
                   TrafficDirection
TrafficIn -> Key
"source_ips" Key -> NonEmpty (EitherParser IPv4Range IPv6Range) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (EitherParser IPv4Range IPv6Range)
ips
                   TrafficDirection
TrafficOut -> Key
"destination_ips" Key -> NonEmpty (EitherParser IPv4Range IPv6Range) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (EitherParser IPv4Range IPv6Range)
ips
                 ]
            [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ (case FirewallRule -> FirewallRuleProtocol
firewallRuleProtocol FirewallRule
rule of
                  FirewallRuleTCP PortRange
r ->
                    [ Key
"protocol" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"tcp" :: Text)
                    , Key
"port" Key -> PortRange -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PortRange
r
                      ]
                  FirewallRuleUDP PortRange
r ->
                    [ Key
"protocol" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"udp" :: Text)
                    , Key
"port" Key -> PortRange -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PortRange
r
                      ]
                  FirewallRuleProtocol
FirewallRuleICMP -> [ Key
"protocol" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"icmp" :: Text) ]
                  FirewallRuleProtocol
FirewallRuleESP -> [ Key
"protocol" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"esp" :: Text) ]
                  FirewallRuleProtocol
FirewallRuleGRE -> [ Key
"protocol" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"gre" :: Text) ]
                 )

-- | A firewall that can be applied to other resources, via 'applyFirewall'
--   or directly on creation.
data Firewall = Firewall
  { Firewall -> FirewallID
firewallID :: FirewallID
    -- | The firewall's name.
  , Firewall -> Text
firewallName :: Text
    -- | Time the firewall was created.
  , Firewall -> ZonedTime
firewallCreated :: ZonedTime
    -- | Servers the firewall has been applied to.
  , Firewall -> [ServerID]
firewallServers :: [ServerID]
    -- | Label selectors used to apply the firewall automatically to
    --   matching resources.
  , Firewall -> [LabelSelectorAll]
firewallLabelSelectors :: [LabelSelectorAll]
    -- | Firewall rules.
  , Firewall -> [FirewallRule]
firewallRules :: [FirewallRule]
    -- | Labels attached to the firewall.
  , Firewall -> LabelMap
firewallLabels :: LabelMap
    } deriving Int -> Firewall -> ShowS
[Firewall] -> ShowS
Firewall -> String
(Int -> Firewall -> ShowS)
-> (Firewall -> String) -> ([Firewall] -> ShowS) -> Show Firewall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Firewall -> ShowS
showsPrec :: Int -> Firewall -> ShowS
$cshow :: Firewall -> String
show :: Firewall -> String
$cshowList :: [Firewall] -> ShowS
showList :: [Firewall] -> ShowS
Show

instance FromJSON Firewall where
  parseJSON :: Value -> Parser Firewall
parseJSON = String -> (Object -> Parser Firewall) -> Value -> Parser Firewall
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Firewall" ((Object -> Parser Firewall) -> Value -> Parser Firewall)
-> (Object -> Parser Firewall) -> Value -> Parser Firewall
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Value]
xs <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"applied_to"
    [Either ServerID LabelSelectorAll]
ys <- [Value]
-> (Value -> Parser (Either ServerID LabelSelectorAll))
-> Parser [Either ServerID LabelSelectorAll]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
xs ((Value -> Parser (Either ServerID LabelSelectorAll))
 -> Parser [Either ServerID LabelSelectorAll])
-> (Value -> Parser (Either ServerID LabelSelectorAll))
-> Parser [Either ServerID LabelSelectorAll]
forall a b. (a -> b) -> a -> b
$ \Value
v ->
            let f :: Object -> Parser (Either a b)
f Object
o' = do
                  Text
t <- Object
o' Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                  case Text
t of
                    Text
"server" -> do
                       Value
v' <- Object
o' Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server"
                       a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Parser a -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Server" (Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id") Value
v'
                    Text
"label_selector" -> do
                       Value
v' <- Object
o' Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label_selector"
                       b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Parser b -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Object -> Parser b) -> Value -> Parser b
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"LabelSelector" (Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"selector") Value
v'
                    Text
_ -> String -> Parser (Either a b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Either a b)) -> String -> Parser (Either a b)
forall a b. (a -> b) -> a -> b
$ String
"Invalid applied_to type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t
            in  String
-> (Object -> Parser (Either ServerID LabelSelectorAll))
-> Value
-> Parser (Either ServerID LabelSelectorAll)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"AppliedTo" Object -> Parser (Either ServerID LabelSelectorAll)
forall {a} {b}.
(FromJSON a, FromJSON b) =>
Object -> Parser (Either a b)
f Value
v
    let ([ServerID]
servers, [LabelSelectorAll]
labels) = [Either ServerID LabelSelectorAll]
-> ([ServerID], [LabelSelectorAll])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ServerID LabelSelectorAll]
ys
    FirewallID
-> Text
-> ZonedTime
-> [ServerID]
-> [LabelSelectorAll]
-> [FirewallRule]
-> LabelMap
-> Firewall
Firewall
      (FirewallID
 -> Text
 -> ZonedTime
 -> [ServerID]
 -> [LabelSelectorAll]
 -> [FirewallRule]
 -> LabelMap
 -> Firewall)
-> Parser FirewallID
-> Parser
     (Text
      -> ZonedTime
      -> [ServerID]
      -> [LabelSelectorAll]
      -> [FirewallRule]
      -> LabelMap
      -> Firewall)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser FirewallID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Text
   -> ZonedTime
   -> [ServerID]
   -> [LabelSelectorAll]
   -> [FirewallRule]
   -> LabelMap
   -> Firewall)
-> Parser Text
-> Parser
     (ZonedTime
      -> [ServerID]
      -> [LabelSelectorAll]
      -> [FirewallRule]
      -> LabelMap
      -> Firewall)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (ZonedTime
   -> [ServerID]
   -> [LabelSelectorAll]
   -> [FirewallRule]
   -> LabelMap
   -> Firewall)
-> Parser ZonedTime
-> Parser
     ([ServerID]
      -> [LabelSelectorAll] -> [FirewallRule] -> LabelMap -> Firewall)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
      Parser
  ([ServerID]
   -> [LabelSelectorAll] -> [FirewallRule] -> LabelMap -> Firewall)
-> Parser [ServerID]
-> Parser
     ([LabelSelectorAll] -> [FirewallRule] -> LabelMap -> Firewall)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ServerID] -> Parser [ServerID]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ServerID]
servers
      Parser
  ([LabelSelectorAll] -> [FirewallRule] -> LabelMap -> Firewall)
-> Parser [LabelSelectorAll]
-> Parser ([FirewallRule] -> LabelMap -> Firewall)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [LabelSelectorAll] -> Parser [LabelSelectorAll]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LabelSelectorAll]
labels
      Parser ([FirewallRule] -> LabelMap -> Firewall)
-> Parser [FirewallRule] -> Parser (LabelMap -> Firewall)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [FirewallRule]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rules"
      Parser (LabelMap -> Firewall) -> Parser LabelMap -> Parser Firewall
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"

-- | Information used to create a new firewall with 'createFirewall'.
data NewFirewall = NewFirewall
  { -- | The firewall's name.
    NewFirewall -> Text
newFirewallName :: Text
    -- | Labels to attach to the firewall on creation.
  , NewFirewall -> [Label]
newFirewallLabels :: [Label]
    -- | Firewall rules.
  , NewFirewall -> [FirewallRule]
newFirewallRules :: [FirewallRule]
    -- | List of servers to apply the firewall to on creation.
  , NewFirewall -> [ServerID]
newFirewallServers :: [ServerID]
    -- | Label selectors to apply the firewall to matching resources.
  , NewFirewall -> [LabelSelectorAll]
newFirewallLabelSelectors :: [LabelSelectorAll]
    }

-- | IPv4 range containing every IP.
anyIPv4 :: IPv4Range
anyIPv4 :: IPv4Range
anyIPv4 = IPv4 -> Word8 -> IPv4Range
IPv4.range IPv4
IPv4.any Word8
0

-- | IPv6 range containing every IP.
anyIPv6 :: IPv6Range
anyIPv6 :: IPv6Range
anyIPv6 = IPv6 -> Word8 -> IPv6Range
IPv6.range IPv6
IPv6.any Word8
0

-- | Default firewall with two rules:
--
-- * Allow SSH on default port 22 from any address.
-- * Allow ICMP from any address.
--
defaultNewFirewall
  :: Text -- ^ Firewall name.
  -> NewFirewall
defaultNewFirewall :: Text -> NewFirewall
defaultNewFirewall Text
name = NewFirewall
  { newFirewallName :: Text
newFirewallName = Text
name
  , newFirewallLabels :: [Label]
newFirewallLabels = []
  , newFirewallRules :: [FirewallRule]
newFirewallRules =
      [ FirewallRule
          { firewallRuleDescription :: Maybe Text
firewallRuleDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"SSH"
          , firewallRuleDirection :: TrafficDirection
firewallRuleDirection = TrafficDirection
TrafficIn
          , firewallRuleIPs :: NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs = IPv4Range -> Either IPv4Range IPv6Range
forall a b. a -> Either a b
Left IPv4Range
anyIPv4 Either IPv4Range IPv6Range
-> [Either IPv4Range IPv6Range]
-> NonEmpty (Either IPv4Range IPv6Range)
forall a. a -> [a] -> NonEmpty a
:| [IPv6Range -> Either IPv4Range IPv6Range
forall a b. b -> Either a b
Right IPv6Range
anyIPv6]
          , firewallRuleProtocol :: FirewallRuleProtocol
firewallRuleProtocol = PortRange -> FirewallRuleProtocol
FirewallRuleTCP (PortRange -> FirewallRuleProtocol)
-> PortRange -> FirewallRuleProtocol
forall a b. (a -> b) -> a -> b
$ Int -> PortRange
singlePort Int
22
            }
      , FirewallRule
          { firewallRuleDescription :: Maybe Text
firewallRuleDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ICMP"
          , firewallRuleDirection :: TrafficDirection
firewallRuleDirection = TrafficDirection
TrafficIn
          , firewallRuleIPs :: NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs = IPv4Range -> Either IPv4Range IPv6Range
forall a b. a -> Either a b
Left IPv4Range
anyIPv4 Either IPv4Range IPv6Range
-> [Either IPv4Range IPv6Range]
-> NonEmpty (Either IPv4Range IPv6Range)
forall a. a -> [a] -> NonEmpty a
:| [IPv6Range -> Either IPv4Range IPv6Range
forall a b. b -> Either a b
Right IPv6Range
anyIPv6]
          , firewallRuleProtocol :: FirewallRuleProtocol
firewallRuleProtocol = FirewallRuleProtocol
FirewallRuleICMP
            }
        ]
  , newFirewallServers :: [ServerID]
newFirewallServers = []
  , newFirewallLabelSelectors :: [LabelSelectorAll]
newFirewallLabelSelectors = []
    }

-- | Result of creating a firewall with 'createFirewall'.
data CreatedFirewall = CreatedFirewall
  { -- | Actions associated with the firewall's creation.
    CreatedFirewall -> [Action]
createdFirewallActions :: [Action]
    -- | The firewall just created.
  , CreatedFirewall -> Firewall
createdFirewall :: Firewall
    } deriving Int -> CreatedFirewall -> ShowS
[CreatedFirewall] -> ShowS
CreatedFirewall -> String
(Int -> CreatedFirewall -> ShowS)
-> (CreatedFirewall -> String)
-> ([CreatedFirewall] -> ShowS)
-> Show CreatedFirewall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedFirewall -> ShowS
showsPrec :: Int -> CreatedFirewall -> ShowS
$cshow :: CreatedFirewall -> String
show :: CreatedFirewall -> String
$cshowList :: [CreatedFirewall] -> ShowS
showList :: [CreatedFirewall] -> ShowS
Show

instance FromJSON CreatedFirewall where
  parseJSON :: Value -> Parser CreatedFirewall
parseJSON = String
-> (Object -> Parser CreatedFirewall)
-> Value
-> Parser CreatedFirewall
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"CreatedFirewall" ((Object -> Parser CreatedFirewall)
 -> Value -> Parser CreatedFirewall)
-> (Object -> Parser CreatedFirewall)
-> Value
-> Parser CreatedFirewall
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Action] -> Firewall -> CreatedFirewall
CreatedFirewall ([Action] -> Firewall -> CreatedFirewall)
-> Parser [Action] -> Parser (Firewall -> CreatedFirewall)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Action]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"actions" Parser (Firewall -> CreatedFirewall)
-> Parser Firewall -> Parser CreatedFirewall
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Firewall
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"firewall"

-- | Get all firewalls in a project.
getFirewalls :: Token -> Maybe Int -> IO (WithMeta "firewalls" [Firewall])
getFirewalls :: Token -> Maybe Int -> IO (WithMeta "firewalls" [Firewall])
getFirewalls = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "firewalls" [Firewall])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/firewalls" Maybe Void
noBody

-- | Get a single firewall.
getFirewall :: Token -> FirewallID -> IO Firewall
getFirewall :: Token -> FirewallID -> IO Firewall
getFirewall Token
token (FirewallID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"firewall" (WithKey "firewall" Firewall -> Firewall)
-> IO (WithKey "firewall" Firewall) -> IO Firewall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "firewall" Firewall)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/firewalls/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Create a firewall.
createFirewall :: Token -> NewFirewall -> IO CreatedFirewall
createFirewall :: Token -> NewFirewall -> IO CreatedFirewall
createFirewall Token
token NewFirewall
nfirewall =
  let servers :: [Value]
servers = (ServerID -> Value) -> [ServerID] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ServerID
i -> [Pair] -> Value
JSON.object [ Key
"server" Key -> ServerID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServerID
i ])
              ([ServerID] -> [Value]) -> [ServerID] -> [Value]
forall a b. (a -> b) -> a -> b
$ NewFirewall -> [ServerID]
newFirewallServers NewFirewall
nfirewall
      selectors :: [Value]
selectors = (LabelSelectorAll -> Value) -> [LabelSelectorAll] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LabelSelectorAll
s -> [Pair] -> Value
JSON.object [ Key
"selector" Key -> LabelSelectorAll -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LabelSelectorAll
s ])
                ([LabelSelectorAll] -> [Value]) -> [LabelSelectorAll] -> [Value]
forall a b. (a -> b) -> a -> b
$ NewFirewall -> [LabelSelectorAll]
newFirewallLabelSelectors NewFirewall
nfirewall
      applyTo :: [Value]
applyTo =
        (Value -> Value) -> [Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Value
v -> [Pair] -> Value
JSON.object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)
                                , Key
"server" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
v ]) [Value]
servers
          [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Value -> Value) -> [Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Value
v -> [Pair] -> Value
JSON.object [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"label_selector" :: Text)
                                     , Key
"label_selector" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
v ]) [Value]
selectors

      body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewFirewall -> Text
newFirewallName NewFirewall
nfirewall
        , Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap (NewFirewall -> [Label]
newFirewallLabels NewFirewall
nfirewall)
        , Key
"rules" Key -> [FirewallRule] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewFirewall -> [FirewallRule]
newFirewallRules NewFirewall
nfirewall
        , Key
"apply_to" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value]
applyTo
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO CreatedFirewall
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/firewalls" (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Delete a firewall.
deleteFirewall :: Token -> FirewallID -> IO ()
deleteFirewall :: Token -> FirewallID -> IO ()
deleteFirewall Token
token (FirewallID Int
i) =
  ByteString
-> ByteString -> Maybe Void -> Token -> Maybe Int -> IO ()
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/firewalls/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Update name and labels of a firewall.
updateFirewall
  :: Token
  -> FirewallID -- ^ Firewall to update.
  -> Text -- ^ New name for the firewall.
  -> [Label] -- ^ New labels for the firewall.
  -> IO Firewall
updateFirewall :: Token -> FirewallID -> Text -> [Label] -> IO Firewall
updateFirewall Token
token (FirewallID Int
i) Text
name [Label]
labels = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"firewall" (WithKey "firewall" Firewall -> Firewall)
-> IO (WithKey "firewall" Firewall) -> IO Firewall
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "firewall" Firewall)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/firewalls/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Apply a firewall to resources.
applyFirewall
  :: Token
  -> FirewallID -- ^ Firewall to apply.
  -> [ServerID] -- ^ Servers to apply the firewall to.
  -> [LabelSelectorAll] -- ^ Label selectors to apply.
  -> IO [Action]
applyFirewall :: Token
-> FirewallID -> [ServerID] -> [LabelSelectorAll] -> IO [Action]
applyFirewall Token
token (FirewallID Int
i) [ServerID]
servers [LabelSelectorAll]
selectors = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"actions" (WithKey "actions" [Action] -> [Action])
-> IO (WithKey "actions" [Action]) -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let path :: ByteString
path = ByteString
"/firewalls/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/apply_to_resources"
      serverf :: v -> Value
serverf v
server = [Pair] -> Value
JSON.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)
        , Key
"server" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"id" Key -> v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
server ] ]
      selectorf :: v -> Value
selectorf v
selector = [Pair] -> Value
JSON.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"label_selector" :: Text)
        , Key
"label_selector" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"selector" Key -> v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
selector ] ]
      body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"apply_to" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((ServerID -> Value) -> [ServerID] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ServerID -> Value
forall a. ToJSON a => a -> Value
serverf [ServerID]
servers [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (LabelSelectorAll -> Value) -> [LabelSelectorAll] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LabelSelectorAll -> Value
forall a. ToJSON a => a -> Value
selectorf [LabelSelectorAll]
selectors)
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "actions" [Action])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
path (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Remove a firewall from the given resources. The firewall itself is not deleted.
--   For that, use 'deleteFirewall'.
removeFirewall
  :: Token
  -> FirewallID -- ^ Firewall to remove.
  -> [ServerID] -- ^ Servers to remove the firewall from.
  -> [LabelSelectorAll] -- ^ Label selectors to remove from the firewall.
  -> IO [Action]
removeFirewall :: Token
-> FirewallID -> [ServerID] -> [LabelSelectorAll] -> IO [Action]
removeFirewall Token
token (FirewallID Int
i) [ServerID]
servers [LabelSelectorAll]
selectors = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"actions" (WithKey "actions" [Action] -> [Action])
-> IO (WithKey "actions" [Action]) -> IO [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let path :: ByteString
path = ByteString
"/firewalls/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/remove_from_resources"
      serverf :: v -> Value
serverf v
server = [Pair] -> Value
JSON.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)
        , Key
"server" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"id" Key -> v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
server ] ]
      selectorf :: v -> Value
selectorf v
selector = [Pair] -> Value
JSON.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"label_selector" :: Text)
        , Key
"label_selector" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"selector" Key -> v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
selector ] ]
      body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"remove_from" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((ServerID -> Value) -> [ServerID] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ServerID -> Value
forall a. ToJSON a => a -> Value
serverf [ServerID]
servers [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (LabelSelectorAll -> Value) -> [LabelSelectorAll] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LabelSelectorAll -> Value
forall a. ToJSON a => a -> Value
selectorf [LabelSelectorAll]
selectors)
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "actions" [Action])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
path (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Floating IPs
----------------------------------------------------------------------------------------------------

-- | Floating IP identifier.
newtype FloatingIPID = FloatingIPID Int deriving (FloatingIPID -> FloatingIPID -> Bool
(FloatingIPID -> FloatingIPID -> Bool)
-> (FloatingIPID -> FloatingIPID -> Bool) -> Eq FloatingIPID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FloatingIPID -> FloatingIPID -> Bool
== :: FloatingIPID -> FloatingIPID -> Bool
$c/= :: FloatingIPID -> FloatingIPID -> Bool
/= :: FloatingIPID -> FloatingIPID -> Bool
Eq, Eq FloatingIPID
Eq FloatingIPID =>
(FloatingIPID -> FloatingIPID -> Ordering)
-> (FloatingIPID -> FloatingIPID -> Bool)
-> (FloatingIPID -> FloatingIPID -> Bool)
-> (FloatingIPID -> FloatingIPID -> Bool)
-> (FloatingIPID -> FloatingIPID -> Bool)
-> (FloatingIPID -> FloatingIPID -> FloatingIPID)
-> (FloatingIPID -> FloatingIPID -> FloatingIPID)
-> Ord FloatingIPID
FloatingIPID -> FloatingIPID -> Bool
FloatingIPID -> FloatingIPID -> Ordering
FloatingIPID -> FloatingIPID -> FloatingIPID
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
$ccompare :: FloatingIPID -> FloatingIPID -> Ordering
compare :: FloatingIPID -> FloatingIPID -> Ordering
$c< :: FloatingIPID -> FloatingIPID -> Bool
< :: FloatingIPID -> FloatingIPID -> Bool
$c<= :: FloatingIPID -> FloatingIPID -> Bool
<= :: FloatingIPID -> FloatingIPID -> Bool
$c> :: FloatingIPID -> FloatingIPID -> Bool
> :: FloatingIPID -> FloatingIPID -> Bool
$c>= :: FloatingIPID -> FloatingIPID -> Bool
>= :: FloatingIPID -> FloatingIPID -> Bool
$cmax :: FloatingIPID -> FloatingIPID -> FloatingIPID
max :: FloatingIPID -> FloatingIPID -> FloatingIPID
$cmin :: FloatingIPID -> FloatingIPID -> FloatingIPID
min :: FloatingIPID -> FloatingIPID -> FloatingIPID
Ord, Int -> FloatingIPID -> ShowS
[FloatingIPID] -> ShowS
FloatingIPID -> String
(Int -> FloatingIPID -> ShowS)
-> (FloatingIPID -> String)
-> ([FloatingIPID] -> ShowS)
-> Show FloatingIPID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FloatingIPID -> ShowS
showsPrec :: Int -> FloatingIPID -> ShowS
$cshow :: FloatingIPID -> String
show :: FloatingIPID -> String
$cshowList :: [FloatingIPID] -> ShowS
showList :: [FloatingIPID] -> ShowS
Show, Maybe FloatingIPID
Value -> Parser [FloatingIPID]
Value -> Parser FloatingIPID
(Value -> Parser FloatingIPID)
-> (Value -> Parser [FloatingIPID])
-> Maybe FloatingIPID
-> FromJSON FloatingIPID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FloatingIPID
parseJSON :: Value -> Parser FloatingIPID
$cparseJSONList :: Value -> Parser [FloatingIPID]
parseJSONList :: Value -> Parser [FloatingIPID]
$comittedField :: Maybe FloatingIPID
omittedField :: Maybe FloatingIPID
FromJSON)

----------------------------------------------------------------------------------------------------
-- Images
----------------------------------------------------------------------------------------------------

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

-- | Flavor of operative system.
data OSFlavor = Ubuntu | CentOS | Debian | Fedora | Rocky | Alma
              | OpenSUSE | UnknownOS
                deriving Int -> OSFlavor -> ShowS
[OSFlavor] -> ShowS
OSFlavor -> String
(Int -> OSFlavor -> ShowS)
-> (OSFlavor -> String) -> ([OSFlavor] -> ShowS) -> Show OSFlavor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OSFlavor -> ShowS
showsPrec :: Int -> OSFlavor -> ShowS
$cshow :: OSFlavor -> String
show :: OSFlavor -> String
$cshowList :: [OSFlavor] -> ShowS
showList :: [OSFlavor] -> ShowS
Show

instance FromJSON OSFlavor where
  parseJSON :: Value -> Parser OSFlavor
parseJSON = String -> (Text -> Parser OSFlavor) -> Value -> Parser OSFlavor
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"OSFlavor" ((Text -> Parser OSFlavor) -> Value -> Parser OSFlavor)
-> (Text -> Parser OSFlavor) -> Value -> Parser OSFlavor
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"ubuntu"   -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Ubuntu
    Text
"centos"   -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
CentOS
    Text
"debian"   -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Debian
    Text
"fedora"   -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Fedora
    Text
"rocky"    -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Rocky
    Text
"alma"     -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Alma
    Text
"opensuse" -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
OpenSUSE
    Text
"unknown"  -> OSFlavor -> Parser OSFlavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
UnknownOS
    Text
_ -> String -> Parser OSFlavor
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser OSFlavor) -> String -> Parser OSFlavor
forall a b. (a -> b) -> a -> b
$ String
"Unknown OS flavor: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | Image type.
data ImageType =
    -- | System image with name.
    SystemImage Text
  | AppImage
    -- | Snapshot with size in GB.
  | Snapshot Double
  | Backup ServerID
  | Temporary
    deriving Int -> ImageType -> ShowS
[ImageType] -> ShowS
ImageType -> String
(Int -> ImageType -> ShowS)
-> (ImageType -> String)
-> ([ImageType] -> ShowS)
-> Show ImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageType -> ShowS
showsPrec :: Int -> ImageType -> ShowS
$cshow :: ImageType -> String
show :: ImageType -> String
$cshowList :: [ImageType] -> ShowS
showList :: [ImageType] -> ShowS
Show

-- | An image that can be mounted to a server.
data Image = Image
  { -- | Image identifier.
    Image -> ImageID
imageID :: ImageID
  , Image -> Text
imageName :: Text
  , Image -> Text
imageDescription :: Text
  , Image -> OSFlavor
imageOSFlavor :: OSFlavor
  , Image -> Architecture
imageArchitecture :: Architecture
  , Image -> ImageType
imageType :: ImageType
    -- | Size of the disk contained in the image in GB.
  , Image -> Int
imageDiskSize :: Int
  , Image -> ZonedTime
imageCreated :: ZonedTime
  , Image -> Maybe ZonedTime
imageDeleted :: Maybe ZonedTime
  , Image -> Maybe ZonedTime
imageDeprecated :: Maybe ZonedTime
  , Image -> LabelMap
imageLabels :: LabelMap
    } deriving Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Image -> ShowS
showsPrec :: Int -> Image -> ShowS
$cshow :: Image -> String
show :: Image -> String
$cshowList :: [Image] -> ShowS
showList :: [Image] -> ShowS
Show

instance FromJSON Image where
  parseJSON :: Value -> Parser Image
parseJSON = String -> (Object -> Parser Image) -> Value -> Parser Image
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Image" ((Object -> Parser Image) -> Value -> Parser Image)
-> (Object -> Parser Image) -> Value -> Parser Image
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ImageType
typ <- do Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
              case Text
t :: Text of
                Text
"system" -> Text -> ImageType
SystemImage (Text -> ImageType) -> Parser Text -> Parser ImageType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Text
"app" -> ImageType -> Parser ImageType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageType
AppImage
                Text
"snapshot" -> Double -> ImageType
Snapshot (Double -> ImageType) -> Parser Double -> Parser ImageType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image_size"
                Text
"backup" -> ServerID -> ImageType
Backup (ServerID -> ImageType) -> Parser ServerID -> Parser ImageType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ServerID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bound_to"
                Text
"temporary" -> ImageType -> Parser ImageType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageType
Temporary
                Text
_ -> String -> Parser ImageType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ImageType) -> String -> Parser ImageType
forall a b. (a -> b) -> a -> b
$ String
"Unknown image type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t
    ImageID
-> Text
-> Text
-> OSFlavor
-> Architecture
-> ImageType
-> Int
-> ZonedTime
-> Maybe ZonedTime
-> Maybe ZonedTime
-> LabelMap
-> Image
Image
      (ImageID
 -> Text
 -> Text
 -> OSFlavor
 -> Architecture
 -> ImageType
 -> Int
 -> ZonedTime
 -> Maybe ZonedTime
 -> Maybe ZonedTime
 -> LabelMap
 -> Image)
-> Parser ImageID
-> Parser
     (Text
      -> Text
      -> OSFlavor
      -> Architecture
      -> ImageType
      -> Int
      -> ZonedTime
      -> Maybe ZonedTime
      -> Maybe ZonedTime
      -> LabelMap
      -> Image)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ImageID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Text
   -> Text
   -> OSFlavor
   -> Architecture
   -> ImageType
   -> Int
   -> ZonedTime
   -> Maybe ZonedTime
   -> Maybe ZonedTime
   -> LabelMap
   -> Image)
-> Parser Text
-> Parser
     (Text
      -> OSFlavor
      -> Architecture
      -> ImageType
      -> Int
      -> ZonedTime
      -> Maybe ZonedTime
      -> Maybe ZonedTime
      -> LabelMap
      -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Text
   -> OSFlavor
   -> Architecture
   -> ImageType
   -> Int
   -> ZonedTime
   -> Maybe ZonedTime
   -> Maybe ZonedTime
   -> LabelMap
   -> Image)
-> Parser Text
-> Parser
     (OSFlavor
      -> Architecture
      -> ImageType
      -> Int
      -> ZonedTime
      -> Maybe ZonedTime
      -> Maybe ZonedTime
      -> LabelMap
      -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      Parser
  (OSFlavor
   -> Architecture
   -> ImageType
   -> Int
   -> ZonedTime
   -> Maybe ZonedTime
   -> Maybe ZonedTime
   -> LabelMap
   -> Image)
-> Parser OSFlavor
-> Parser
     (Architecture
      -> ImageType
      -> Int
      -> ZonedTime
      -> Maybe ZonedTime
      -> Maybe ZonedTime
      -> LabelMap
      -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser OSFlavor
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"os_flavor"
      Parser
  (Architecture
   -> ImageType
   -> Int
   -> ZonedTime
   -> Maybe ZonedTime
   -> Maybe ZonedTime
   -> LabelMap
   -> Image)
-> Parser Architecture
-> Parser
     (ImageType
      -> Int
      -> ZonedTime
      -> Maybe ZonedTime
      -> Maybe ZonedTime
      -> LabelMap
      -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Architecture
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"architecture"
      Parser
  (ImageType
   -> Int
   -> ZonedTime
   -> Maybe ZonedTime
   -> Maybe ZonedTime
   -> LabelMap
   -> Image)
-> Parser ImageType
-> Parser
     (Int
      -> ZonedTime
      -> Maybe ZonedTime
      -> Maybe ZonedTime
      -> LabelMap
      -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ImageType -> Parser ImageType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageType
typ
      Parser
  (Int
   -> ZonedTime
   -> Maybe ZonedTime
   -> Maybe ZonedTime
   -> LabelMap
   -> Image)
-> Parser Int
-> Parser
     (ZonedTime
      -> Maybe ZonedTime -> Maybe ZonedTime -> LabelMap -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"disk_size"
      Parser
  (ZonedTime
   -> Maybe ZonedTime -> Maybe ZonedTime -> LabelMap -> Image)
-> Parser ZonedTime
-> Parser (Maybe ZonedTime -> Maybe ZonedTime -> LabelMap -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
      Parser (Maybe ZonedTime -> Maybe ZonedTime -> LabelMap -> Image)
-> Parser (Maybe ZonedTime)
-> Parser (Maybe ZonedTime -> LabelMap -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ZonedTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
      Parser (Maybe ZonedTime -> LabelMap -> Image)
-> Parser (Maybe ZonedTime) -> Parser (LabelMap -> Image)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ZonedTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deprecated"
      Parser (LabelMap -> Image) -> Parser LabelMap -> Parser Image
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"

-- | Get images.
--
--   A regularly updated list of images can be found
--   [here](https://daniel-casanueva.gitlab.io/haskell/hetzner/images).
getImages
  :: Token
  -> Maybe Int -- ^ Page.
  -> IO (WithMeta "images" [Image])
getImages :: Token -> Maybe Int -> IO (WithMeta "images" [Image])
getImages = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "images" [Image])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/images" Maybe Void
noBody

-- | Get a single image.
getImage :: Token -> ImageID -> IO Image
getImage :: Token -> ImageID -> IO Image
getImage Token
token (ImageID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"image" (WithKey "image" Image -> Image)
-> IO (WithKey "image" Image) -> IO Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "image" Image)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/images/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Load Balancers
----------------------------------------------------------------------------------------------------

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

----------------------------------------------------------------------------------------------------
-- Locations
----------------------------------------------------------------------------------------------------

-- | Cities where Hetzner hosts their servers.
data City =
    Falkenstein
  | Nuremberg
  | Helsinki
  | AshburnVA
  | HillsboroOR
    deriving (City -> City -> Bool
(City -> City -> Bool) -> (City -> City -> Bool) -> Eq City
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: City -> City -> Bool
== :: City -> City -> Bool
$c/= :: City -> City -> Bool
/= :: City -> City -> Bool
Eq, Int -> City -> ShowS
[City] -> ShowS
City -> String
(Int -> City -> ShowS)
-> (City -> String) -> ([City] -> ShowS) -> Show City
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> City -> ShowS
showsPrec :: Int -> City -> ShowS
$cshow :: City -> String
show :: City -> String
$cshowList :: [City] -> ShowS
showList :: [City] -> ShowS
Show)

instance FromJSON City where
  parseJSON :: Value -> Parser City
parseJSON = String -> (Text -> Parser City) -> Value -> Parser City
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"City" ((Text -> Parser City) -> Value -> Parser City)
-> (Text -> Parser City) -> Value -> Parser City
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"Falkenstein" -> City -> Parser City
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure City
Falkenstein
    Text
"Nuremberg" -> City -> Parser City
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure City
Nuremberg
    Text
"Helsinki" -> City -> Parser City
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure City
Helsinki
    Text
"Ashburn, VA" -> City -> Parser City
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure City
AshburnVA
    Text
"Hillsboro, OR" -> City -> Parser City
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure City
HillsboroOR
    Text
_ -> String -> Parser City
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser City) -> String -> Parser City
forall a b. (a -> b) -> a -> b
$ String
"Unknown city: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

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

-- | A location.
data Location = Location
  { Location -> City
locationCity :: City
  , Location -> Country
locationCountry :: Country
  , Location -> Text
locationDescription :: Text
  , Location -> LocationID
locationID :: LocationID
  , Location -> Double
locationLatitude :: Double
  , Location -> Double
locationLongitude :: Double
  , Location -> Text
locationName :: Text
  , Location -> Region
locationRegion :: Region
    } deriving Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show

instance FromJSON Location where
  parseJSON :: Value -> Parser Location
parseJSON = String -> (Object -> Parser Location) -> Value -> Parser Location
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Location" ((Object -> Parser Location) -> Value -> Parser Location)
-> (Object -> Parser Location) -> Value -> Parser Location
forall a b. (a -> b) -> a -> b
$ \Object
o -> City
-> Country
-> Text
-> LocationID
-> Double
-> Double
-> Text
-> Region
-> Location
Location
    (City
 -> Country
 -> Text
 -> LocationID
 -> Double
 -> Double
 -> Text
 -> Region
 -> Location)
-> Parser City
-> Parser
     (Country
      -> Text
      -> LocationID
      -> Double
      -> Double
      -> Text
      -> Region
      -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser City
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"city"
    Parser
  (Country
   -> Text
   -> LocationID
   -> Double
   -> Double
   -> Text
   -> Region
   -> Location)
-> Parser Country
-> Parser
     (Text
      -> LocationID -> Double -> Double -> Text -> Region -> Location)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Country
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"country"
    Parser
  (Text
   -> LocationID -> Double -> Double -> Text -> Region -> Location)
-> Parser Text
-> Parser
     (LocationID -> Double -> Double -> Text -> Region -> Location)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Parser
  (LocationID -> Double -> Double -> Text -> Region -> Location)
-> Parser LocationID
-> Parser (Double -> Double -> Text -> Region -> Location)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LocationID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser (Double -> Double -> Text -> Region -> Location)
-> Parser Double -> Parser (Double -> Text -> Region -> Location)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"latitude"
    Parser (Double -> Text -> Region -> Location)
-> Parser Double -> Parser (Text -> Region -> Location)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"longitude"
    Parser (Text -> Region -> Location)
-> Parser Text -> Parser (Region -> Location)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser (Region -> Location) -> Parser Region -> Parser Location
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Region
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"network_zone"

-- | Get all locations.
getLocations :: Token -> IO [Location]
getLocations :: Token -> IO [Location]
getLocations Token
token = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"locations" (WithKey "locations" [Location] -> [Location])
-> IO (WithKey "locations" [Location]) -> IO [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "locations" [Location])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/locations" Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Get a single location.
getLocation :: Token -> LocationID -> IO Location
getLocation :: Token -> LocationID -> IO Location
getLocation Token
token (LocationID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"location" (WithKey "location" Location -> Location)
-> IO (WithKey "location" Location) -> IO Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "location" Location)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/locations/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Primary IPs
----------------------------------------------------------------------------------------------------

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

-- | Primary IP.
data PrimaryIP = PrimaryIP
  { -- | Resource the primary IP is assigned to.
    PrimaryIP -> ResourceID
primaryIPAssignee :: ResourceID
    -- | This primary IP is deleted when the resource it is assigned to is deleted.
  , PrimaryIP -> Bool
primaryIPAutoDelete :: Bool
  , PrimaryIP -> Bool
primaryIPIsBlocked :: Bool
    -- | Point in time where the primary IP was created.
  , PrimaryIP -> ZonedTime
primaryIPCreated :: ZonedTime
  , PrimaryIP -> Datacenter
primaryIPDatacenter :: Datacenter
  , PrimaryIP -> PrimaryIPID
primaryIPID :: PrimaryIPID
    -- | Primary IP together with reverse DNS information.
  , PrimaryIP
-> Either
     (PublicIPInfo Text IPv4)
     (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
primaryIP :: Either (PublicIPInfo Text IPv4) (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
  , PrimaryIP -> LabelMap
primaryIPLabels :: LabelMap
  , PrimaryIP -> Text
primaryIPName :: Text
    } deriving Int -> PrimaryIP -> ShowS
[PrimaryIP] -> ShowS
PrimaryIP -> String
(Int -> PrimaryIP -> ShowS)
-> (PrimaryIP -> String)
-> ([PrimaryIP] -> ShowS)
-> Show PrimaryIP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimaryIP -> ShowS
showsPrec :: Int -> PrimaryIP -> ShowS
$cshow :: PrimaryIP -> String
show :: PrimaryIP -> String
$cshowList :: [PrimaryIP] -> ShowS
showList :: [PrimaryIP] -> ShowS
Show

instance FromJSON PrimaryIP where
  parseJSON :: Value -> Parser PrimaryIP
parseJSON = String -> (Object -> Parser PrimaryIP) -> Value -> Parser PrimaryIP
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"PrimaryIP" ((Object -> Parser PrimaryIP) -> Value -> Parser PrimaryIP)
-> (Object -> Parser PrimaryIP) -> Value -> Parser PrimaryIP
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
aid <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignee_id" :: JSON.Parser Int
    Text
atype <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignee_type" :: JSON.Parser Text
    Text
iptype <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    ResourceID
-> Bool
-> Bool
-> ZonedTime
-> Datacenter
-> PrimaryIPID
-> Either
     (PublicIPInfo Text IPv4)
     (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
-> LabelMap
-> Text
-> PrimaryIP
PrimaryIP
      (ResourceID
 -> Bool
 -> Bool
 -> ZonedTime
 -> Datacenter
 -> PrimaryIPID
 -> Either
      (PublicIPInfo Text IPv4)
      (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
 -> LabelMap
 -> Text
 -> PrimaryIP)
-> Parser ResourceID
-> Parser
     (Bool
      -> Bool
      -> ZonedTime
      -> Datacenter
      -> PrimaryIPID
      -> Either
           (PublicIPInfo Text IPv4)
           (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> LabelMap
      -> Text
      -> PrimaryIP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ResourceID
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON ([Pair] -> Value
JSON.object [ Key
"id" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
aid, Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
atype ])
      Parser
  (Bool
   -> Bool
   -> ZonedTime
   -> Datacenter
   -> PrimaryIPID
   -> Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> LabelMap
   -> Text
   -> PrimaryIP)
-> Parser Bool
-> Parser
     (Bool
      -> ZonedTime
      -> Datacenter
      -> PrimaryIPID
      -> Either
           (PublicIPInfo Text IPv4)
           (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> LabelMap
      -> Text
      -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"auto_delete"
      Parser
  (Bool
   -> ZonedTime
   -> Datacenter
   -> PrimaryIPID
   -> Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> LabelMap
   -> Text
   -> PrimaryIP)
-> Parser Bool
-> Parser
     (ZonedTime
      -> Datacenter
      -> PrimaryIPID
      -> Either
           (PublicIPInfo Text IPv4)
           (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> LabelMap
      -> Text
      -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocked"
      Parser
  (ZonedTime
   -> Datacenter
   -> PrimaryIPID
   -> Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> LabelMap
   -> Text
   -> PrimaryIP)
-> Parser ZonedTime
-> Parser
     (Datacenter
      -> PrimaryIPID
      -> Either
           (PublicIPInfo Text IPv4)
           (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> LabelMap
      -> Text
      -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
      Parser
  (Datacenter
   -> PrimaryIPID
   -> Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> LabelMap
   -> Text
   -> PrimaryIP)
-> Parser Datacenter
-> Parser
     (PrimaryIPID
      -> Either
           (PublicIPInfo Text IPv4)
           (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> LabelMap
      -> Text
      -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Datacenter
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"datacenter"
      Parser
  (PrimaryIPID
   -> Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> LabelMap
   -> Text
   -> PrimaryIP)
-> Parser PrimaryIPID
-> Parser
     (Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
      -> LabelMap -> Text -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser PrimaryIPID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Either
     (PublicIPInfo Text IPv4)
     (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
   -> LabelMap -> Text -> PrimaryIP)
-> Parser
     (Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
-> Parser (LabelMap -> Text -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (case Text
iptype :: Text of
             Text
"ipv4" -> PublicIPInfo Text IPv4
-> Either
     (PublicIPInfo Text IPv4)
     (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
forall a b. a -> Either a b
Left (PublicIPInfo Text IPv4
 -> Either
      (PublicIPInfo Text IPv4)
      (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
-> Parser (PublicIPInfo Text IPv4)
-> Parser
     (Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dns_ptr" Parser [Value]
-> ([Value] -> Parser (PublicIPInfo Text IPv4))
-> Parser (PublicIPInfo Text IPv4)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser (PublicIPInfo Text IPv4)
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON (Value -> Parser (PublicIPInfo Text IPv4))
-> ([Value] -> Value) -> [Value] -> Parser (PublicIPInfo Text IPv4)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
forall a. HasCallStack => [a] -> a
head)
             Text
"ipv6" -> PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range
-> Either
     (PublicIPInfo Text IPv4)
     (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
forall a b. b -> Either a b
Right (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range
 -> Either
      (PublicIPInfo Text IPv4)
      (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
-> Parser (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
-> Parser
     (Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON (Object -> Value
JSON.Object Object
o)
             Text
_ -> String
-> Parser
     (Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser
      (Either
         (PublicIPInfo Text IPv4)
         (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)))
-> String
-> Parser
     (Either
        (PublicIPInfo Text IPv4)
        (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range))
forall a b. (a -> b) -> a -> b
$ String
"Invalid ip type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
iptype
             )
      Parser (LabelMap -> Text -> PrimaryIP)
-> Parser LabelMap -> Parser (Text -> PrimaryIP)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
      Parser (Text -> PrimaryIP) -> Parser Text -> Parser PrimaryIP
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

-- | Get primary IPs.
getPrimaryIPs
  :: Token
  -> Maybe Int -- ^ Page.
  -> IO (WithMeta "primary_ips" [PrimaryIP])
getPrimaryIPs :: Token -> Maybe Int -> IO (WithMeta "primary_ips" [PrimaryIP])
getPrimaryIPs = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "primary_ips" [PrimaryIP])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/primary_ips" Maybe Void
noBody

-- | Get a single primary IP.
getPrimaryIP :: Token -> PrimaryIPID -> IO PrimaryIP
getPrimaryIP :: Token -> PrimaryIPID -> IO PrimaryIP
getPrimaryIP Token
token (PrimaryIPID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"primary_ip" (WithKey "primary_ip" PrimaryIP -> PrimaryIP)
-> IO (WithKey "primary_ip" PrimaryIP) -> IO PrimaryIP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "primary_ip" PrimaryIP)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/primary_ips" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Set reverse DNS for a primary IP.
--
--   * If the primary IP corresponds to an IPv4, the reverse DNS setting's
--     IP /must/ coincide with the primary IP's IPv4.
--
--   * If the primary IP corresponds to an IPv6, the reverse DNS setting's
--     IP /must/ be within the primary IP's IPv6 range.
--
setReverseDNS
  :: Token
     -- | Primary IP to set reverse DNS for.
  -> PrimaryIPID
     -- | Reverse DNS settings.
  -> PublicIPInfo Text (Either IPv4 IPv6)
  -> IO Action
setReverseDNS :: Token
-> PrimaryIPID -> PublicIPInfo Text (Either IPv4 IPv6) -> IO Action
setReverseDNS Token
token (PrimaryIPID Int
i) (PublicIPInfo Text
dns Either IPv4 IPv6
ip) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/primary_ips/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/change_dns_ptr")
    (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ (IPv4 -> Value) -> (IPv6 -> Value) -> Either IPv4 IPv6 -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PublicIPInfo Text IPv4 -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (PublicIPInfo Text IPv4 -> Value)
-> (IPv4 -> PublicIPInfo Text IPv4) -> IPv4 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IPv4 -> PublicIPInfo Text IPv4
forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo Text
dns) (PublicIPInfo Text IPv6 -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (PublicIPInfo Text IPv6 -> Value)
-> (IPv6 -> PublicIPInfo Text IPv6) -> IPv6 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IPv6 -> PublicIPInfo Text IPv6
forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo Text
dns) Either IPv4 IPv6
ip)
    Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Networks
----------------------------------------------------------------------------------------------------

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

-- | A route that sends all packets for a given destination to
--   a given gateway.
data Route = Route
  { Route -> IPv4Range
routeDestination :: IPv4Range
  , Route -> IPv4
routeGateway :: IPv4
    } deriving Int -> Route -> ShowS
[Route] -> ShowS
Route -> String
(Int -> Route -> ShowS)
-> (Route -> String) -> ([Route] -> ShowS) -> Show Route
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Route -> ShowS
showsPrec :: Int -> Route -> ShowS
$cshow :: Route -> String
show :: Route -> String
$cshowList :: [Route] -> ShowS
showList :: [Route] -> ShowS
Show

instance FromJSON Route where
  parseJSON :: Value -> Parser Route
parseJSON = String -> (Object -> Parser Route) -> Value -> Parser Route
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Route" ((Object -> Parser Route) -> Value -> Parser Route)
-> (Object -> Parser Route) -> Value -> Parser Route
forall a b. (a -> b) -> a -> b
$ \Object
o -> IPv4Range -> IPv4 -> Route
Route
    (IPv4Range -> IPv4 -> Route)
-> Parser IPv4Range -> Parser (IPv4 -> Route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser IPv4Range
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"destination"
    Parser (IPv4 -> Route) -> Parser IPv4 -> Parser Route
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser IPv4
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gateway"

instance ToJSON Route where
  toJSON :: Route -> Value
toJSON Route
route = [Pair] -> Value
JSON.object
    [ Key
"destination" Key -> IPv4Range -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Route -> IPv4Range
routeDestination Route
route
    , Key
"gateway" Key -> IPv4 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Route -> IPv4
routeGateway Route
route
      ]

-- | Types of subnetworks.
data SubnetType = SubnetCloud | SubnetServer | SubnetVSwitch deriving (SubnetType -> SubnetType -> Bool
(SubnetType -> SubnetType -> Bool)
-> (SubnetType -> SubnetType -> Bool) -> Eq SubnetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubnetType -> SubnetType -> Bool
== :: SubnetType -> SubnetType -> Bool
$c/= :: SubnetType -> SubnetType -> Bool
/= :: SubnetType -> SubnetType -> Bool
Eq, Int -> SubnetType -> ShowS
[SubnetType] -> ShowS
SubnetType -> String
(Int -> SubnetType -> ShowS)
-> (SubnetType -> String)
-> ([SubnetType] -> ShowS)
-> Show SubnetType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubnetType -> ShowS
showsPrec :: Int -> SubnetType -> ShowS
$cshow :: SubnetType -> String
show :: SubnetType -> String
$cshowList :: [SubnetType] -> ShowS
showList :: [SubnetType] -> ShowS
Show)

instance FromJSON SubnetType where
  parseJSON :: Value -> Parser SubnetType
parseJSON = String -> (Text -> Parser SubnetType) -> Value -> Parser SubnetType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"SubnetType" ((Text -> Parser SubnetType) -> Value -> Parser SubnetType)
-> (Text -> Parser SubnetType) -> Value -> Parser SubnetType
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"cloud" -> SubnetType -> Parser SubnetType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubnetType
SubnetCloud
    Text
"server" -> SubnetType -> Parser SubnetType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubnetType
SubnetServer
    Text
"vswitch" -> SubnetType -> Parser SubnetType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubnetType
SubnetVSwitch
    Text
_ -> String -> Parser SubnetType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SubnetType) -> String -> Parser SubnetType
forall a b. (a -> b) -> a -> b
$ String
"Invalid subnet type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

instance ToJSON SubnetType where
  toJSON :: SubnetType -> Value
toJSON SubnetType
t = case SubnetType
t of
    SubnetType
SubnetCloud -> Value
"cloud"
    SubnetType
SubnetServer -> Value
"server"
    SubnetType
SubnetVSwitch -> Value
"vswitch"

-- | Subnets divide the IP range of a parent 'Network'.
data Subnet = Subnet
  { Subnet -> IPv4
subnetGateway :: IPv4
  , Subnet -> IPv4Range
subnetIPRange :: IPv4Range
  , Subnet -> Region
subnetRegion :: Region
  , Subnet -> SubnetType
subnetType :: SubnetType
    } deriving Int -> Subnet -> ShowS
[Subnet] -> ShowS
Subnet -> String
(Int -> Subnet -> ShowS)
-> (Subnet -> String) -> ([Subnet] -> ShowS) -> Show Subnet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Subnet -> ShowS
showsPrec :: Int -> Subnet -> ShowS
$cshow :: Subnet -> String
show :: Subnet -> String
$cshowList :: [Subnet] -> ShowS
showList :: [Subnet] -> ShowS
Show

instance FromJSON Subnet where
  parseJSON :: Value -> Parser Subnet
parseJSON = String -> (Object -> Parser Subnet) -> Value -> Parser Subnet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Subnet" ((Object -> Parser Subnet) -> Value -> Parser Subnet)
-> (Object -> Parser Subnet) -> Value -> Parser Subnet
forall a b. (a -> b) -> a -> b
$ \Object
o -> IPv4 -> IPv4Range -> Region -> SubnetType -> Subnet
Subnet
    (IPv4 -> IPv4Range -> Region -> SubnetType -> Subnet)
-> Parser IPv4
-> Parser (IPv4Range -> Region -> SubnetType -> Subnet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser IPv4
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gateway"
    Parser (IPv4Range -> Region -> SubnetType -> Subnet)
-> Parser IPv4Range -> Parser (Region -> SubnetType -> Subnet)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser IPv4Range
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip_range"
    Parser (Region -> SubnetType -> Subnet)
-> Parser Region -> Parser (SubnetType -> Subnet)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Region
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"network_zone"
    Parser (SubnetType -> Subnet) -> Parser SubnetType -> Parser Subnet
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser SubnetType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

instance ToJSON Subnet where
  toJSON :: Subnet -> Value
toJSON Subnet
subnet = [Pair] -> Value
JSON.object
    [ Key
"gateway" Key -> IPv4 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Subnet -> IPv4
subnetGateway Subnet
subnet
    , Key
"ip_range" Key -> IPv4Range -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Subnet -> IPv4Range
subnetIPRange Subnet
subnet
    , Key
"network_zone" Key -> Region -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Subnet -> Region
subnetRegion Subnet
subnet
    , Key
"type" Key -> SubnetType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Subnet -> SubnetType
subnetType Subnet
subnet
      ]

-- | A private network.
data Network = Network
  { Network -> ZonedTime
networkCreated :: ZonedTime
  , Network -> NetworkID
networkID :: NetworkID
  , Network -> IPv4Range
networkIPRange :: IPv4Range
  , Network -> LabelMap
networkLabels :: LabelMap
  , Network -> [LoadBalancerID]
networkLoadBalancers :: [LoadBalancerID]
  , Network -> Text
networkName :: Text
  , Network -> [Route]
networkRoutes :: [Route]
  , Network -> [ServerID]
networkServers :: [ServerID]
  , Network -> [Subnet]
networkSubnets :: [Subnet]
    } deriving Int -> Network -> ShowS
[Network] -> ShowS
Network -> String
(Int -> Network -> ShowS)
-> (Network -> String) -> ([Network] -> ShowS) -> Show Network
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Network -> ShowS
showsPrec :: Int -> Network -> ShowS
$cshow :: Network -> String
show :: Network -> String
$cshowList :: [Network] -> ShowS
showList :: [Network] -> ShowS
Show

instance FromJSON Network where
  parseJSON :: Value -> Parser Network
parseJSON = String -> (Object -> Parser Network) -> Value -> Parser Network
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Network" ((Object -> Parser Network) -> Value -> Parser Network)
-> (Object -> Parser Network) -> Value -> Parser Network
forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> NetworkID
-> IPv4Range
-> LabelMap
-> [LoadBalancerID]
-> Text
-> [Route]
-> [ServerID]
-> [Subnet]
-> Network
Network
    (ZonedTime
 -> NetworkID
 -> IPv4Range
 -> LabelMap
 -> [LoadBalancerID]
 -> Text
 -> [Route]
 -> [ServerID]
 -> [Subnet]
 -> Network)
-> Parser ZonedTime
-> Parser
     (NetworkID
      -> IPv4Range
      -> LabelMap
      -> [LoadBalancerID]
      -> Text
      -> [Route]
      -> [ServerID]
      -> [Subnet]
      -> Network)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    Parser
  (NetworkID
   -> IPv4Range
   -> LabelMap
   -> [LoadBalancerID]
   -> Text
   -> [Route]
   -> [ServerID]
   -> [Subnet]
   -> Network)
-> Parser NetworkID
-> Parser
     (IPv4Range
      -> LabelMap
      -> [LoadBalancerID]
      -> Text
      -> [Route]
      -> [ServerID]
      -> [Subnet]
      -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser NetworkID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (IPv4Range
   -> LabelMap
   -> [LoadBalancerID]
   -> Text
   -> [Route]
   -> [ServerID]
   -> [Subnet]
   -> Network)
-> Parser IPv4Range
-> Parser
     (LabelMap
      -> [LoadBalancerID]
      -> Text
      -> [Route]
      -> [ServerID]
      -> [Subnet]
      -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser IPv4Range
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip_range"
    Parser
  (LabelMap
   -> [LoadBalancerID]
   -> Text
   -> [Route]
   -> [ServerID]
   -> [Subnet]
   -> Network)
-> Parser LabelMap
-> Parser
     ([LoadBalancerID]
      -> Text -> [Route] -> [ServerID] -> [Subnet] -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    Parser
  ([LoadBalancerID]
   -> Text -> [Route] -> [ServerID] -> [Subnet] -> Network)
-> Parser [LoadBalancerID]
-> Parser (Text -> [Route] -> [ServerID] -> [Subnet] -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [LoadBalancerID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"load_balancers"
    Parser (Text -> [Route] -> [ServerID] -> [Subnet] -> Network)
-> Parser Text
-> Parser ([Route] -> [ServerID] -> [Subnet] -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser ([Route] -> [ServerID] -> [Subnet] -> Network)
-> Parser [Route] -> Parser ([ServerID] -> [Subnet] -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Route]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"routes"
    Parser ([ServerID] -> [Subnet] -> Network)
-> Parser [ServerID] -> Parser ([Subnet] -> Network)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ServerID]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"servers"
    Parser ([Subnet] -> Network) -> Parser [Subnet] -> Parser Network
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Subnet]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subnets"

-- | Network creation configuration to be used with 'createNetwork'.
data NewNetwork = NewNetwork
  { NewNetwork -> IPv4Range
newNetworkIPRange :: IPv4Range
  , NewNetwork -> [Label]
newNetworkLabels :: [Label]
  , NewNetwork -> Text
newNetworkName :: Text
  , NewNetwork -> [Route]
newNetworkRoutes :: [Route]
  , NewNetwork -> [Subnet]
newNetworkSubnets :: [Subnet]
    }

instance ToJSON NewNetwork where
  toJSON :: NewNetwork -> Value
toJSON NewNetwork
nnetwork = [Pair] -> Value
JSON.object
    [ Key
"ip_range" Key -> IPv4Range -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> IPv4Range
newNetworkIPRange NewNetwork
nnetwork
    , Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap (NewNetwork -> [Label]
newNetworkLabels NewNetwork
nnetwork)
    , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> Text
newNetworkName NewNetwork
nnetwork
    , Key
"routes" Key -> [Route] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> [Route]
newNetworkRoutes NewNetwork
nnetwork
    , Key
"subnets" Key -> [Subnet] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> [Subnet]
newNetworkSubnets NewNetwork
nnetwork
      ]

-- | Default network configuration for new networks.
defaultNewNetwork
  :: Text -- ^ Network name.
  -> IPv4Range -- ^ IP range of the network.
  -> NewNetwork
defaultNewNetwork :: Text -> IPv4Range -> NewNetwork
defaultNewNetwork Text
name IPv4Range
iprange = NewNetwork
  { newNetworkIPRange :: IPv4Range
newNetworkIPRange = IPv4Range
iprange
  , newNetworkLabels :: [Label]
newNetworkLabels = []
  , newNetworkName :: Text
newNetworkName = Text
name
  , newNetworkRoutes :: [Route]
newNetworkRoutes = []
  , newNetworkSubnets :: [Subnet]
newNetworkSubnets = []
    }

-- | Get networks.
getNetworks
  :: Token
  -> Maybe Int -- ^ Page.
  -> IO (WithMeta "networks" [Network])
getNetworks :: Token -> Maybe Int -> IO (WithMeta "networks" [Network])
getNetworks = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "networks" [Network])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/networks" Maybe Void
noBody

-- | Get a single network.
getNetwork :: Token -> NetworkID -> IO Network
getNetwork :: Token -> NetworkID -> IO Network
getNetwork Token
token (NetworkID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"network" (WithKey "network" Network -> Network)
-> IO (WithKey "network" Network) -> IO Network
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "network" Network)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/networks/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Create a new network.
createNetwork :: Token -> NewNetwork -> IO Network
createNetwork :: Token -> NewNetwork -> IO Network
createNetwork Token
token NewNetwork
new = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"network" (WithKey "network" Network -> Network)
-> IO (WithKey "network" Network) -> IO Network
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe NewNetwork
-> Token
-> Maybe Int
-> IO (WithKey "network" Network)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/networks" (NewNetwork -> Maybe NewNetwork
forall a. a -> Maybe a
Just NewNetwork
new) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Delete a network.
deleteNetwork :: Token -> NetworkID -> IO ()
deleteNetwork :: Token -> NetworkID -> IO ()
deleteNetwork Token
token (NetworkID Int
i) =
  ByteString
-> ByteString -> Maybe Void -> Token -> Maybe Int -> IO ()
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/networks/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Update name and labels of a network.
updateNetwork
  :: Token
  -> NetworkID -- ^ Network to update.
  -> Text -- ^ New name for the network.
  -> [Label] -- ^ New labels for the network.
  -> IO Network
updateNetwork :: Token -> NetworkID -> Text -> [Label] -> IO Network
updateNetwork Token
token (NetworkID Int
i) Text
name [Label]
labels = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"network" (WithKey "network" Network -> Network)
-> IO (WithKey "network" Network) -> IO Network
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "network" Network)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/networks/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Pricing
----------------------------------------------------------------------------------------------------

-- | A resource's price.
data Price = Price
  { Price -> Scientific
grossPrice :: Scientific
  , Price -> Scientific
netPrice :: Scientific
    } deriving (Price -> Price -> Bool
(Price -> Price -> Bool) -> (Price -> Price -> Bool) -> Eq Price
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Price -> Price -> Bool
== :: Price -> Price -> Bool
$c/= :: Price -> Price -> Bool
/= :: Price -> Price -> Bool
Eq, Int -> Price -> ShowS
[Price] -> ShowS
Price -> String
(Int -> Price -> ShowS)
-> (Price -> String) -> ([Price] -> ShowS) -> Show Price
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Price -> ShowS
showsPrec :: Int -> Price -> ShowS
$cshow :: Price -> String
show :: Price -> String
$cshowList :: [Price] -> ShowS
showList :: [Price] -> ShowS
Show)

-- | The 'Ord' instance can be used to compare prices.
--   Only the gross price is used for comparisons.
instance Ord Price where
  compare :: Price -> Price -> Ordering
compare Price
p Price
p' = Scientific -> Scientific -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Price -> Scientific
grossPrice Price
p) (Price -> Scientific
grossPrice Price
p')

-- | Prices are written as strings. This internal type helps
--   parsing that string in the 'FromJSON' instance.
newtype PriceString = PriceString { PriceString -> Scientific
fromPriceString :: Scientific }

instance FromJSON PriceString where
  parseJSON :: Value -> Parser PriceString
parseJSON = String
-> (Text -> Parser PriceString) -> Value -> Parser PriceString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"PriceString" ((Text -> Parser PriceString) -> Value -> Parser PriceString)
-> (Text -> Parser PriceString) -> Value -> Parser PriceString
forall a b. (a -> b) -> a -> b
$ \Text
t ->
   (ParseErrorBundle Text Void -> Parser PriceString)
-> (Scientific -> Parser PriceString)
-> Either (ParseErrorBundle Text Void) Scientific
-> Parser PriceString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser PriceString
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PriceString)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Parser PriceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) (PriceString -> Parser PriceString
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PriceString -> Parser PriceString)
-> (Scientific -> PriceString) -> Scientific -> Parser PriceString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> PriceString
PriceString) (Either (ParseErrorBundle Text Void) Scientific
 -> Parser PriceString)
-> Either (ParseErrorBundle Text Void) Scientific
-> Parser PriceString
forall a b. (a -> b) -> a -> b
$
     Parsec Void Text Scientific
-> String -> Text -> Either (ParseErrorBundle Text Void) Scientific
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (Parsec Void Text Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
Parser.scientific :: Parser Scientific) String
"JSON" Text
t

instance FromJSON Price where
  parseJSON :: Value -> Parser Price
parseJSON = String -> (Object -> Parser Price) -> Value -> Parser Price
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Price" ((Object -> Parser Price) -> Value -> Parser Price)
-> (Object -> Parser Price) -> Value -> Parser Price
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    (Scientific -> Scientific -> Price)
-> Parser Scientific -> Parser Scientific -> Parser Price
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scientific -> Scientific -> Price
Price (PriceString -> Scientific
fromPriceString (PriceString -> Scientific)
-> Parser PriceString -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser PriceString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gross")
                 (PriceString -> Scientific
fromPriceString (PriceString -> Scientific)
-> Parser PriceString -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser PriceString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"net")

-- | The price of a resource in a location.
--   Hourly pricing is unavailable for some resources.
data PriceInLocation = PriceInLocation
  { -- | Location name.
    PriceInLocation -> Text
priceLocation :: Text
    -- | Hourly price.
  , PriceInLocation -> Maybe Price
hourlyPrice :: Maybe Price
    -- | Monthly price.
  , PriceInLocation -> Price
monthlyPrice :: Price
    -- | Outgoing traffic included (in bytes).
  , PriceInLocation -> Int
includedTraffic :: Int
    } deriving Int -> PriceInLocation -> ShowS
[PriceInLocation] -> ShowS
PriceInLocation -> String
(Int -> PriceInLocation -> ShowS)
-> (PriceInLocation -> String)
-> ([PriceInLocation] -> ShowS)
-> Show PriceInLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PriceInLocation -> ShowS
showsPrec :: Int -> PriceInLocation -> ShowS
$cshow :: PriceInLocation -> String
show :: PriceInLocation -> String
$cshowList :: [PriceInLocation] -> ShowS
showList :: [PriceInLocation] -> ShowS
Show

instance FromJSON PriceInLocation where
  parseJSON :: Value -> Parser PriceInLocation
parseJSON = String
-> (Object -> Parser PriceInLocation)
-> Value
-> Parser PriceInLocation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"PriceInLocation" ((Object -> Parser PriceInLocation)
 -> Value -> Parser PriceInLocation)
-> (Object -> Parser PriceInLocation)
-> Value
-> Parser PriceInLocation
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe Price -> Price -> Int -> PriceInLocation
PriceInLocation
    (Text -> Maybe Price -> Price -> Int -> PriceInLocation)
-> Parser Text
-> Parser (Maybe Price -> Price -> Int -> PriceInLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"location"
    Parser (Maybe Price -> Price -> Int -> PriceInLocation)
-> Parser (Maybe Price) -> Parser (Price -> Int -> PriceInLocation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Price)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"price_hourly"
    Parser (Price -> Int -> PriceInLocation)
-> Parser Price -> Parser (Int -> PriceInLocation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Price
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"price_monthly"
    Parser (Int -> PriceInLocation)
-> Parser Int -> Parser PriceInLocation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"included_traffic"

----------------------------------------------------------------------------------------------------
-- Servers
----------------------------------------------------------------------------------------------------

-- | A server status.
data ServerStatus =
    Running
  | Initializing
  | Starting
  | Stopping
  | Off
  | Deleting
  | Migrating
  | Rebuilding
  | StatusUnknown
    deriving (ServerStatus -> ServerStatus -> Bool
(ServerStatus -> ServerStatus -> Bool)
-> (ServerStatus -> ServerStatus -> Bool) -> Eq ServerStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerStatus -> ServerStatus -> Bool
== :: ServerStatus -> ServerStatus -> Bool
$c/= :: ServerStatus -> ServerStatus -> Bool
/= :: ServerStatus -> ServerStatus -> Bool
Eq, Int -> ServerStatus -> ShowS
[ServerStatus] -> ShowS
ServerStatus -> String
(Int -> ServerStatus -> ShowS)
-> (ServerStatus -> String)
-> ([ServerStatus] -> ShowS)
-> Show ServerStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerStatus -> ShowS
showsPrec :: Int -> ServerStatus -> ShowS
$cshow :: ServerStatus -> String
show :: ServerStatus -> String
$cshowList :: [ServerStatus] -> ShowS
showList :: [ServerStatus] -> ShowS
Show)

instance FromJSON ServerStatus where
  parseJSON :: Value -> Parser ServerStatus
parseJSON = String
-> (Text -> Parser ServerStatus) -> Value -> Parser ServerStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"ServerStatus" ((Text -> Parser ServerStatus) -> Value -> Parser ServerStatus)
-> (Text -> Parser ServerStatus) -> Value -> Parser ServerStatus
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"running" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Running
    Text
"initializing" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Initializing
    Text
"starting" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Starting
    Text
"stopping" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Stopping
    Text
"off" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Off
    Text
"deleting" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Deleting
    Text
"migrating" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Migrating
    Text
"rebuilding" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Rebuilding
    Text
"unknown" -> ServerStatus -> Parser ServerStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
StatusUnknown
    Text
_ -> String -> Parser ServerStatus
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ServerStatus) -> String -> Parser ServerStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid server status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | Server identifier.
newtype ServerID = ServerID Int deriving (Int -> ServerID -> ShowS
[ServerID] -> ShowS
ServerID -> String
(Int -> ServerID -> ShowS)
-> (ServerID -> String) -> ([ServerID] -> ShowS) -> Show ServerID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerID -> ShowS
showsPrec :: Int -> ServerID -> ShowS
$cshow :: ServerID -> String
show :: ServerID -> String
$cshowList :: [ServerID] -> ShowS
showList :: [ServerID] -> ShowS
Show, Maybe ServerID
Value -> Parser [ServerID]
Value -> Parser ServerID
(Value -> Parser ServerID)
-> (Value -> Parser [ServerID])
-> Maybe ServerID
-> FromJSON ServerID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ServerID
parseJSON :: Value -> Parser ServerID
$cparseJSONList :: Value -> Parser [ServerID]
parseJSONList :: Value -> Parser [ServerID]
$comittedField :: Maybe ServerID
omittedField :: Maybe ServerID
FromJSON, [ServerID] -> Value
[ServerID] -> Encoding
ServerID -> Bool
ServerID -> Value
ServerID -> Encoding
(ServerID -> Value)
-> (ServerID -> Encoding)
-> ([ServerID] -> Value)
-> ([ServerID] -> Encoding)
-> (ServerID -> Bool)
-> ToJSON ServerID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ServerID -> Value
toJSON :: ServerID -> Value
$ctoEncoding :: ServerID -> Encoding
toEncoding :: ServerID -> Encoding
$ctoJSONList :: [ServerID] -> Value
toJSONList :: [ServerID] -> Value
$ctoEncodingList :: [ServerID] -> Encoding
toEncodingList :: [ServerID] -> Encoding
$comitField :: ServerID -> Bool
omitField :: ServerID -> Bool
ToJSON)

-- | A server.
data Server = Server
  { Server -> ZonedTime
serverCreated :: ZonedTime
  , Server -> Datacenter
serverDatacenter :: Datacenter
  , Server -> ServerID
serverID :: ServerID
  , Server -> Image
serverImage :: Image
  , Server -> LabelMap
serverLabels :: LabelMap
  , Server -> Bool
serverIsLocked :: Bool
  , Server -> Text
serverName :: Text
  , Server -> PublicNetwork
serverPublicNetwork :: PublicNetwork
  , Server -> ServerType
serverType :: ServerType
  , Server -> ServerStatus
serverStatus :: ServerStatus
    } deriving Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
(Int -> Server -> ShowS)
-> (Server -> String) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Server -> ShowS
showsPrec :: Int -> Server -> ShowS
$cshow :: Server -> String
show :: Server -> String
$cshowList :: [Server] -> ShowS
showList :: [Server] -> ShowS
Show

instance FromJSON Server where
  parseJSON :: Value -> Parser Server
parseJSON = String -> (Object -> Parser Server) -> Value -> Parser Server
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Server" ((Object -> Parser Server) -> Value -> Parser Server)
-> (Object -> Parser Server) -> Value -> Parser Server
forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> Datacenter
-> ServerID
-> Image
-> LabelMap
-> Bool
-> Text
-> PublicNetwork
-> ServerType
-> ServerStatus
-> Server
Server
    (ZonedTime
 -> Datacenter
 -> ServerID
 -> Image
 -> LabelMap
 -> Bool
 -> Text
 -> PublicNetwork
 -> ServerType
 -> ServerStatus
 -> Server)
-> Parser ZonedTime
-> Parser
     (Datacenter
      -> ServerID
      -> Image
      -> LabelMap
      -> Bool
      -> Text
      -> PublicNetwork
      -> ServerType
      -> ServerStatus
      -> Server)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    Parser
  (Datacenter
   -> ServerID
   -> Image
   -> LabelMap
   -> Bool
   -> Text
   -> PublicNetwork
   -> ServerType
   -> ServerStatus
   -> Server)
-> Parser Datacenter
-> Parser
     (ServerID
      -> Image
      -> LabelMap
      -> Bool
      -> Text
      -> PublicNetwork
      -> ServerType
      -> ServerStatus
      -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Datacenter
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"datacenter"
    Parser
  (ServerID
   -> Image
   -> LabelMap
   -> Bool
   -> Text
   -> PublicNetwork
   -> ServerType
   -> ServerStatus
   -> Server)
-> Parser ServerID
-> Parser
     (Image
      -> LabelMap
      -> Bool
      -> Text
      -> PublicNetwork
      -> ServerType
      -> ServerStatus
      -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ServerID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (Image
   -> LabelMap
   -> Bool
   -> Text
   -> PublicNetwork
   -> ServerType
   -> ServerStatus
   -> Server)
-> Parser Image
-> Parser
     (LabelMap
      -> Bool
      -> Text
      -> PublicNetwork
      -> ServerType
      -> ServerStatus
      -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Image
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image"
    Parser
  (LabelMap
   -> Bool
   -> Text
   -> PublicNetwork
   -> ServerType
   -> ServerStatus
   -> Server)
-> Parser LabelMap
-> Parser
     (Bool
      -> Text -> PublicNetwork -> ServerType -> ServerStatus -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    Parser
  (Bool
   -> Text -> PublicNetwork -> ServerType -> ServerStatus -> Server)
-> Parser Bool
-> Parser
     (Text -> PublicNetwork -> ServerType -> ServerStatus -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locked"
    Parser
  (Text -> PublicNetwork -> ServerType -> ServerStatus -> Server)
-> Parser Text
-> Parser (PublicNetwork -> ServerType -> ServerStatus -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser (PublicNetwork -> ServerType -> ServerStatus -> Server)
-> Parser PublicNetwork
-> Parser (ServerType -> ServerStatus -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser PublicNetwork
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public_net"
    Parser (ServerType -> ServerStatus -> Server)
-> Parser ServerType -> Parser (ServerStatus -> Server)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ServerType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server_type"
    Parser (ServerStatus -> Server)
-> Parser ServerStatus -> Parser Server
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ServerStatus
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"

-- | Server creation configuration to be used with 'createServer'.
data NewServer = NewServer
  { -- | Automount attached volumes.
    NewServer -> Bool
newServerAutomount :: Bool
  , NewServer -> Maybe (Either DatacenterID LocationID)
newServerLocation :: Maybe (Either DatacenterID LocationID)
  , NewServer -> [FirewallID]
newServerFirewalls :: [FirewallID]
  , NewServer -> ImageID
newServerImage :: ImageID
  , NewServer -> [Label]
newServerLabels :: [Label]
    -- | Name of the server. Must be unique per project and a valid
    --   hostname as per RFC 1123.
  , NewServer -> Text
newServerName :: Text
    -- | List of networks the server will be attached to.
  , NewServer -> [NetworkID]
newServerNetworks :: [NetworkID]
  , NewServer -> Bool
newServerEnableIPv4 :: Bool
  , NewServer -> Bool
newServerEnableIPv6 :: Bool
  , NewServer -> ServerTypeID
newServerType :: ServerTypeID
  , NewServer -> [SSHKeyID]
newServerSSHKeys :: [SSHKeyID]
    -- | Whether to start the server after creation.
  , NewServer -> Bool
newServerStart :: Bool
    -- | Volumes to attach to the server after creation.
  , NewServer -> [VolumeID]
newServerVolumes :: [VolumeID]
    } deriving Int -> NewServer -> ShowS
[NewServer] -> ShowS
NewServer -> String
(Int -> NewServer -> ShowS)
-> (NewServer -> String)
-> ([NewServer] -> ShowS)
-> Show NewServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewServer -> ShowS
showsPrec :: Int -> NewServer -> ShowS
$cshow :: NewServer -> String
show :: NewServer -> String
$cshowList :: [NewServer] -> ShowS
showList :: [NewServer] -> ShowS
Show

instance ToJSON NewServer where
  toJSON :: NewServer -> Value
toJSON NewServer
nserver = [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat
    [ Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"automount" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (NewServer -> Bool
newServerAutomount NewServer
nserver Bool -> Bool -> Bool
&& Bool -> Bool
not ([VolumeID] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([VolumeID] -> Bool) -> [VolumeID] -> Bool
forall a b. (a -> b) -> a -> b
$ NewServer -> [VolumeID]
newServerVolumes NewServer
nserver))
    , [Pair]
-> (Either DatacenterID LocationID -> [Pair])
-> Maybe (Either DatacenterID LocationID)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair])
-> (Either DatacenterID LocationID -> Pair)
-> Either DatacenterID LocationID
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatacenterID -> Pair)
-> (LocationID -> Pair) -> Either DatacenterID LocationID -> Pair
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Key
"datacenter"Key -> DatacenterID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Key
"location"Key -> LocationID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)) (Maybe (Either DatacenterID LocationID) -> [Pair])
-> Maybe (Either DatacenterID LocationID) -> [Pair]
forall a b. (a -> b) -> a -> b
$ NewServer -> Maybe (Either DatacenterID LocationID)
newServerLocation NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"firewalls" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
        (FirewallID -> Value) -> [FirewallID] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FirewallID
fwid -> [Pair] -> Value
JSON.object [ Key
"firewall" Key -> FirewallID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FirewallID
fwid ]) (NewServer -> [FirewallID]
newServerFirewalls NewServer
nserver)
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"image" Key -> ImageID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> ImageID
newServerImage NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap (NewServer -> [Label]
newServerLabels NewServer
nserver)
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> Text
newServerName NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"networks" Key -> [NetworkID] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> [NetworkID]
newServerNetworks NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"public_net" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object
        [ Key
"enable_ipv4" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> Bool
newServerEnableIPv4 NewServer
nserver
        , Key
"enable_ipv6" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> Bool
newServerEnableIPv6 NewServer
nserver
          ]
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"server_type" Key -> ServerTypeID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> ServerTypeID
newServerType NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"ssh_keys" Key -> [SSHKeyID] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> [SSHKeyID]
newServerSSHKeys NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"start_after_create" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> Bool
newServerStart NewServer
nserver
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"volumes" Key -> [VolumeID] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewServer -> [VolumeID]
newServerVolumes NewServer
nserver
      ]

-- | Default server configuration that can be used as a starting point
--   for a custom server configuration.
--
--   Note that by default no SSH key is installed, which means you'll need the
--   password in the response in order to access the server (you will also receive an
--   e-mail with the password).
--
defaultNewServer
  :: Text -- ^ Server name.
  -> NewServer
defaultNewServer :: Text -> NewServer
defaultNewServer Text
name = NewServer
  { newServerAutomount :: Bool
newServerAutomount = Bool
True
  , newServerLocation :: Maybe (Either DatacenterID LocationID)
newServerLocation = Maybe (Either DatacenterID LocationID)
forall a. Maybe a
Nothing
  , newServerFirewalls :: [FirewallID]
newServerFirewalls = []
  , newServerImage :: ImageID
newServerImage = Int -> ImageID
ImageID Int
67794396
  , newServerLabels :: [Label]
newServerLabels = []
  , newServerName :: Text
newServerName = Text
name
  , newServerNetworks :: [NetworkID]
newServerNetworks = []
  , newServerEnableIPv4 :: Bool
newServerEnableIPv4 = Bool
True
  , newServerEnableIPv6 :: Bool
newServerEnableIPv6 = Bool
True
  , newServerType :: ServerTypeID
newServerType = Int -> ServerTypeID
ServerTypeID Int
1
  , newServerSSHKeys :: [SSHKeyID]
newServerSSHKeys = []
  , newServerStart :: Bool
newServerStart = Bool
True
  , newServerVolumes :: [VolumeID]
newServerVolumes = []
    }

-- | A server that was just created with 'createServer'.
data CreatedServer = CreatedServer
  { -- | Server creation action. You can use 'waitForAction'
    --   to wait until the server creation is finished.
    CreatedServer -> Action
createdServerAction :: Action
    -- | Additional server actions that are run after the server
    --   is created, like mounting volumes or starting the server.
  , CreatedServer -> [Action]
createdServerNextActions :: [Action]
    -- | Root password returned when no SSH keys are provided.
  , CreatedServer -> Maybe Text
createdServerPassword :: Maybe Text
    -- | The server being created.
  , CreatedServer -> Server
createdServer :: Server
    } deriving Int -> CreatedServer -> ShowS
[CreatedServer] -> ShowS
CreatedServer -> String
(Int -> CreatedServer -> ShowS)
-> (CreatedServer -> String)
-> ([CreatedServer] -> ShowS)
-> Show CreatedServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedServer -> ShowS
showsPrec :: Int -> CreatedServer -> ShowS
$cshow :: CreatedServer -> String
show :: CreatedServer -> String
$cshowList :: [CreatedServer] -> ShowS
showList :: [CreatedServer] -> ShowS
Show

instance FromJSON CreatedServer where
  parseJSON :: Value -> Parser CreatedServer
parseJSON = String
-> (Object -> Parser CreatedServer)
-> Value
-> Parser CreatedServer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"CreatedServer" ((Object -> Parser CreatedServer) -> Value -> Parser CreatedServer)
-> (Object -> Parser CreatedServer)
-> Value
-> Parser CreatedServer
forall a b. (a -> b) -> a -> b
$ \Object
o -> Action -> [Action] -> Maybe Text -> Server -> CreatedServer
CreatedServer
    (Action -> [Action] -> Maybe Text -> Server -> CreatedServer)
-> Parser Action
-> Parser ([Action] -> Maybe Text -> Server -> CreatedServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Action
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
    Parser ([Action] -> Maybe Text -> Server -> CreatedServer)
-> Parser [Action]
-> Parser (Maybe Text -> Server -> CreatedServer)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Action]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"next_actions"
    Parser (Maybe Text -> Server -> CreatedServer)
-> Parser (Maybe Text) -> Parser (Server -> CreatedServer)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"root_password"
    Parser (Server -> CreatedServer)
-> Parser Server -> Parser CreatedServer
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Server
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server"

-- | Get servers.
getServers
  :: Token
  -> Maybe Int -- ^ Page.
  -> IO (WithMeta "servers" [Server])
getServers :: Token -> Maybe Int -> IO (WithMeta "servers" [Server])
getServers = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "servers" [Server])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/servers" Maybe Void
noBody

-- | Get a single server.
getServer :: Token -> ServerID -> IO Server
getServer :: Token -> ServerID -> IO Server
getServer Token
token (ServerID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"server" (WithKey "server" Server -> Server)
-> IO (WithKey "server" Server) -> IO Server
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "server" Server)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Create a new server.
createServer :: Token -> NewServer -> IO CreatedServer
createServer :: Token -> NewServer -> IO CreatedServer
createServer Token
token NewServer
nserver =
  ByteString
-> ByteString
-> Maybe NewServer
-> Token
-> Maybe Int
-> IO CreatedServer
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/servers" (NewServer -> Maybe NewServer
forall a. a -> Maybe a
Just NewServer
nserver) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Delete a server.
deleteServer :: Token -> ServerID -> IO Action
deleteServer :: Token -> ServerID -> IO Action
deleteServer Token
token (ServerID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Set reverse DNS entry for a server.
setServerReverseDNS :: Token -> ServerID -> PublicIPInfo Text (Either IPv4 IPv6) -> IO Action
setServerReverseDNS :: Token
-> ServerID -> PublicIPInfo Text (Either IPv4 IPv6) -> IO Action
setServerReverseDNS Token
token (ServerID Int
i) PublicIPInfo Text (Either IPv4 IPv6)
ipinfo = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let ip :: Value
ip = (IPv4 -> Value) -> (IPv6 -> Value) -> Either IPv4 IPv6 -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IPv4 -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON IPv6 -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (Either IPv4 IPv6 -> Value) -> Either IPv4 IPv6 -> Value
forall a b. (a -> b) -> a -> b
$ PublicIPInfo Text (Either IPv4 IPv6) -> Either IPv4 IPv6
forall dnsptr ip. PublicIPInfo dnsptr ip -> ip
publicIP PublicIPInfo Text (Either IPv4 IPv6)
ipinfo
  in  ByteString
-> ByteString
-> Maybe (PublicIPInfo Text Value)
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST"
        (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/change_dns_ptr") 
        (PublicIPInfo Text Value -> Maybe (PublicIPInfo Text Value)
forall a. a -> Maybe a
Just (PublicIPInfo Text Value -> Maybe (PublicIPInfo Text Value))
-> PublicIPInfo Text Value -> Maybe (PublicIPInfo Text Value)
forall a b. (a -> b) -> a -> b
$ PublicIPInfo Text (Either IPv4 IPv6)
ipinfo { publicIP = ip }) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Turn server on.
powerOnServer :: Token -> ServerID -> IO Action
powerOnServer :: Token -> ServerID -> IO Action
powerOnServer Token
token (ServerID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/poweron") Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Turn server off. This is not a graceful shutdown.
powerOffServer :: Token -> ServerID -> IO Action
powerOffServer :: Token -> ServerID -> IO Action
powerOffServer Token
token (ServerID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/poweroff") Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Send ACPI shutdown request to a server. Use this instead of 'powerOffServer' if you
--   wish for a graceful shutdown. However, the returned action finishes when the
--   shutdown request is sent, so 'waitForAction' won't help you to tell whether the
--   server is actually off.
shutdownServer :: Token -> ServerID -> IO Action
shutdownServer :: Token -> ServerID -> IO Action
shutdownServer Token
token (ServerID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/shutdown") Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Send ACPI reboot request to a server.
rebootServer :: Token -> ServerID -> IO Action
rebootServer :: Token -> ServerID -> IO Action
rebootServer Token
token (ServerID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/reboot") Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Change a server's type. The target type must have equal or larger disk.
--   The server needs to be turned off before changing its type.
changeServerType
  :: Token -> ServerID -> ServerTypeID
  -> Bool -- ^ Should the disk also be upgraded? If not, it will stay the same size.
  -> IO Action
changeServerType :: Token -> ServerID -> ServerTypeID -> Bool -> IO Action
changeServerType Token
token (ServerID Int
i) ServerTypeID
stype Bool
upgrade = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"action" (WithKey "action" Action -> Action)
-> IO (WithKey "action" Action) -> IO Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"server_type" Key -> ServerTypeID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServerTypeID
stype
        , Key
"upgrade_disk" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
upgrade
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "action" Action)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST"
        (ByteString
"/servers/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/change_type")
        (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Server Types
----------------------------------------------------------------------------------------------------

-- | Computer architecture.
data Architecture = X86 | Arm deriving (Architecture -> Architecture -> Bool
(Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Bool) -> Eq Architecture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Architecture -> Architecture -> Bool
== :: Architecture -> Architecture -> Bool
$c/= :: Architecture -> Architecture -> Bool
/= :: Architecture -> Architecture -> Bool
Eq, Int -> Architecture -> ShowS
[Architecture] -> ShowS
Architecture -> String
(Int -> Architecture -> ShowS)
-> (Architecture -> String)
-> ([Architecture] -> ShowS)
-> Show Architecture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Architecture -> ShowS
showsPrec :: Int -> Architecture -> ShowS
$cshow :: Architecture -> String
show :: Architecture -> String
$cshowList :: [Architecture] -> ShowS
showList :: [Architecture] -> ShowS
Show)

instance FromJSON Architecture where
  parseJSON :: Value -> Parser Architecture
parseJSON = String
-> (Text -> Parser Architecture) -> Value -> Parser Architecture
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"Architecture" ((Text -> Parser Architecture) -> Value -> Parser Architecture)
-> (Text -> Parser Architecture) -> Value -> Parser Architecture
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"x86" -> Architecture -> Parser Architecture
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Architecture
X86
    Text
"arm" -> Architecture -> Parser Architecture
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Architecture
Arm
    Text
_ -> String -> Parser Architecture
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Architecture) -> String -> Parser Architecture
forall a b. (a -> b) -> a -> b
$ String
"Unknown architecture: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | Type of server boot drive.
data StorageType = LocalStorage | NetworkStorage deriving (StorageType -> StorageType -> Bool
(StorageType -> StorageType -> Bool)
-> (StorageType -> StorageType -> Bool) -> Eq StorageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorageType -> StorageType -> Bool
== :: StorageType -> StorageType -> Bool
$c/= :: StorageType -> StorageType -> Bool
/= :: StorageType -> StorageType -> Bool
Eq, Int -> StorageType -> ShowS
[StorageType] -> ShowS
StorageType -> String
(Int -> StorageType -> ShowS)
-> (StorageType -> String)
-> ([StorageType] -> ShowS)
-> Show StorageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorageType -> ShowS
showsPrec :: Int -> StorageType -> ShowS
$cshow :: StorageType -> String
show :: StorageType -> String
$cshowList :: [StorageType] -> ShowS
showList :: [StorageType] -> ShowS
Show)

instance FromJSON StorageType where
  parseJSON :: Value -> Parser StorageType
parseJSON = String
-> (Text -> Parser StorageType) -> Value -> Parser StorageType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"StorageType" ((Text -> Parser StorageType) -> Value -> Parser StorageType)
-> (Text -> Parser StorageType) -> Value -> Parser StorageType
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"local" -> StorageType -> Parser StorageType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageType
LocalStorage
    Text
"network" -> StorageType -> Parser StorageType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StorageType
NetworkStorage
    Text
_ -> String -> Parser StorageType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser StorageType) -> String -> Parser StorageType
forall a b. (a -> b) -> a -> b
$ String
"Unknown storage type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | CPU types available.
data CPUType = SharedCPU | DedicatedCPU deriving (CPUType -> CPUType -> Bool
(CPUType -> CPUType -> Bool)
-> (CPUType -> CPUType -> Bool) -> Eq CPUType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPUType -> CPUType -> Bool
== :: CPUType -> CPUType -> Bool
$c/= :: CPUType -> CPUType -> Bool
/= :: CPUType -> CPUType -> Bool
Eq, Int -> CPUType -> ShowS
[CPUType] -> ShowS
CPUType -> String
(Int -> CPUType -> ShowS)
-> (CPUType -> String) -> ([CPUType] -> ShowS) -> Show CPUType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CPUType -> ShowS
showsPrec :: Int -> CPUType -> ShowS
$cshow :: CPUType -> String
show :: CPUType -> String
$cshowList :: [CPUType] -> ShowS
showList :: [CPUType] -> ShowS
Show)

instance FromJSON CPUType where
  parseJSON :: Value -> Parser CPUType
parseJSON = String -> (Text -> Parser CPUType) -> Value -> Parser CPUType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"CPUType" ((Text -> Parser CPUType) -> Value -> Parser CPUType)
-> (Text -> Parser CPUType) -> Value -> Parser CPUType
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"shared" -> CPUType -> Parser CPUType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPUType
SharedCPU
    Text
"dedicated" -> CPUType -> Parser CPUType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPUType
DedicatedCPU
    Text
_ -> String -> Parser CPUType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser CPUType) -> String -> Parser CPUType
forall a b. (a -> b) -> a -> b
$ String
"Unknown CPU type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

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

-- | Server characteristics.
data ServerType = ServerType
  { ServerType -> Architecture
serverArchitecture :: Architecture
  , ServerType -> Int
serverCores :: Int
  , ServerType -> CPUType
serverCPUType :: CPUType
  , ServerType -> Bool
serverDeprecated :: Bool
  , ServerType -> Text
serverTypeDescription :: Text
    -- | Disk size a server of this type has in GB.
  , ServerType -> Int
serverDisk :: Int
  , ServerType -> ServerTypeID
serverTypeID :: ServerTypeID
    -- | Memory a server of this type has in GB.
  , ServerType -> Int
serverMemory :: Int
  , ServerType -> Text
serverTypeName :: Text
  , ServerType -> [PriceInLocation]
serverPricing :: [PriceInLocation]
  , ServerType -> StorageType
serverStorageType :: StorageType
    } deriving Int -> ServerType -> ShowS
[ServerType] -> ShowS
ServerType -> String
(Int -> ServerType -> ShowS)
-> (ServerType -> String)
-> ([ServerType] -> ShowS)
-> Show ServerType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerType -> ShowS
showsPrec :: Int -> ServerType -> ShowS
$cshow :: ServerType -> String
show :: ServerType -> String
$cshowList :: [ServerType] -> ShowS
showList :: [ServerType] -> ShowS
Show

instance FromJSON ServerType where
  parseJSON :: Value -> Parser ServerType
parseJSON = String
-> (Object -> Parser ServerType) -> Value -> Parser ServerType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"ServerType" ((Object -> Parser ServerType) -> Value -> Parser ServerType)
-> (Object -> Parser ServerType) -> Value -> Parser ServerType
forall a b. (a -> b) -> a -> b
$ \Object
o -> Architecture
-> Int
-> CPUType
-> Bool
-> Text
-> Int
-> ServerTypeID
-> Int
-> Text
-> [PriceInLocation]
-> StorageType
-> ServerType
ServerType
    (Architecture
 -> Int
 -> CPUType
 -> Bool
 -> Text
 -> Int
 -> ServerTypeID
 -> Int
 -> Text
 -> [PriceInLocation]
 -> StorageType
 -> ServerType)
-> Parser Architecture
-> Parser
     (Int
      -> CPUType
      -> Bool
      -> Text
      -> Int
      -> ServerTypeID
      -> Int
      -> Text
      -> [PriceInLocation]
      -> StorageType
      -> ServerType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Architecture
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"architecture"
    Parser
  (Int
   -> CPUType
   -> Bool
   -> Text
   -> Int
   -> ServerTypeID
   -> Int
   -> Text
   -> [PriceInLocation]
   -> StorageType
   -> ServerType)
-> Parser Int
-> Parser
     (CPUType
      -> Bool
      -> Text
      -> Int
      -> ServerTypeID
      -> Int
      -> Text
      -> [PriceInLocation]
      -> StorageType
      -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cores"
    Parser
  (CPUType
   -> Bool
   -> Text
   -> Int
   -> ServerTypeID
   -> Int
   -> Text
   -> [PriceInLocation]
   -> StorageType
   -> ServerType)
-> Parser CPUType
-> Parser
     (Bool
      -> Text
      -> Int
      -> ServerTypeID
      -> Int
      -> Text
      -> [PriceInLocation]
      -> StorageType
      -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser CPUType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cpu_type"
    Parser
  (Bool
   -> Text
   -> Int
   -> ServerTypeID
   -> Int
   -> Text
   -> [PriceInLocation]
   -> StorageType
   -> ServerType)
-> Parser Bool
-> Parser
     (Text
      -> Int
      -> ServerTypeID
      -> Int
      -> Text
      -> [PriceInLocation]
      -> StorageType
      -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deprecated")
    Parser
  (Text
   -> Int
   -> ServerTypeID
   -> Int
   -> Text
   -> [PriceInLocation]
   -> StorageType
   -> ServerType)
-> Parser Text
-> Parser
     (Int
      -> ServerTypeID
      -> Int
      -> Text
      -> [PriceInLocation]
      -> StorageType
      -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Parser
  (Int
   -> ServerTypeID
   -> Int
   -> Text
   -> [PriceInLocation]
   -> StorageType
   -> ServerType)
-> Parser Int
-> Parser
     (ServerTypeID
      -> Int -> Text -> [PriceInLocation] -> StorageType -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"disk"
    Parser
  (ServerTypeID
   -> Int -> Text -> [PriceInLocation] -> StorageType -> ServerType)
-> Parser ServerTypeID
-> Parser
     (Int -> Text -> [PriceInLocation] -> StorageType -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ServerTypeID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (Int -> Text -> [PriceInLocation] -> StorageType -> ServerType)
-> Parser Int
-> Parser (Text -> [PriceInLocation] -> StorageType -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory"
    Parser (Text -> [PriceInLocation] -> StorageType -> ServerType)
-> Parser Text
-> Parser ([PriceInLocation] -> StorageType -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser ([PriceInLocation] -> StorageType -> ServerType)
-> Parser [PriceInLocation] -> Parser (StorageType -> ServerType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [PriceInLocation]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prices"
    Parser (StorageType -> ServerType)
-> Parser StorageType -> Parser ServerType
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser StorageType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"storage_type"

-- | Get all server types.
--
--   A regularly updated list of server types can be browsed
--   [here](https://daniel-casanueva.gitlab.io/haskell/hetzner/server-types).
getServerTypes :: Token -> Maybe Int -> IO (WithMeta "server_types" [ServerType])
getServerTypes :: Token -> Maybe Int -> IO (WithMeta "server_types" [ServerType])
getServerTypes = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "server_types" [ServerType])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/server_types" Maybe Void
noBody

----------------------------------------------------------------------------------------------------
-- SSH Keys
----------------------------------------------------------------------------------------------------

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

-- | SSH key information.
data SSHKey = SSHKey
  { SSHKey -> ZonedTime
sshKeyCreated :: ZonedTime
  , SSHKey -> Fingerprint
sshKeyFingerprint :: Fingerprint
  , SSHKey -> SSHKeyID
sshKeyID :: SSHKeyID
  , SSHKey -> LabelMap
sshKeyLabels :: LabelMap
  , SSHKey -> Text
sshKeyName :: Text
  , SSHKey -> Text
sshKeyPublicKey :: Text
    } deriving Int -> SSHKey -> ShowS
[SSHKey] -> ShowS
SSHKey -> String
(Int -> SSHKey -> ShowS)
-> (SSHKey -> String) -> ([SSHKey] -> ShowS) -> Show SSHKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SSHKey -> ShowS
showsPrec :: Int -> SSHKey -> ShowS
$cshow :: SSHKey -> String
show :: SSHKey -> String
$cshowList :: [SSHKey] -> ShowS
showList :: [SSHKey] -> ShowS
Show

instance FromJSON SSHKey where
  parseJSON :: Value -> Parser SSHKey
parseJSON = String -> (Object -> Parser SSHKey) -> Value -> Parser SSHKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"SSHKey" ((Object -> Parser SSHKey) -> Value -> Parser SSHKey)
-> (Object -> Parser SSHKey) -> Value -> Parser SSHKey
forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> Fingerprint -> SSHKeyID -> LabelMap -> Text -> Text -> SSHKey
SSHKey
    (ZonedTime
 -> Fingerprint -> SSHKeyID -> LabelMap -> Text -> Text -> SSHKey)
-> Parser ZonedTime
-> Parser
     (Fingerprint -> SSHKeyID -> LabelMap -> Text -> Text -> SSHKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    Parser
  (Fingerprint -> SSHKeyID -> LabelMap -> Text -> Text -> SSHKey)
-> Parser Fingerprint
-> Parser (SSHKeyID -> LabelMap -> Text -> Text -> SSHKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FingerprintText -> Fingerprint
fingerprint (FingerprintText -> Fingerprint)
-> Parser FingerprintText -> Parser Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser FingerprintText
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fingerprint")
    Parser (SSHKeyID -> LabelMap -> Text -> Text -> SSHKey)
-> Parser SSHKeyID -> Parser (LabelMap -> Text -> Text -> SSHKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser SSHKeyID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser (LabelMap -> Text -> Text -> SSHKey)
-> Parser LabelMap -> Parser (Text -> Text -> SSHKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    Parser (Text -> Text -> SSHKey)
-> Parser Text -> Parser (Text -> SSHKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser (Text -> SSHKey) -> Parser Text -> Parser SSHKey
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public_key"

-- | Get all uploaded SSH keys.
getSSHKeys :: Token -> IO [SSHKey]
getSSHKeys :: Token -> IO [SSHKey]
getSSHKeys Token
token = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"ssh_keys" (WithKey "ssh_keys" [SSHKey] -> [SSHKey])
-> IO (WithKey "ssh_keys" [SSHKey]) -> IO [SSHKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "ssh_keys" [SSHKey])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/ssh_keys" Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Get a single SSH key.
getSSHKey :: Token -> SSHKeyID -> IO SSHKey
getSSHKey :: Token -> SSHKeyID -> IO SSHKey
getSSHKey Token
token (SSHKeyID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"ssh_key" (WithKey "ssh_key" SSHKey -> SSHKey)
-> IO (WithKey "ssh_key" SSHKey) -> IO SSHKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "ssh_key" SSHKey)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/ssh_keys/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Upload an SSH key.
createSSHKey
  :: Token
  -> Text -- ^ Name for the SSH key.
  -> Text -- ^ Public key.
  -> [Label] -- ^ List of labels to attach to the key.
  -> IO SSHKey
createSSHKey :: Token -> Text -> Text -> [Label] -> IO SSHKey
createSSHKey Token
token Text
name Text
public [Label]
labels = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"ssh_key" (WithKey "ssh_key" SSHKey -> SSHKey)
-> IO (WithKey "ssh_key" SSHKey) -> IO SSHKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
        , Key
"public_key" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
public
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "ssh_key" SSHKey)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/ssh_keys" (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Delete an SSH key.
deleteSSHKey :: Token -> SSHKeyID -> IO ()
deleteSSHKey :: Token -> SSHKeyID -> IO ()
deleteSSHKey Token
token (SSHKeyID Int
i) =
  ByteString
-> ByteString -> Maybe Void -> Token -> Maybe Int -> IO ()
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/ssh_keys/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Update name and labels of an SSH key.
updateSSHKey
  :: Token
  -> SSHKeyID
  -> Text -- ^ New name for the key.
  -> [Label] -- ^ New labels for the key.
  -> IO SSHKey -- ^ Updated SSH key.
updateSSHKey :: Token -> SSHKeyID -> Text -> [Label] -> IO SSHKey
updateSSHKey Token
token (SSHKeyID Int
i) Text
name [Label]
labels = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"ssh_key" (WithKey "ssh_key" SSHKey -> SSHKey)
-> IO (WithKey "ssh_key" SSHKey) -> IO SSHKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "ssh_key" SSHKey)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/ssh_keys/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------------------
-- Volumes
----------------------------------------------------------------------------------------------------

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

-- | Volume format.
data VolumeFormat = EXT4 | XFS deriving (VolumeFormat -> VolumeFormat -> Bool
(VolumeFormat -> VolumeFormat -> Bool)
-> (VolumeFormat -> VolumeFormat -> Bool) -> Eq VolumeFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VolumeFormat -> VolumeFormat -> Bool
== :: VolumeFormat -> VolumeFormat -> Bool
$c/= :: VolumeFormat -> VolumeFormat -> Bool
/= :: VolumeFormat -> VolumeFormat -> Bool
Eq, Int -> VolumeFormat -> ShowS
[VolumeFormat] -> ShowS
VolumeFormat -> String
(Int -> VolumeFormat -> ShowS)
-> (VolumeFormat -> String)
-> ([VolumeFormat] -> ShowS)
-> Show VolumeFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VolumeFormat -> ShowS
showsPrec :: Int -> VolumeFormat -> ShowS
$cshow :: VolumeFormat -> String
show :: VolumeFormat -> String
$cshowList :: [VolumeFormat] -> ShowS
showList :: [VolumeFormat] -> ShowS
Show)

instance FromJSON VolumeFormat where
  parseJSON :: Value -> Parser VolumeFormat
parseJSON = String
-> (Text -> Parser VolumeFormat) -> Value -> Parser VolumeFormat
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"VolumeFormat" ((Text -> Parser VolumeFormat) -> Value -> Parser VolumeFormat)
-> (Text -> Parser VolumeFormat) -> Value -> Parser VolumeFormat
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"ext4" -> VolumeFormat -> Parser VolumeFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeFormat
EXT4
    Text
"xfs" -> VolumeFormat -> Parser VolumeFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeFormat
XFS
    Text
_ -> String -> Parser VolumeFormat
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser VolumeFormat) -> String -> Parser VolumeFormat
forall a b. (a -> b) -> a -> b
$ String
"Invalid volume format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

instance ToJSON VolumeFormat where
  toJSON :: VolumeFormat -> Value
toJSON VolumeFormat
EXT4 = Text -> Value
JSON.String Text
"ext4"
  toJSON VolumeFormat
XFS = Text -> Value
JSON.String Text
"xfs"

-- | Volume status.
data VolumeStatus = VolumeCreating | VolumeAvailable deriving (VolumeStatus -> VolumeStatus -> Bool
(VolumeStatus -> VolumeStatus -> Bool)
-> (VolumeStatus -> VolumeStatus -> Bool) -> Eq VolumeStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VolumeStatus -> VolumeStatus -> Bool
== :: VolumeStatus -> VolumeStatus -> Bool
$c/= :: VolumeStatus -> VolumeStatus -> Bool
/= :: VolumeStatus -> VolumeStatus -> Bool
Eq, Int -> VolumeStatus -> ShowS
[VolumeStatus] -> ShowS
VolumeStatus -> String
(Int -> VolumeStatus -> ShowS)
-> (VolumeStatus -> String)
-> ([VolumeStatus] -> ShowS)
-> Show VolumeStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VolumeStatus -> ShowS
showsPrec :: Int -> VolumeStatus -> ShowS
$cshow :: VolumeStatus -> String
show :: VolumeStatus -> String
$cshowList :: [VolumeStatus] -> ShowS
showList :: [VolumeStatus] -> ShowS
Show)

instance FromJSON VolumeStatus where
  parseJSON :: Value -> Parser VolumeStatus
parseJSON = String
-> (Text -> Parser VolumeStatus) -> Value -> Parser VolumeStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"VolumeStatus" ((Text -> Parser VolumeStatus) -> Value -> Parser VolumeStatus)
-> (Text -> Parser VolumeStatus) -> Value -> Parser VolumeStatus
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"creating" -> VolumeStatus -> Parser VolumeStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeStatus
VolumeCreating
    Text
"available" -> VolumeStatus -> Parser VolumeStatus
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeStatus
VolumeAvailable
    Text
_ -> String -> Parser VolumeStatus
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser VolumeStatus) -> String -> Parser VolumeStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid volume status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t

-- | A volume that can be attached to a server.
data Volume = Volume
  { Volume -> ZonedTime
volumeCreated :: ZonedTime
    -- | Volume format. It returns 'Nothing' if the volume hasn't been formatted yet.
  , Volume -> Maybe VolumeFormat
volumeFormat :: Maybe VolumeFormat
  , Volume -> VolumeID
volumeID :: VolumeID
  , Volume -> LabelMap
volumeLabels :: LabelMap
    -- | Device path on the file system for the volume.
  , Volume -> String
volumePath :: FilePath
  , Volume -> Location
volumeLocation :: Location
  , Volume -> Text
volumeName :: Text
    -- | ID of the server the volume is attached to, if any.
  , Volume -> Maybe ServerID
volumeServer :: Maybe ServerID
    -- | Size of the volume in GB.
  , Volume -> Int
volumeSize :: Int
  , Volume -> VolumeStatus
volumeStatus :: VolumeStatus
    } deriving Int -> Volume -> ShowS
[Volume] -> ShowS
Volume -> String
(Int -> Volume -> ShowS)
-> (Volume -> String) -> ([Volume] -> ShowS) -> Show Volume
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Volume -> ShowS
showsPrec :: Int -> Volume -> ShowS
$cshow :: Volume -> String
show :: Volume -> String
$cshowList :: [Volume] -> ShowS
showList :: [Volume] -> ShowS
Show

instance FromJSON Volume where
  parseJSON :: Value -> Parser Volume
parseJSON = String -> (Object -> Parser Volume) -> Value -> Parser Volume
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Volume" ((Object -> Parser Volume) -> Value -> Parser Volume)
-> (Object -> Parser Volume) -> Value -> Parser Volume
forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> Maybe VolumeFormat
-> VolumeID
-> LabelMap
-> String
-> Location
-> Text
-> Maybe ServerID
-> Int
-> VolumeStatus
-> Volume
Volume
    (ZonedTime
 -> Maybe VolumeFormat
 -> VolumeID
 -> LabelMap
 -> String
 -> Location
 -> Text
 -> Maybe ServerID
 -> Int
 -> VolumeStatus
 -> Volume)
-> Parser ZonedTime
-> Parser
     (Maybe VolumeFormat
      -> VolumeID
      -> LabelMap
      -> String
      -> Location
      -> Text
      -> Maybe ServerID
      -> Int
      -> VolumeStatus
      -> Volume)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ZonedTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    Parser
  (Maybe VolumeFormat
   -> VolumeID
   -> LabelMap
   -> String
   -> Location
   -> Text
   -> Maybe ServerID
   -> Int
   -> VolumeStatus
   -> Volume)
-> Parser (Maybe VolumeFormat)
-> Parser
     (VolumeID
      -> LabelMap
      -> String
      -> Location
      -> Text
      -> Maybe ServerID
      -> Int
      -> VolumeStatus
      -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe VolumeFormat)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"format"
    Parser
  (VolumeID
   -> LabelMap
   -> String
   -> Location
   -> Text
   -> Maybe ServerID
   -> Int
   -> VolumeStatus
   -> Volume)
-> Parser VolumeID
-> Parser
     (LabelMap
      -> String
      -> Location
      -> Text
      -> Maybe ServerID
      -> Int
      -> VolumeStatus
      -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser VolumeID
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser
  (LabelMap
   -> String
   -> Location
   -> Text
   -> Maybe ServerID
   -> Int
   -> VolumeStatus
   -> Volume)
-> Parser LabelMap
-> Parser
     (String
      -> Location
      -> Text
      -> Maybe ServerID
      -> Int
      -> VolumeStatus
      -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LabelMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    Parser
  (String
   -> Location
   -> Text
   -> Maybe ServerID
   -> Int
   -> VolumeStatus
   -> Volume)
-> Parser String
-> Parser
     (Location
      -> Text -> Maybe ServerID -> Int -> VolumeStatus -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"linux_device"
    Parser
  (Location
   -> Text -> Maybe ServerID -> Int -> VolumeStatus -> Volume)
-> Parser Location
-> Parser (Text -> Maybe ServerID -> Int -> VolumeStatus -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Location
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location"
    Parser (Text -> Maybe ServerID -> Int -> VolumeStatus -> Volume)
-> Parser Text
-> Parser (Maybe ServerID -> Int -> VolumeStatus -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Parser (Maybe ServerID -> Int -> VolumeStatus -> Volume)
-> Parser (Maybe ServerID)
-> Parser (Int -> VolumeStatus -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ServerID)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server"
    Parser (Int -> VolumeStatus -> Volume)
-> Parser Int -> Parser (VolumeStatus -> Volume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
    Parser (VolumeStatus -> Volume)
-> Parser VolumeStatus -> Parser Volume
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser VolumeStatus
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"

-- | Attach a volume to a server. The boolean parameter
--   indicates whether the volume will be auto-mounted.
data AttachToServer = AttachToServer ServerID Bool

-- | Volume creation configuration to be used with 'createVolume'.
data NewVolume = NewVolume
  { -- | If specified, volume will be formatted according
    --   to the given format.
    NewVolume -> Maybe VolumeFormat
newVolumeFormat :: Maybe VolumeFormat
  , NewVolume -> [Label]
newVolumeLabels :: [Label]
    -- | You can either create a volume in a location or
    --   directly attach the volume to a server.
  , NewVolume -> Either LocationID AttachToServer
newVolumeLocation :: Either LocationID AttachToServer
  , NewVolume -> Text
newVolumeName :: Text
    -- | Size of the volume in GB. It must be at least 10.
  , NewVolume -> Int
newVolumeSize :: Int
    }

instance ToJSON NewVolume where
  toJSON :: NewVolume -> Value
toJSON NewVolume
nvolume = [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat
    [ [Pair] -> (VolumeFormat -> [Pair]) -> Maybe VolumeFormat -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair])
-> (VolumeFormat -> Pair) -> VolumeFormat -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"format"Key -> VolumeFormat -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)) (Maybe VolumeFormat -> [Pair]) -> Maybe VolumeFormat -> [Pair]
forall a b. (a -> b) -> a -> b
$ NewVolume -> Maybe VolumeFormat
newVolumeFormat NewVolume
nvolume
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap (NewVolume -> [Label]
newVolumeLabels NewVolume
nvolume)
    , let f :: AttachToServer -> [JSON.Pair]
          f :: AttachToServer -> [Pair]
f (AttachToServer ServerID
i Bool
b) = [ Key
"server" Key -> ServerID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServerID
i, Key
"automount" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
b ]
      in  (LocationID -> [Pair])
-> (AttachToServer -> [Pair])
-> Either LocationID AttachToServer
-> [Pair]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> (LocationID -> Pair) -> LocationID -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"location"Key -> LocationID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)) AttachToServer -> [Pair]
f (Either LocationID AttachToServer -> [Pair])
-> Either LocationID AttachToServer -> [Pair]
forall a b. (a -> b) -> a -> b
$ NewVolume -> Either LocationID AttachToServer
newVolumeLocation NewVolume
nvolume
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewVolume -> Text
newVolumeName NewVolume
nvolume
    , Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> Pair -> [Pair]
forall a b. (a -> b) -> a -> b
$ Key
"size" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NewVolume -> Int
newVolumeSize NewVolume
nvolume
      ]

-- | A volume created with 'createVolume'.
data CreatedVolume = CreatedVolume
  { CreatedVolume -> Action
createdVolumeAction :: Action
  , CreatedVolume -> [Action]
createdVolumeNextActions :: [Action]
  , CreatedVolume -> Volume
createdVolume :: Volume
    } deriving Int -> CreatedVolume -> ShowS
[CreatedVolume] -> ShowS
CreatedVolume -> String
(Int -> CreatedVolume -> ShowS)
-> (CreatedVolume -> String)
-> ([CreatedVolume] -> ShowS)
-> Show CreatedVolume
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedVolume -> ShowS
showsPrec :: Int -> CreatedVolume -> ShowS
$cshow :: CreatedVolume -> String
show :: CreatedVolume -> String
$cshowList :: [CreatedVolume] -> ShowS
showList :: [CreatedVolume] -> ShowS
Show

instance FromJSON CreatedVolume where
  parseJSON :: Value -> Parser CreatedVolume
parseJSON = String
-> (Object -> Parser CreatedVolume)
-> Value
-> Parser CreatedVolume
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"CreatedVolume" ((Object -> Parser CreatedVolume) -> Value -> Parser CreatedVolume)
-> (Object -> Parser CreatedVolume)
-> Value
-> Parser CreatedVolume
forall a b. (a -> b) -> a -> b
$ \Object
o -> Action -> [Action] -> Volume -> CreatedVolume
CreatedVolume
    (Action -> [Action] -> Volume -> CreatedVolume)
-> Parser Action -> Parser ([Action] -> Volume -> CreatedVolume)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Action
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
    Parser ([Action] -> Volume -> CreatedVolume)
-> Parser [Action] -> Parser (Volume -> CreatedVolume)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Action]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"next_actions"
    Parser (Volume -> CreatedVolume)
-> Parser Volume -> Parser CreatedVolume
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Volume
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"volume"

-- | Get volumes.
getVolumes :: Token -> Maybe Int -> IO (WithMeta "volumes" [Volume])
getVolumes :: Token -> Maybe Int -> IO (WithMeta "volumes" [Volume])
getVolumes = ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithMeta "volumes" [Volume])
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" ByteString
"/volumes" Maybe Void
noBody

-- | Get a single volume.
getVolume :: Token -> VolumeID -> IO Volume
getVolume :: Token -> VolumeID -> IO Volume
getVolume Token
token (VolumeID Int
i) = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"volume" (WithKey "volume" Volume -> Volume)
-> IO (WithKey "volume" Volume) -> IO Volume
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString
-> ByteString
-> Maybe Void
-> Token
-> Maybe Int
-> IO (WithKey "volume" Volume)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/volumes/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Create a new volume.
createVolume :: Token -> NewVolume -> IO CreatedVolume
createVolume :: Token -> NewVolume -> IO CreatedVolume
createVolume Token
token NewVolume
nvolume =
  ByteString
-> ByteString
-> Maybe NewVolume
-> Token
-> Maybe Int
-> IO CreatedVolume
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/volumes" (NewVolume -> Maybe NewVolume
forall a. a -> Maybe a
Just NewVolume
nvolume) Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Delete a volume.
deleteVolume :: Token -> VolumeID -> IO ()
deleteVolume :: Token -> VolumeID -> IO ()
deleteVolume Token
token (VolumeID Int
i) =
  ByteString
-> ByteString -> Maybe Void -> Token -> Maybe Int -> IO ()
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/volumes/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token Maybe Int
forall a. Maybe a
Nothing

-- | Update name and labels of a volume.
updateVolume
  :: Token
  -> VolumeID
  -> Text -- ^ New name for the volume.
  -> [Label] -- ^ New labels for the volume.
  -> IO Volume -- ^ Updated volume.
updateVolume :: Token -> VolumeID -> Text -> [Label] -> IO Volume
updateVolume Token
token (VolumeID Int
i) Text
name [Label]
labels = forall (key :: Symbol) a. WithKey key a -> a
withoutKey @"volume" (WithKey "volume" Volume -> Volume)
-> IO (WithKey "volume" Volume) -> IO Volume
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" Key -> LabelMap -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  ByteString
-> ByteString
-> Maybe Value
-> Token
-> Maybe Int
-> IO (WithKey "volume" Volume)
forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/volumes/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i)) (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
body) Token
token Maybe Int
forall a. Maybe a
Nothing