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

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

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

-- | Lookup 'Token' from the environment variable @HETZNER_API_TOKEN@.
getTokenFromEnv :: IO (Maybe Token)
getTokenFromEnv :: IO (Maybe Token)
getTokenFromEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
System.lookupEnv String
"HETZNER_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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show

instance FromJSON Error where
  parseJSON :: Value -> Parser Error
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Error" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Error
Error forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Error -> Text
errorCode Error
err, Key
"message" forall kv v. (KeyValue 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelKey -> LabelKey -> Bool
$c/= :: LabelKey -> LabelKey -> Bool
== :: LabelKey -> LabelKey -> Bool
$c== :: LabelKey -> LabelKey -> Bool
Eq, Eq 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
min :: LabelKey -> LabelKey -> LabelKey
$cmin :: LabelKey -> LabelKey -> LabelKey
max :: LabelKey -> LabelKey -> LabelKey
$cmax :: LabelKey -> LabelKey -> LabelKey
>= :: LabelKey -> LabelKey -> Bool
$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
compare :: LabelKey -> LabelKey -> Ordering
$ccompare :: LabelKey -> LabelKey -> Ordering
Ord, Int -> LabelKey -> ShowS
[LabelKey] -> ShowS
LabelKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelKey] -> ShowS
$cshowList :: [LabelKey] -> ShowS
show :: LabelKey -> String
$cshow :: LabelKey -> String
showsPrec :: Int -> LabelKey -> ShowS
$cshowsPrec :: Int -> LabelKey -> ShowS
Show)

type Parser = Parser.Parsec Void Text

labelKeyPrefixParser :: Parser Text
labelKeyPrefixParser :: Parser Text
labelKeyPrefixParser = do
  [Text]
xs <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Parser.some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar) (forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'.')
  Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'/'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar
  let loop :: Bool -> Parser [Char]
      loop :: Bool -> Parser String
loop Bool
afterSymbol = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
        [ (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
False
        , (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'-' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
True
        , (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'_' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
True
        , (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
True
        , if Bool
afterSymbol
             then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Label key name must end in alphanumeric character."
             else forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          ]
  String
xs <- Bool -> Parser String
loop Bool
False
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ Char
x forall a. a -> [a] -> [a]
: String
xs

labelKeyParser :: Parser LabelKey
labelKeyParser :: Parser LabelKey
labelKeyParser = do
  Maybe Text
prefix <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parser.optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Parser.try Parser Text
labelKeyPrefixParser
  Text
name <- Parser Text
labelKeyNameParser
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"LabelKey" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelKey -> Text
labelKeyRender

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

instance ToJSONKey LabelKey where
  toJSONKey :: ToJSONKeyFunction LabelKey
toJSONKey =
    forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
JSON.ToJSONKeyText
      (Text -> Key
JSONKey.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelKey -> Text
labelKeyRender)
      (forall a. Text -> Encoding' a
JSONEncoding.text 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show)

labelValueParser :: Parser Text
labelValueParser :: Parser Text
labelValueParser = do
  let loop :: Bool -> Parser [Char]
      loop :: Bool -> Parser String
loop Bool
afterSymbol = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
        [ (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Parser.alphaNumChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
False
        , (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'-' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
True
        , (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'_' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
True
        , (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser String
loop Bool
True
        , if Bool
afterSymbol
             then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Label value must end in alphanumeric character."
             else forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          ]
  Maybe Char
mx <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parser.optional 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser String
loop Bool
False
    Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Label
label -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Label -> LabelKey
labelKey Label
label) forall a b. (a -> b) -> a -> b
$ Label -> Text
labelValue Label
label) forall k a. Map k a
Map.empty

-- | Get a list of labels from a label map.
fromLabelMap :: LabelMap -> [Label]
fromLabelMap :: LabelMap -> [Label]
fromLabelMap = 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 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelSelector] -> ShowS
$cshowList :: [LabelSelector] -> ShowS
show :: LabelSelector -> String
$cshow :: LabelSelector -> String
showsPrec :: Int -> LabelSelector -> ShowS
$cshowsPrec :: Int -> LabelSelector -> ShowS
Show

-- | Label selector parser.
labelSelectorParser :: Parser LabelSelector
labelSelectorParser :: Parser LabelSelector
labelSelectorParser = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
  [ forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'!' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (LabelKey -> LabelSelector
KeyNotPresent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LabelKey
labelKeyParser)
  , do LabelKey
k <- Parser LabelKey
labelKeyParser
       forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
         [ do Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'='
              Maybe (Token Text)
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Parser.optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'='
              Text
v <- Parser Text
labelValueParser
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Label -> LabelSelector
LabelEqual forall a b. (a -> b) -> a -> b
$ LabelKey -> Text -> Label
Label LabelKey
k Text
v
         , do Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'!'
              Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'='
              Text
v <- Parser Text
labelValueParser
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Label -> LabelSelector
LabelNotEqual forall a b. (a -> b) -> a -> b
$ LabelKey -> Text -> Label
Label LabelKey
k Text
v
         , do Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
' '
              forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Parser.choice
                [ do Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parser.chunk Tokens Text
"in ("
                     [Text]
vs <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 Parser Text
labelValueParser forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
','
                     Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
')'
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LabelKey -> [Text] -> LabelSelector
KeyValueIn LabelKey
k [Text]
vs
                , do Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Parser.chunk Tokens Text
"notin ("
                     [Text]
vs <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 Parser Text
labelValueParser forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
','
                     Token Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
')'
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LabelKey -> [Text] -> LabelSelector
KeyValueNotIn LabelKey
k [Text]
vs
                  ]
         , forall (f :: * -> *) a. Applicative f => a -> f a
pure 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) forall a. Semigroup a => a -> a -> a
<> 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) forall a. Semigroup a => a -> a -> a
<> 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
"!" forall a. Semigroup a => a -> a -> a
<> LabelKey -> Text
labelKeyRender LabelKey
k
renderLabelSelector (KeyValueIn LabelKey
k [Text]
vs) =
  LabelKey -> Text
labelKeyRender LabelKey
k forall a. Semigroup a => a -> a -> a
<> Text
" in (" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
vs forall a. Semigroup a => a -> a -> a
<> Text
")"
renderLabelSelector (KeyValueNotIn LabelKey
k [Text]
vs) =
  LabelKey -> Text
labelKeyRender LabelKey
k forall a. Semigroup a => a -> a -> a
<> Text
" notin (" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," [Text]
vs 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelSelectorAll] -> ShowS
$cshowList :: [LabelSelectorAll] -> ShowS
show :: LabelSelectorAll -> String
$cshow :: LabelSelectorAll -> String
showsPrec :: Int -> LabelSelectorAll -> ShowS
$cshowsPrec :: Int -> LabelSelectorAll -> ShowS
Show

instance FromJSON LabelSelectorAll where
  parseJSON :: Value -> Parser LabelSelectorAll
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"LabelSelector" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      let parser :: ParsecT Void Text Identity LabelSelectorAll
parser = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LabelSelector] -> LabelSelectorAll
LabelSelectorAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Parser.sepBy1 Parser LabelSelector
labelSelectorParser forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
','
      in  forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (ParsecT Void Text Identity LabelSelectorAll
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 forall a b. (a -> b) -> a -> b
$
    Text -> [Text] -> Text
Text.intercalate 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pagination] -> ShowS
$cshowList :: [Pagination] -> ShowS
show :: Pagination -> String
$cshow :: Pagination -> String
showsPrec :: Int -> Pagination -> ShowS
$cshowsPrec :: Int -> Pagination -> ShowS
Show

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

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

instance FromJSON Region where
  parseJSON :: Value -> Parser Region
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"Region" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"eu-central" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
EUCentral
    Text
"us-west" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
USWest
    Text
"us-east" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
USEast
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown region: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show

instance FromJSON Metadata where
  parseJSON :: Value -> Parser Metadata
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Metadata" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> ServerID -> IPv4 -> Text -> Region -> Metadata
Metadata
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hostname"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"instance-id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public-ipv4"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"availability-zone"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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"
          forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
False
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
"169.254.169.254"
          forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
80
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath (ByteString
"/hetzner/v1/metadata" forall a. Semigroup a => a -> a -> a
<> ByteString
path)
          forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  in  forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Yaml.decodeThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. FromJSON a => ByteString -> IO a
metadataQuery 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloudException] -> ShowS
$cshowList :: [CloudException] -> ShowS
show :: CloudException -> String
$cshow :: CloudException -> String
showsPrec :: Int -> CloudException -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirewallStatus] -> ShowS
$cshowList :: [FirewallStatus] -> ShowS
show :: FirewallStatus -> String
$cshow :: FirewallStatus -> String
showsPrec :: Int -> FirewallStatus -> ShowS
$cshowsPrec :: Int -> FirewallStatus -> ShowS
Show

instance FromJSON FirewallStatus where
  parseJSON :: Value -> Parser FirewallStatus
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"FirewallStatus" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
status <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
    forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FirewallID -> Bool -> FirewallStatus
FirewallStatus (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id") forall a b. (a -> b) -> a -> b
$ case Text
status of
      Text
"applied" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Text
"pending" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid firewall status: " 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
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
showList :: [PublicIPInfo dnsptr ip] -> ShowS
$cshowList :: forall dnsptr ip.
(Show dnsptr, Show ip) =>
[PublicIPInfo dnsptr ip] -> ShowS
show :: PublicIPInfo dnsptr ip -> String
$cshow :: forall dnsptr ip.
(Show dnsptr, Show ip) =>
PublicIPInfo dnsptr ip -> String
showsPrec :: Int -> PublicIPInfo dnsptr ip -> ShowS
$cshowsPrec :: forall dnsptr ip.
(Show dnsptr, Show ip) =>
Int -> PublicIPInfo dnsptr ip -> ShowS
Show

instance (FromJSON dnsptr, FromJSON ip) => FromJSON (PublicIPInfo dnsptr ip) where
  parseJSON :: Value -> Parser (PublicIPInfo dnsptr ip)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"PublicIPInfo" forall a b. (a -> b) -> a -> b
$ \Object
o -> forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dns_ptr"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= dnsptr
dns, Key
"ip" forall kv v. (KeyValue 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) = 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) = forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo dnsptr
dns 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicNetwork] -> ShowS
$cshowList :: [PublicNetwork] -> ShowS
show :: PublicNetwork -> String
$cshow :: PublicNetwork -> String
showsPrec :: Int -> PublicNetwork -> ShowS
$cshowsPrec :: Int -> PublicNetwork -> ShowS
Show

instance FromJSON PublicNetwork where
  parseJSON :: Value -> Parser PublicNetwork
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"PublicNetwork" forall a b. (a -> b) -> a -> b
$ \Object
o -> [FirewallStatus]
-> [FloatingIPID]
-> Maybe (PublicIPInfo Text IPv4)
-> Maybe (PublicIPInfo [PublicIPInfo Text IPv6] IPv6Range)
-> PublicNetwork
PublicNetwork
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"firewalls"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"floating_ips"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ipv4"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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
          forall a b. (a -> b) -> a -> b
$ Bool -> Request -> Request
HTTP.setRequestSecure Bool
True
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestHost ByteString
"api.hetzner.cloud"
          forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
443
          forall a b. (a -> b) -> a -> b
$ ByteString -> Request -> Request
HTTP.setRequestPath (ByteString
"/v1" forall a. Semigroup a => a -> a -> a
<> ByteString
path)
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. ToJSON a => a -> Request -> Request
HTTP.setRequestBodyJSON Maybe body
mbody
          forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> Request -> Request
HTTP.addRequestHeader HeaderName
"Authorization" (ByteString
"Bearer " forall a. Semigroup a => a -> a -> a
<> ByteString
token)
          forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Int
page -> Query -> Request -> Request
HTTP.addToRequestQueryString
                                 [(ByteString
"page", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
page)]) Maybe Int
mpage
          forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpBS Request
req
  let body :: ByteString
body = forall a. Response a -> a
HTTP.getResponseBody Response ByteString
resp
  case forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Response a -> Int
HTTP.getResponseStatusCode Response ByteString
resp) Int
100 of
    (Int
2,Int
m) ->
      let body' :: ByteString
body' = if Int
m forall a. Eq a => a -> a -> Bool
== Int
4 then ByteString
"{}" else ByteString
body
      in  case forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body' of
            Left String
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Response ByteString -> String -> CloudException
JSONError Response ByteString
resp String
err
            Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    (Int, Int)
_ -> case forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict ByteString
body of
           Left String
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Response ByteString -> String -> CloudException
JSONError Response ByteString
resp String
err
           Right WithKey "error" Error
x -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Error -> CloudException
CloudError 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 = 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 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Int -> IO (WithMeta key (f a))
f Maybe Int
page
      -- Yield results from response
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ WithMeta key (f a)
resp forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== Int
cur
                                then forall a. Maybe a
Nothing
                                else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
cur forall a. Num a => a -> a -> a
+ Int
1
                   Maybe Int
_ -> Pagination -> Maybe Int
nextPage Pagination
pag
      if forall a. Maybe a -> Bool
isNothing Maybe Int
next then 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 = 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
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
showList :: [WithKey key a] -> ShowS
$cshowList :: forall (key :: Symbol) a. Show a => [WithKey key a] -> ShowS
show :: WithKey key a -> String
$cshow :: forall (key :: Symbol) a. Show a => WithKey key a -> String
showsPrec :: Int -> WithKey key a -> ShowS
$cshowsPrec :: forall (key :: Symbol) a. Show a => Int -> 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) = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @key)
    in  forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject (String
"WithKey:" forall a. [a] -> [a] -> [a]
++ String
key) forall a b. (a -> b) -> a -> b
$ \Object
o ->
          forall (key :: Symbol) a. a -> WithKey key a
WithKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: 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
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
showList :: [WithMeta key a] -> ShowS
$cshowList :: forall (key :: Symbol) a. Show a => [WithMeta key a] -> ShowS
show :: WithMeta key a -> String
$cshow :: forall (key :: Symbol) a. Show a => WithMeta key a -> String
showsPrec :: Int -> WithMeta key a -> ShowS
$cshowsPrec :: forall (key :: Symbol) a. Show a => Int -> 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 :: b
withoutMeta = a -> b
f forall a b. (a -> b) -> a -> b
$ forall (key :: Symbol) a. WithMeta key a -> a
withoutMeta WithMeta key a
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @key)
    in  forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject (String
"WithMeta:" forall a. [a] -> [a] -> [a]
++ String
key) forall a b. (a -> b) -> a -> b
$ \Object
o ->
          forall (key :: Symbol) a. ResponseMeta -> a -> WithMeta key a
WithMeta forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"meta" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseMeta] -> ShowS
$cshowList :: [ResponseMeta] -> ShowS
show :: ResponseMeta -> String
$cshow :: ResponseMeta -> String
showsPrec :: Int -> ResponseMeta -> ShowS
$cshowsPrec :: Int -> ResponseMeta -> ShowS
Show

instance FromJSON ResponseMeta where
  parseJSON :: Value -> Parser ResponseMeta
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"ResponseMeta" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Pagination -> ResponseMeta
ResponseMeta forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> EitherParser a b
LeftParser (forall a. FromJSON a => Value -> Parser a
JSON.parseJSON Value
v) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> EitherParser a b
RightParser (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) = forall a. ToJSON a => a -> Value
JSON.toJSON a
a
  toJSON (RightParser b
b) = 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> EitherParser a b
LeftParser 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 = forall a c b. (a -> c) -> (b -> c) -> EitherParser a b -> c
eitherParser forall a b. a -> Either a b
Left 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionStatus] -> ShowS
$cshowList :: [ActionStatus] -> ShowS
show :: ActionStatus -> String
$cshow :: ActionStatus -> String
showsPrec :: Int -> ActionStatus -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionCommand] -> ShowS
$cshowList :: [ActionCommand] -> ShowS
show :: ActionCommand -> String
$cshow :: ActionCommand -> String
showsPrec :: Int -> ActionCommand -> ShowS
$cshowsPrec :: Int -> ActionCommand -> ShowS
Show

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

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

instance FromJSON ResourceID where
  parseJSON :: Value -> Parser ResourceID
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"ResourceID" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
t <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case Text
t :: Text of
      Text
"server" -> ServerID -> ResourceID
ResourceServerID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
"volume" -> VolumeID -> ResourceID
ResourceVolumeID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
"primary_ip" -> PrimaryIPID -> ResourceID
ResourcePrimaryIPID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
"firewall" -> FirewallID -> ResourceID
ResourceFirewallID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown resource type: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show

instance FromJSON Action where
  parseJSON :: Value -> Parser Action
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Action" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ActionStatus
status <- do Text
statusText <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
                 case Text
statusText :: Text of
                   Text
"running" -> Int -> ActionStatus
ActionRunning forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"progress"
                   Text
"success" -> ZonedTime -> ActionStatus
ActionSuccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"finished"
                   Text
"error" -> ZonedTime -> Error -> ActionStatus
ActionError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"finished" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
                   Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown action status: " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
statusText
    ActionID
-> ActionCommand
-> ActionStatus
-> ZonedTime
-> [ResourceID]
-> Action
Action
     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"command"
     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionStatus
status
     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"started"
     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/actions/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ZonedTime
go
              ActionSuccess ZonedTime
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ZonedTime
t
              ActionError ZonedTime
_ Error
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Error -> CloudException
CloudError Error
err

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

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

instance FromJSON DatacenterServers where
  parseJSON :: Value -> Parser DatacenterServers
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"DatacenterServers" forall a b. (a -> b) -> a -> b
$ \Object
o -> [ServerTypeID]
-> [ServerTypeID] -> [ServerTypeID] -> DatacenterServers
DatacenterServers
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available_for_migration"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datacenter] -> ShowS
$cshowList :: [Datacenter] -> ShowS
show :: Datacenter -> String
$cshow :: Datacenter -> String
showsPrec :: Int -> Datacenter -> ShowS
$cshowsPrec :: Int -> Datacenter -> ShowS
Show

instance FromJSON Datacenter where
  parseJSON :: Value -> Parser Datacenter
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Datacenter" forall a b. (a -> b) -> a -> b
$ \Object
o -> DatacenterID
-> Text -> Text -> Location -> DatacenterServers -> Datacenter
Datacenter
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DatacentersWithRecommendation] -> ShowS
$cshowList :: [DatacentersWithRecommendation] -> ShowS
show :: DatacentersWithRecommendation -> String
$cshow :: DatacentersWithRecommendation -> String
showsPrec :: Int -> DatacentersWithRecommendation -> ShowS
$cshowsPrec :: Int -> DatacentersWithRecommendation -> ShowS
Show

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

-- | Get all datacenters.
getDatacenters :: Token -> IO DatacentersWithRecommendation
getDatacenters :: Token -> IO DatacentersWithRecommendation
getDatacenters Token
token = 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 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/datacenters/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token forall a. Maybe a
Nothing

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

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

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

instance FromJSON TrafficDirection where
  parseJSON :: Value -> Parser TrafficDirection
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"TrafficDirection" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text
t of
      Text
"in" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TrafficDirection
TrafficIn
      Text
"out" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TrafficDirection
TrafficOut
      Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid traffic direction: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortRange] -> ShowS
$cshowList :: [PortRange] -> ShowS
show :: PortRange -> String
$cshow :: PortRange -> String
showsPrec :: Int -> PortRange -> ShowS
$cshowsPrec :: Int -> 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 <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Parser.decimal
  Bool
hasSecondPart <- (forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
Parser.single Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  if Bool
hasSecondPart
     then Int -> Int -> PortRange
PortRange Int
p1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Parser.decimal
     else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> PortRange
PortRange Int
p1 Int
p1

instance FromJSON PortRange where
  parseJSON :: Value -> Parser PortRange
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"PortRange" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (Parser PortRange
portRangeParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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) = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$
    if Int
p1 forall a. Eq a => a -> a -> Bool
== Int
p2
       then forall a. Show a => a -> String
show Int
p1
       else forall a. Show a => a -> String
show Int
p1 forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirewallRuleProtocol] -> ShowS
$cshowList :: [FirewallRuleProtocol] -> ShowS
show :: FirewallRuleProtocol -> String
$cshow :: FirewallRuleProtocol -> String
showsPrec :: Int -> FirewallRuleProtocol -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirewallRule] -> ShowS
$cshowList :: [FirewallRule] -> ShowS
show :: FirewallRule -> String
$cshow :: FirewallRule -> String
showsPrec :: Int -> FirewallRule -> ShowS
$cshowsPrec :: Int -> FirewallRule -> ShowS
Show

instance FromJSON FirewallRule where
  parseJSON :: Value -> Parser FirewallRule
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"FirewallRule" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TrafficDirection
dir <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"direction"
    NonEmpty (EitherParser IPv4Range IPv6Range)
ips <-
      case TrafficDirection
dir of
        TrafficDirection
TrafficIn -> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source_ips"
        TrafficDirection
TrafficOut -> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"destination_ips"
    Text
protocolType <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocol"
    FirewallRuleProtocol
protocol <-
      case Text
protocolType of
        Text
"tcp" -> PortRange -> FirewallRuleProtocol
FirewallRuleTCP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
        Text
"udp" -> PortRange -> FirewallRuleProtocol
FirewallRuleUDP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
        Text
"icmp" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
FirewallRuleICMP
        Text
"esp" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
FirewallRuleESP
        Text
"gre" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FirewallRuleProtocol
FirewallRuleGRE
        Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid protocol: " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
protocolType
    Maybe Text
-> TrafficDirection
-> NonEmpty (Either IPv4Range IPv6Range)
-> FirewallRuleProtocol
-> FirewallRule
FirewallRule
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure TrafficDirection
dir
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. EitherParser a b -> Either a b
fromEitherParser NonEmpty (EitherParser IPv4Range IPv6Range)
ips)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Either a b -> EitherParser a b
toEitherParser forall a b. (a -> b) -> a -> b
$ FirewallRule -> NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs FirewallRule
rule
    in  [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t) (FirewallRule -> Maybe Text
firewallRuleDescription FirewallRule
rule)
            forall a. [a] -> [a] -> [a]
++ [ Key
"direction" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TrafficDirection
dir
               , case TrafficDirection
dir of
                   TrafficDirection
TrafficIn -> Key
"source_ips" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (EitherParser IPv4Range IPv6Range)
ips
                   TrafficDirection
TrafficOut -> Key
"destination_ips" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (EitherParser IPv4Range IPv6Range)
ips
                 ]
            forall a. [a] -> [a] -> [a]
++ (case FirewallRule -> FirewallRuleProtocol
firewallRuleProtocol FirewallRule
rule of
                  FirewallRuleTCP PortRange
r ->
                    [ Key
"protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"tcp" :: Text)
                    , Key
"port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PortRange
r
                      ]
                  FirewallRuleUDP PortRange
r ->
                    [ Key
"protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"udp" :: Text)
                    , Key
"port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PortRange
r
                      ]
                  FirewallRuleProtocol
FirewallRuleICMP -> [ Key
"protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"icmp" :: Text) ]
                  FirewallRuleProtocol
FirewallRuleESP -> [ Key
"protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"esp" :: Text) ]
                  FirewallRuleProtocol
FirewallRuleGRE -> [ Key
"protocol" forall kv v. (KeyValue 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Firewall] -> ShowS
$cshowList :: [Firewall] -> ShowS
show :: Firewall -> String
$cshow :: Firewall -> String
showsPrec :: Int -> Firewall -> ShowS
$cshowsPrec :: Int -> Firewall -> ShowS
Show

instance FromJSON Firewall where
  parseJSON :: Value -> Parser Firewall
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Firewall" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Value]
xs <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"applied_to"
    [Either ServerID LabelSelectorAll]
ys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
xs forall a b. (a -> b) -> a -> b
$ \Value
v ->
            let f :: Object -> Parser (Either a b)
f Object
o' = do
                  Text
t <- Object
o' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                  case Text
t of
                    Text
"server" -> do
                       Value
v' <- Object
o' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server"
                       forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Server" (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id") Value
v'
                    Text
"label_selector" -> do
                       Value
v' <- Object
o' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label_selector"
                       forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"LabelSelector" (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"selector") Value
v'
                    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid applied_to type: " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
t
            in  forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"AppliedTo" forall {a} {b}.
(FromJSON a, FromJSON b) =>
Object -> Parser (Either a b)
f Value
v
    let ([ServerID]
servers, [LabelSelectorAll]
labels) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ServerID LabelSelectorAll]
ys
    FirewallID
-> Text
-> ZonedTime
-> [ServerID]
-> [LabelSelectorAll]
-> [FirewallRule]
-> LabelMap
-> Firewall
Firewall
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [ServerID]
servers
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [LabelSelectorAll]
labels
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rules"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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 = forall a. a -> Maybe a
Just Text
"SSH"
          , firewallRuleDirection :: TrafficDirection
firewallRuleDirection = TrafficDirection
TrafficIn
          , firewallRuleIPs :: NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs = forall a b. a -> Either a b
Left IPv4Range
anyIPv4 forall a. a -> [a] -> NonEmpty a
:| [forall a b. b -> Either a b
Right IPv6Range
anyIPv6]
          , firewallRuleProtocol :: FirewallRuleProtocol
firewallRuleProtocol = PortRange -> FirewallRuleProtocol
FirewallRuleTCP forall a b. (a -> b) -> a -> b
$ Int -> PortRange
singlePort Int
22
            }
      , FirewallRule
          { firewallRuleDescription :: Maybe Text
firewallRuleDescription = forall a. a -> Maybe a
Just Text
"ICMP"
          , firewallRuleDirection :: TrafficDirection
firewallRuleDirection = TrafficDirection
TrafficIn
          , firewallRuleIPs :: NonEmpty (Either IPv4Range IPv6Range)
firewallRuleIPs = forall a b. a -> Either a b
Left IPv4Range
anyIPv4 forall a. a -> [a] -> NonEmpty a
:| [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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatedFirewall] -> ShowS
$cshowList :: [CreatedFirewall] -> ShowS
show :: CreatedFirewall -> String
$cshow :: CreatedFirewall -> String
showsPrec :: Int -> CreatedFirewall -> ShowS
$cshowsPrec :: Int -> CreatedFirewall -> ShowS
Show

instance FromJSON CreatedFirewall where
  parseJSON :: Value -> Parser CreatedFirewall
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"CreatedFirewall" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Action] -> Firewall -> CreatedFirewall
CreatedFirewall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"actions" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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 = 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/firewalls/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ServerID
i -> [Pair] -> Value
JSON.object [ Key
"server" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ServerID
i ])
              forall a b. (a -> b) -> a -> b
$ NewFirewall -> [ServerID]
newFirewallServers NewFirewall
nfirewall
      selectors :: [Value]
selectors = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LabelSelectorAll
s -> [Pair] -> Value
JSON.object [ Key
"selector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LabelSelectorAll
s ])
                forall a b. (a -> b) -> a -> b
$ NewFirewall -> [LabelSelectorAll]
newFirewallLabelSelectors NewFirewall
nfirewall
      applyTo :: [Value]
applyTo =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Value
v -> [Pair] -> Value
JSON.object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)
                                , Key
"server" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
v ]) [Value]
servers
          forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Value
v -> [Pair] -> Value
JSON.object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"label_selector" :: Text)
                                     , Key
"label_selector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
v ]) [Value]
selectors

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

-- | Delete a firewall.
deleteFirewall :: Token -> FirewallID -> IO ()
deleteFirewall :: Token -> FirewallID -> IO ()
deleteFirewall Token
token (FirewallID Int
i) =
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/firewalls/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/firewalls/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) (forall a. a -> Maybe a
Just Value
body) Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let path :: ByteString
path = ByteString
"/firewalls/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/apply_to_resources"
      serverf :: v -> Value
serverf v
server = [Pair] -> Value
JSON.object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)
        , Key
"server" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
server ] ]
      selectorf :: v -> Value
selectorf v
selector = [Pair] -> Value
JSON.object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"label_selector" :: Text)
        , Key
"label_selector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"selector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
selector ] ]
      body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"apply_to" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
serverf [ServerID]
servers forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
selectorf [LabelSelectorAll]
selectors)
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
path (forall a. a -> Maybe a
Just Value
body) Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let path :: ByteString
path = ByteString
"/firewalls/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/remove_from_resources"
      serverf :: v -> Value
serverf v
server = [Pair] -> Value
JSON.object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"server" :: Text)
        , Key
"server" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
server ] ]
      selectorf :: v -> Value
selectorf v
selector = [Pair] -> Value
JSON.object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"label_selector" :: Text)
        , Key
"label_selector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
JSON.object [ Key
"selector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
selector ] ]
      body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"remove_from" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
serverf [ServerID]
servers forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
selectorf [LabelSelectorAll]
selectors)
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
path (forall a. a -> Maybe a
Just Value
body) Token
token forall a. Maybe a
Nothing

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

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

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

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

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

instance FromJSON OSFlavor where
  parseJSON :: Value -> Parser OSFlavor
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"OSFlavor" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"ubuntu"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Ubuntu
    Text
"centos"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
CentOS
    Text
"debian"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Debian
    Text
"fedora"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Fedora
    Text
"rocky"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Rocky
    Text
"alma"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
Alma
    Text
"unknown" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OSFlavor
UnknownOS
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown OS flavor: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageType] -> ShowS
$cshowList :: [ImageType] -> ShowS
show :: ImageType -> String
$cshow :: ImageType -> String
showsPrec :: Int -> ImageType -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show

instance FromJSON Image where
  parseJSON :: Value -> Parser Image
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Image" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ImageType
typ <- do Text
t <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
              case Text
t :: Text of
                Text
"system" -> Text -> ImageType
SystemImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Text
"app" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageType
AppImage
                Text
"snapshot" -> Double -> ImageType
Snapshot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image_size"
                Text
"backup" -> ServerID -> ImageType
Backup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bound_to"
                Text
"temporary" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageType
Temporary
                Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown image type: " 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"os_flavor"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"architecture"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageType
typ
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"disk_size"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deprecated"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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 = 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/images/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token forall a. Maybe a
Nothing

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

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

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

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

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

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

instance FromJSON Location where
  parseJSON :: Value -> Parser Location
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Location" forall a b. (a -> b) -> a -> b
$ \Object
o -> City
-> Country
-> Text
-> LocationID
-> Double
-> Double
-> Text
-> Region
-> Location
Location
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"city"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"country"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"latitude"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"longitude"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  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 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/locations/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token forall a. Maybe a
Nothing

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

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

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

-- | Get primary IPs.
getPrimaryIPs
  :: Token
  -> Maybe Int -- ^ Page.
  -> IO (WithMeta "primary_ips" [PrimaryIP])
getPrimaryIPs :: Token -> Maybe Int -> IO (WithMeta "primary_ips" [PrimaryIP])
getPrimaryIPs = 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/primary_ips" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/primary_ips/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/change_dns_ptr")
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. ToJSON a => a -> Value
JSON.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo Text
dns) (forall a. ToJSON a => a -> Value
JSON.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dnsptr ip. dnsptr -> ip -> PublicIPInfo dnsptr ip
PublicIPInfo Text
dns) Either IPv4 IPv6
ip)
    Token
token forall a. Maybe a
Nothing

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

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

instance FromJSON Route where
  parseJSON :: Value -> Parser Route
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Route" forall a b. (a -> b) -> a -> b
$ \Object
o -> IPv4Range -> IPv4 -> Route
Route
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"destination"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Route -> IPv4Range
routeDestination Route
route
    , Key
"gateway" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Route -> IPv4
routeGateway Route
route
      ]

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

instance FromJSON SubnetType where
  parseJSON :: Value -> Parser SubnetType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"SubnetType" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"cloud" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SubnetType
SubnetCloud
    Text
"server" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SubnetType
SubnetServer
    Text
"vswitch" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SubnetType
SubnetVSwitch
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid subnet type: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subnet] -> ShowS
$cshowList :: [Subnet] -> ShowS
show :: Subnet -> String
$cshow :: Subnet -> String
showsPrec :: Int -> Subnet -> ShowS
$cshowsPrec :: Int -> Subnet -> ShowS
Show

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

instance ToJSON Subnet where
  toJSON :: Subnet -> Value
toJSON Subnet
subnet = [Pair] -> Value
JSON.object
    [ Key
"gateway" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Subnet -> IPv4
subnetGateway Subnet
subnet
    , Key
"ip_range" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Subnet -> IPv4Range
subnetIPRange Subnet
subnet
    , Key
"network_zone" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Subnet -> Region
subnetRegion Subnet
subnet
    , Key
"type" forall kv v. (KeyValue 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Network] -> ShowS
$cshowList :: [Network] -> ShowS
show :: Network -> String
$cshow :: Network -> String
showsPrec :: Int -> Network -> ShowS
$cshowsPrec :: Int -> Network -> ShowS
Show

instance FromJSON Network where
  parseJSON :: Value -> Parser Network
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Network" forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> NetworkID
-> IPv4Range
-> LabelMap
-> [LoadBalancerID]
-> Text
-> [Route]
-> [ServerID]
-> [Subnet]
-> Network
Network
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip_range"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"load_balancers"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"routes"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"servers"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> IPv4Range
newNetworkIPRange NewNetwork
nnetwork
    , Key
"labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap (NewNetwork -> [Label]
newNetworkLabels NewNetwork
nnetwork)
    , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> Text
newNetworkName NewNetwork
nnetwork
    , Key
"routes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NewNetwork -> [Route]
newNetworkRoutes NewNetwork
nnetwork
    , Key
"subnets" forall kv v. (KeyValue 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 = 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/networks/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/networks" (forall a. a -> Maybe a
Just NewNetwork
new) Token
token forall a. Maybe a
Nothing

-- | Delete a network.
deleteNetwork :: Token -> NetworkID -> IO ()
deleteNetwork :: Token -> NetworkID -> IO ()
deleteNetwork Token
token (NetworkID Int
i) =
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/networks/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/networks/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) (forall a. a -> Maybe a
Just Value
body) Token
token 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Price -> Price -> Bool
$c/= :: Price -> Price -> Bool
== :: Price -> Price -> Bool
$c== :: Price -> Price -> Bool
Eq, Int -> Price -> ShowS
[Price] -> ShowS
Price -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Price] -> ShowS
$cshowList :: [Price] -> ShowS
show :: Price -> String
$cshow :: Price -> String
showsPrec :: Int -> Price -> ShowS
$cshowsPrec :: Int -> 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' = 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 = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"PriceString" forall a b. (a -> b) -> a -> b
$ \Text
t ->
   forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Parser.errorBundlePretty) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> PriceString
PriceString) forall a b. (a -> b) -> a -> b
$
     forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Parser.runParser (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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Price" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scientific -> Scientific -> Price
Price (PriceString -> Scientific
fromPriceString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gross")
                 (PriceString -> Scientific
fromPriceString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o 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
    } deriving Int -> PriceInLocation -> ShowS
[PriceInLocation] -> ShowS
PriceInLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PriceInLocation] -> ShowS
$cshowList :: [PriceInLocation] -> ShowS
show :: PriceInLocation -> String
$cshow :: PriceInLocation -> String
showsPrec :: Int -> PriceInLocation -> ShowS
$cshowsPrec :: Int -> PriceInLocation -> ShowS
Show

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

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

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

instance FromJSON ServerStatus where
  parseJSON :: Value -> Parser ServerStatus
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"ServerStatus" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"running" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Running
    Text
"initializing" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Initializing
    Text
"starting" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Starting
    Text
"stopping" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Stopping
    Text
"off" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Off
    Text
"deleting" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Deleting
    Text
"migrating" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Migrating
    Text
"rebuilding" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
Rebuilding
    Text
"unknown" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStatus
StatusUnknown
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid server status: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerID] -> ShowS
$cshowList :: [ServerID] -> ShowS
show :: ServerID -> String
$cshow :: ServerID -> String
showsPrec :: Int -> ServerID -> ShowS
$cshowsPrec :: Int -> ServerID -> ShowS
Show, Value -> Parser [ServerID]
Value -> Parser ServerID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ServerID]
$cparseJSONList :: Value -> Parser [ServerID]
parseJSON :: Value -> Parser ServerID
$cparseJSON :: Value -> Parser ServerID
FromJSON, [ServerID] -> Encoding
[ServerID] -> Value
ServerID -> Encoding
ServerID -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ServerID] -> Encoding
$ctoEncodingList :: [ServerID] -> Encoding
toJSONList :: [ServerID] -> Value
$ctoJSONList :: [ServerID] -> Value
toEncoding :: ServerID -> Encoding
$ctoEncoding :: ServerID -> Encoding
toJSON :: ServerID -> Value
$ctoJSON :: ServerID -> Value
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show

instance FromJSON Server where
  parseJSON :: Value -> Parser Server
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Server" forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> Datacenter
-> ServerID
-> Image
-> LabelMap
-> Bool
-> Text
-> PublicNetwork
-> ServerType
-> ServerStatus
-> Server
Server
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"datacenter"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locked"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public_net"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server_type"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewServer] -> ShowS
$cshowList :: [NewServer] -> ShowS
show :: NewServer -> String
$cshow :: NewServer -> String
showsPrec :: Int -> NewServer -> ShowS
$cshowsPrec :: Int -> NewServer -> ShowS
Show

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

instance FromJSON CreatedServer where
  parseJSON :: Value -> Parser CreatedServer
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"CreatedServer" forall a b. (a -> b) -> a -> b
$ \Object
o -> Action -> [Action] -> Maybe Text -> Server -> CreatedServer
CreatedServer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"next_actions"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"root_password"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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 = 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token forall a. Maybe a
Nothing

-- | Create a new server.
createServer :: Token -> NewServer -> IO CreatedServer
createServer :: Token -> NewServer -> IO CreatedServer
createServer Token
token NewServer
nserver =
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/servers" (forall a. a -> Maybe a
Just NewServer
nserver) Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let ip :: Value
ip = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. ToJSON a => a -> Value
JSON.toJSON forall a. ToJSON a => a -> Value
JSON.toJSON forall a b. (a -> b) -> a -> b
$ forall dnsptr ip. PublicIPInfo dnsptr ip -> ip
publicIP PublicIPInfo Text (Either IPv4 IPv6)
ipinfo
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST"
        (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/change_dns_ptr") 
        (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PublicIPInfo Text (Either IPv4 IPv6)
ipinfo { publicIP :: Value
publicIP = Value
ip }) Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/poweron") Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/poweroff") Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/shutdown") Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/reboot") Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"server_type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ServerTypeID
stype
        , Key
"upgrade_disk" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
upgrade
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST"
        (ByteString
"/servers/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i) forall a. Semigroup a => a -> a -> a
<> ByteString
"/actions/change_type")
        (forall a. a -> Maybe a
Just Value
body) Token
token forall a. Maybe a
Nothing

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

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

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

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

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

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

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

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

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

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

instance FromJSON SSHKey where
  parseJSON :: Value -> Parser SSHKey
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"SSHKey" forall a b. (a -> b) -> a -> b
$ \Object
o -> ZonedTime
-> Fingerprint -> SSHKeyID -> LabelMap -> Text -> Text -> SSHKey
SSHKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FingerprintText -> Fingerprint
fingerprint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fingerprint")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  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 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/ssh_keys/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
        , Key
"public_key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
public
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"POST" ByteString
"/ssh_keys" (forall a. a -> Maybe a
Just Value
body) Token
token forall a. Maybe a
Nothing

-- | Delete an SSH key.
deleteSSHKey :: Token -> SSHKeyID -> IO ()
deleteSSHKey :: Token -> SSHKeyID -> IO ()
deleteSSHKey Token
token (SSHKeyID Int
i) =
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/ssh_keys/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/ssh_keys/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) (forall a. a -> Maybe a
Just Value
body) Token
token forall a. Maybe a
Nothing

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

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

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

instance FromJSON VolumeFormat where
  parseJSON :: Value -> Parser VolumeFormat
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"VolumeFormat" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"ext4" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeFormat
EXT4
    Text
"xfs" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeFormat
XFS
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid volume format: " 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolumeStatus -> VolumeStatus -> Bool
$c/= :: VolumeStatus -> VolumeStatus -> Bool
== :: VolumeStatus -> VolumeStatus -> Bool
$c== :: VolumeStatus -> VolumeStatus -> Bool
Eq, Int -> VolumeStatus -> ShowS
[VolumeStatus] -> ShowS
VolumeStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VolumeStatus] -> ShowS
$cshowList :: [VolumeStatus] -> ShowS
show :: VolumeStatus -> String
$cshow :: VolumeStatus -> String
showsPrec :: Int -> VolumeStatus -> ShowS
$cshowsPrec :: Int -> VolumeStatus -> ShowS
Show)

instance FromJSON VolumeStatus where
  parseJSON :: Value -> Parser VolumeStatus
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"VolumeStatus" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"creating" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeStatus
VolumeCreating
    Text
"available" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeStatus
VolumeAvailable
    Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid volume status: " 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Volume] -> ShowS
$cshowList :: [Volume] -> ShowS
show :: Volume -> String
$cshow :: Volume -> String
showsPrec :: Int -> Volume -> ShowS
$cshowsPrec :: Int -> Volume -> ShowS
Show

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

-- | 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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"format"forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) forall a b. (a -> b) -> a -> b
$ NewVolume -> Maybe VolumeFormat
newVolumeFormat NewVolume
nvolume
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Key
"labels" forall kv v. (KeyValue 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ServerID
i, Key
"automount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b ]
      in  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"location"forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) AttachToServer -> [Pair]
f forall a b. (a -> b) -> a -> b
$ NewVolume -> Either LocationID AttachToServer
newVolumeLocation NewVolume
nvolume
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NewVolume -> Text
newVolumeName NewVolume
nvolume
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Key
"size" forall kv v. (KeyValue 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatedVolume] -> ShowS
$cshowList :: [CreatedVolume] -> ShowS
show :: CreatedVolume -> String
$cshow :: CreatedVolume -> String
showsPrec :: Int -> CreatedVolume -> ShowS
$cshowsPrec :: Int -> CreatedVolume -> ShowS
Show

instance FromJSON CreatedVolume where
  parseJSON :: Value -> Parser CreatedVolume
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"CreatedVolume" forall a b. (a -> b) -> a -> b
$ \Object
o -> Action -> [Action] -> Volume -> CreatedVolume
CreatedVolume
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"next_actions"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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 = 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"GET" (ByteString
"/volumes/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token forall a. Maybe a
Nothing

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

-- | Delete a volume.
deleteVolume :: Token -> VolumeID -> IO ()
deleteVolume :: Token -> VolumeID -> IO ()
deleteVolume Token
token (VolumeID Int
i) =
  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"DELETE" (ByteString
"/volumes/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) Maybe Void
noBody Token
token 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" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  let body :: Value
body = [Pair] -> Value
JSON.object
        [ Key
"labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label] -> LabelMap
toLabelMap [Label]
labels
        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
          ]
  in  forall body a.
(ToJSON body, FromJSON a) =>
ByteString
-> ByteString -> Maybe body -> Token -> Maybe Int -> IO a
cloudQuery ByteString
"PUT" (ByteString
"/volumes/" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
i)) (forall a. a -> Maybe a
Just Value
body) Token
token forall a. Maybe a
Nothing