{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE EmptyDataDecls #-}

module Cloudy.Scaleway where

import Data.Aeson (ToJSON(..), object, (.=), FromJSON (..), withObject, Value, (.:), withText)
import Data.Map.Strict (Map)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Servant.API ((:>), Capture, ReqBody, JSON, AuthProtect, (:<|>) ((:<|>)), PostCreated, Get, QueryParam, Headers, Header, PlainText, NoContent, MimeRender (mimeRender), PatchNoContent, Accept (contentType), PostAccepted, Patch, DeleteNoContent, MimeUnrender (..))
import Servant.Client (client, ClientM)
import Servant.Client.Core (AuthenticatedRequest)
import Web.HttpApiData (ToHttpApiData (..), FromHttpApiData)
import Data.Aeson.Types (Parser)
import Data.Kind (Type)
import Data.Time (UTCTime)
import Network.HTTP.Media ((//))

data PlainTextNoUTF8

instance Accept PlainTextNoUTF8 where
  contentType :: Proxy PlainTextNoUTF8 -> MediaType
contentType Proxy PlainTextNoUTF8
_ = ByteString
"text" ByteString -> ByteString -> MediaType
// ByteString
"plain"

instance MimeRender PlainTextNoUTF8 Text where
  mimeRender :: Proxy PlainTextNoUTF8 -> Text -> ByteString
mimeRender Proxy PlainTextNoUTF8
_ = Proxy PlainText -> Text -> ByteString
forall {k} (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @PlainText)

instance MimeUnrender PlainTextNoUTF8 Text where
  mimeUnrender :: Proxy PlainTextNoUTF8 -> ByteString -> Either String Text
mimeUnrender Proxy PlainTextNoUTF8
_ = Proxy PlainText -> ByteString -> Either String Text
forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @PlainText)

newtype PerPage = PerPage { PerPage -> Int
unPerPage :: Int }
  deriving stock Int -> PerPage -> ShowS
[PerPage] -> ShowS
PerPage -> String
(Int -> PerPage -> ShowS)
-> (PerPage -> String) -> ([PerPage] -> ShowS) -> Show PerPage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerPage -> ShowS
showsPrec :: Int -> PerPage -> ShowS
$cshow :: PerPage -> String
show :: PerPage -> String
$cshowList :: [PerPage] -> ShowS
showList :: [PerPage] -> ShowS
Show
  deriving newtype (Text -> Either Text PerPage
ByteString -> Either Text PerPage
(Text -> Either Text PerPage)
-> (ByteString -> Either Text PerPage)
-> (Text -> Either Text PerPage)
-> FromHttpApiData PerPage
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text PerPage
parseUrlPiece :: Text -> Either Text PerPage
$cparseHeader :: ByteString -> Either Text PerPage
parseHeader :: ByteString -> Either Text PerPage
$cparseQueryParam :: Text -> Either Text PerPage
parseQueryParam :: Text -> Either Text PerPage
FromHttpApiData, Maybe PerPage
Value -> Parser [PerPage]
Value -> Parser PerPage
(Value -> Parser PerPage)
-> (Value -> Parser [PerPage]) -> Maybe PerPage -> FromJSON PerPage
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PerPage
parseJSON :: Value -> Parser PerPage
$cparseJSONList :: Value -> Parser [PerPage]
parseJSONList :: Value -> Parser [PerPage]
$comittedField :: Maybe PerPage
omittedField :: Maybe PerPage
FromJSON, PerPage -> Text
PerPage -> ByteString
PerPage -> Builder
(PerPage -> Text)
-> (PerPage -> Builder)
-> (PerPage -> ByteString)
-> (PerPage -> Text)
-> (PerPage -> Builder)
-> ToHttpApiData PerPage
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PerPage -> Text
toUrlPiece :: PerPage -> Text
$ctoEncodedUrlPiece :: PerPage -> Builder
toEncodedUrlPiece :: PerPage -> Builder
$ctoHeader :: PerPage -> ByteString
toHeader :: PerPage -> ByteString
$ctoQueryParam :: PerPage -> Text
toQueryParam :: PerPage -> Text
$ctoEncodedQueryParam :: PerPage -> Builder
toEncodedQueryParam :: PerPage -> Builder
ToHttpApiData, [PerPage] -> Value
[PerPage] -> Encoding
PerPage -> Bool
PerPage -> Value
PerPage -> Encoding
(PerPage -> Value)
-> (PerPage -> Encoding)
-> ([PerPage] -> Value)
-> ([PerPage] -> Encoding)
-> (PerPage -> Bool)
-> ToJSON PerPage
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PerPage -> Value
toJSON :: PerPage -> Value
$ctoEncoding :: PerPage -> Encoding
toEncoding :: PerPage -> Encoding
$ctoJSONList :: [PerPage] -> Value
toJSONList :: [PerPage] -> Value
$ctoEncodingList :: [PerPage] -> Encoding
toEncodingList :: [PerPage] -> Encoding
$comitField :: PerPage -> Bool
omitField :: PerPage -> Bool
ToJSON)

newtype PageNum = PageNum { PageNum -> Int
unPageNum :: Int }
  deriving stock Int -> PageNum -> ShowS
[PageNum] -> ShowS
PageNum -> String
(Int -> PageNum -> ShowS)
-> (PageNum -> String) -> ([PageNum] -> ShowS) -> Show PageNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageNum -> ShowS
showsPrec :: Int -> PageNum -> ShowS
$cshow :: PageNum -> String
show :: PageNum -> String
$cshowList :: [PageNum] -> ShowS
showList :: [PageNum] -> ShowS
Show
  deriving newtype (Text -> Either Text PageNum
ByteString -> Either Text PageNum
(Text -> Either Text PageNum)
-> (ByteString -> Either Text PageNum)
-> (Text -> Either Text PageNum)
-> FromHttpApiData PageNum
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text PageNum
parseUrlPiece :: Text -> Either Text PageNum
$cparseHeader :: ByteString -> Either Text PageNum
parseHeader :: ByteString -> Either Text PageNum
$cparseQueryParam :: Text -> Either Text PageNum
parseQueryParam :: Text -> Either Text PageNum
FromHttpApiData, Maybe PageNum
Value -> Parser [PageNum]
Value -> Parser PageNum
(Value -> Parser PageNum)
-> (Value -> Parser [PageNum]) -> Maybe PageNum -> FromJSON PageNum
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PageNum
parseJSON :: Value -> Parser PageNum
$cparseJSONList :: Value -> Parser [PageNum]
parseJSONList :: Value -> Parser [PageNum]
$comittedField :: Maybe PageNum
omittedField :: Maybe PageNum
FromJSON, PageNum -> Text
PageNum -> ByteString
PageNum -> Builder
(PageNum -> Text)
-> (PageNum -> Builder)
-> (PageNum -> ByteString)
-> (PageNum -> Text)
-> (PageNum -> Builder)
-> ToHttpApiData PageNum
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PageNum -> Text
toUrlPiece :: PageNum -> Text
$ctoEncodedUrlPiece :: PageNum -> Builder
toEncodedUrlPiece :: PageNum -> Builder
$ctoHeader :: PageNum -> ByteString
toHeader :: PageNum -> ByteString
$ctoQueryParam :: PageNum -> Text
toQueryParam :: PageNum -> Text
$ctoEncodedQueryParam :: PageNum -> Builder
toEncodedQueryParam :: PageNum -> Builder
ToHttpApiData, [PageNum] -> Value
[PageNum] -> Encoding
PageNum -> Bool
PageNum -> Value
PageNum -> Encoding
(PageNum -> Value)
-> (PageNum -> Encoding)
-> ([PageNum] -> Value)
-> ([PageNum] -> Encoding)
-> (PageNum -> Bool)
-> ToJSON PageNum
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PageNum -> Value
toJSON :: PageNum -> Value
$ctoEncoding :: PageNum -> Encoding
toEncoding :: PageNum -> Encoding
$ctoJSONList :: [PageNum] -> Value
toJSONList :: [PageNum] -> Value
$ctoEncodingList :: [PageNum] -> Encoding
toEncodingList :: [PageNum] -> Encoding
$comitField :: PageNum -> Bool
omitField :: PageNum -> Bool
ToJSON)

type Paged :: forall k l. (k -> l -> Type) -> k -> l -> Type
type family Paged verb ct resp where
  Paged verb ct resp =
    QueryParam "per_page" PerPage :>
    QueryParam "page" PageNum :>
    verb ct (Headers '[Header "x-total-count" Int] resp)

data Zone = NL1 | NL2 | NL3
  deriving (Zone
Zone -> Zone -> Bounded Zone
forall a. a -> a -> Bounded a
$cminBound :: Zone
minBound :: Zone
$cmaxBound :: Zone
maxBound :: Zone
Bounded, Int -> Zone
Zone -> Int
Zone -> [Zone]
Zone -> Zone
Zone -> Zone -> [Zone]
Zone -> Zone -> Zone -> [Zone]
(Zone -> Zone)
-> (Zone -> Zone)
-> (Int -> Zone)
-> (Zone -> Int)
-> (Zone -> [Zone])
-> (Zone -> Zone -> [Zone])
-> (Zone -> Zone -> [Zone])
-> (Zone -> Zone -> Zone -> [Zone])
-> Enum Zone
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Zone -> Zone
succ :: Zone -> Zone
$cpred :: Zone -> Zone
pred :: Zone -> Zone
$ctoEnum :: Int -> Zone
toEnum :: Int -> Zone
$cfromEnum :: Zone -> Int
fromEnum :: Zone -> Int
$cenumFrom :: Zone -> [Zone]
enumFrom :: Zone -> [Zone]
$cenumFromThen :: Zone -> Zone -> [Zone]
enumFromThen :: Zone -> Zone -> [Zone]
$cenumFromTo :: Zone -> Zone -> [Zone]
enumFromTo :: Zone -> Zone -> [Zone]
$cenumFromThenTo :: Zone -> Zone -> Zone -> [Zone]
enumFromThenTo :: Zone -> Zone -> Zone -> [Zone]
Enum, Zone -> Zone -> Bool
(Zone -> Zone -> Bool) -> (Zone -> Zone -> Bool) -> Eq Zone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Zone -> Zone -> Bool
== :: Zone -> Zone -> Bool
$c/= :: Zone -> Zone -> Bool
/= :: Zone -> Zone -> Bool
Eq, Int -> Zone -> ShowS
[Zone] -> ShowS
Zone -> String
(Int -> Zone -> ShowS)
-> (Zone -> String) -> ([Zone] -> ShowS) -> Show Zone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Zone -> ShowS
showsPrec :: Int -> Zone -> ShowS
$cshow :: Zone -> String
show :: Zone -> String
$cshowList :: [Zone] -> ShowS
showList :: [Zone] -> ShowS
Show)


instance ToJSON Zone where toJSON :: Zone -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Zone -> Text) -> Zone -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zone -> Text
zoneToText
instance FromJSON Zone where
  parseJSON :: Value -> Parser Zone
parseJSON = String -> (Text -> Parser Zone) -> Value -> Parser Zone
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Zone" ((Text -> Parser Zone) -> Value -> Parser Zone)
-> (Text -> Parser Zone) -> Value -> Parser Zone
forall a b. (a -> b) -> a -> b
$ Parser Zone -> (Zone -> Parser Zone) -> Maybe Zone -> Parser Zone
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Zone
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse Zone") Zone -> Parser Zone
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Zone -> Parser Zone)
-> (Text -> Maybe Zone) -> Text -> Parser Zone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Zone
zoneFromText

allScalewayZones :: [Zone]
allScalewayZones :: [Zone]
allScalewayZones = Zone -> Zone -> [Zone]
forall a. Enum a => a -> a -> [a]
enumFromTo Zone
forall a. Bounded a => a
minBound Zone
forall a. Bounded a => a
maxBound

zoneToText :: Zone -> Text
zoneToText :: Zone -> Text
zoneToText = \case
  Zone
NL1 -> Text
"nl-ams-1"
  Zone
NL2 -> Text
"nl-ams-2"
  Zone
NL3 -> Text
"nl-ams-3"

zoneFromText :: Text -> Maybe Zone
zoneFromText :: Text -> Maybe Zone
zoneFromText = \case
  Text
"nl-ams-1" -> Zone -> Maybe Zone
forall a. a -> Maybe a
Just Zone
NL1
  Text
"nl-ams-2" -> Zone -> Maybe Zone
forall a. a -> Maybe a
Just Zone
NL2
  Text
"nl-ams-3" -> Zone -> Maybe Zone
forall a. a -> Maybe a
Just Zone
NL3
  Text
_ -> Maybe Zone
forall a. Maybe a
Nothing

instance ToHttpApiData Zone where
  toUrlPiece :: Zone -> Text
  toUrlPiece :: Zone -> Text
toUrlPiece = Zone -> Text
zoneToText

newtype ImageId = ImageId { ImageId -> Text
unImageId :: Text }
  deriving stock (ImageId -> ImageId -> Bool
(ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool) -> Eq ImageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageId -> ImageId -> Bool
== :: ImageId -> ImageId -> Bool
$c/= :: ImageId -> ImageId -> Bool
/= :: ImageId -> ImageId -> Bool
Eq, Int -> ImageId -> ShowS
[ImageId] -> ShowS
ImageId -> String
(Int -> ImageId -> ShowS)
-> (ImageId -> String) -> ([ImageId] -> ShowS) -> Show ImageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageId -> ShowS
showsPrec :: Int -> ImageId -> ShowS
$cshow :: ImageId -> String
show :: ImageId -> String
$cshowList :: [ImageId] -> ShowS
showList :: [ImageId] -> ShowS
Show)
  deriving newtype (Text -> Either Text ImageId
ByteString -> Either Text ImageId
(Text -> Either Text ImageId)
-> (ByteString -> Either Text ImageId)
-> (Text -> Either Text ImageId)
-> FromHttpApiData ImageId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text ImageId
parseUrlPiece :: Text -> Either Text ImageId
$cparseHeader :: ByteString -> Either Text ImageId
parseHeader :: ByteString -> Either Text ImageId
$cparseQueryParam :: Text -> Either Text ImageId
parseQueryParam :: Text -> Either Text ImageId
FromHttpApiData, Maybe ImageId
Value -> Parser [ImageId]
Value -> Parser ImageId
(Value -> Parser ImageId)
-> (Value -> Parser [ImageId]) -> Maybe ImageId -> FromJSON ImageId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ImageId
parseJSON :: Value -> Parser ImageId
$cparseJSONList :: Value -> Parser [ImageId]
parseJSONList :: Value -> Parser [ImageId]
$comittedField :: Maybe ImageId
omittedField :: Maybe ImageId
FromJSON, ImageId -> Text
ImageId -> ByteString
ImageId -> Builder
(ImageId -> Text)
-> (ImageId -> Builder)
-> (ImageId -> ByteString)
-> (ImageId -> Text)
-> (ImageId -> Builder)
-> ToHttpApiData ImageId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: ImageId -> Text
toUrlPiece :: ImageId -> Text
$ctoEncodedUrlPiece :: ImageId -> Builder
toEncodedUrlPiece :: ImageId -> Builder
$ctoHeader :: ImageId -> ByteString
toHeader :: ImageId -> ByteString
$ctoQueryParam :: ImageId -> Text
toQueryParam :: ImageId -> Text
$ctoEncodedQueryParam :: ImageId -> Builder
toEncodedQueryParam :: ImageId -> Builder
ToHttpApiData, [ImageId] -> Value
[ImageId] -> Encoding
ImageId -> Bool
ImageId -> Value
ImageId -> Encoding
(ImageId -> Value)
-> (ImageId -> Encoding)
-> ([ImageId] -> Value)
-> ([ImageId] -> Encoding)
-> (ImageId -> Bool)
-> ToJSON ImageId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ImageId -> Value
toJSON :: ImageId -> Value
$ctoEncoding :: ImageId -> Encoding
toEncoding :: ImageId -> Encoding
$ctoJSONList :: [ImageId] -> Value
toJSONList :: [ImageId] -> Value
$ctoEncodingList :: [ImageId] -> Encoding
toEncodingList :: [ImageId] -> Encoding
$comitField :: ImageId -> Bool
omitField :: ImageId -> Bool
ToJSON)

newtype IpId = IpId { IpId -> Text
unIpId :: Text }
  deriving stock (IpId -> IpId -> Bool
(IpId -> IpId -> Bool) -> (IpId -> IpId -> Bool) -> Eq IpId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IpId -> IpId -> Bool
== :: IpId -> IpId -> Bool
$c/= :: IpId -> IpId -> Bool
/= :: IpId -> IpId -> Bool
Eq, Int -> IpId -> ShowS
[IpId] -> ShowS
IpId -> String
(Int -> IpId -> ShowS)
-> (IpId -> String) -> ([IpId] -> ShowS) -> Show IpId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IpId -> ShowS
showsPrec :: Int -> IpId -> ShowS
$cshow :: IpId -> String
show :: IpId -> String
$cshowList :: [IpId] -> ShowS
showList :: [IpId] -> ShowS
Show)
  deriving newtype (Text -> Either Text IpId
ByteString -> Either Text IpId
(Text -> Either Text IpId)
-> (ByteString -> Either Text IpId)
-> (Text -> Either Text IpId)
-> FromHttpApiData IpId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text IpId
parseUrlPiece :: Text -> Either Text IpId
$cparseHeader :: ByteString -> Either Text IpId
parseHeader :: ByteString -> Either Text IpId
$cparseQueryParam :: Text -> Either Text IpId
parseQueryParam :: Text -> Either Text IpId
FromHttpApiData, Maybe IpId
Value -> Parser [IpId]
Value -> Parser IpId
(Value -> Parser IpId)
-> (Value -> Parser [IpId]) -> Maybe IpId -> FromJSON IpId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser IpId
parseJSON :: Value -> Parser IpId
$cparseJSONList :: Value -> Parser [IpId]
parseJSONList :: Value -> Parser [IpId]
$comittedField :: Maybe IpId
omittedField :: Maybe IpId
FromJSON, IpId -> Text
IpId -> ByteString
IpId -> Builder
(IpId -> Text)
-> (IpId -> Builder)
-> (IpId -> ByteString)
-> (IpId -> Text)
-> (IpId -> Builder)
-> ToHttpApiData IpId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: IpId -> Text
toUrlPiece :: IpId -> Text
$ctoEncodedUrlPiece :: IpId -> Builder
toEncodedUrlPiece :: IpId -> Builder
$ctoHeader :: IpId -> ByteString
toHeader :: IpId -> ByteString
$ctoQueryParam :: IpId -> Text
toQueryParam :: IpId -> Text
$ctoEncodedQueryParam :: IpId -> Builder
toEncodedQueryParam :: IpId -> Builder
ToHttpApiData, [IpId] -> Value
[IpId] -> Encoding
IpId -> Bool
IpId -> Value
IpId -> Encoding
(IpId -> Value)
-> (IpId -> Encoding)
-> ([IpId] -> Value)
-> ([IpId] -> Encoding)
-> (IpId -> Bool)
-> ToJSON IpId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: IpId -> Value
toJSON :: IpId -> Value
$ctoEncoding :: IpId -> Encoding
toEncoding :: IpId -> Encoding
$ctoJSONList :: [IpId] -> Value
toJSONList :: [IpId] -> Value
$ctoEncodingList :: [IpId] -> Encoding
toEncodingList :: [IpId] -> Encoding
$comitField :: IpId -> Bool
omitField :: IpId -> Bool
ToJSON)

newtype OrganizationId = OrganizationId { OrganizationId -> Text
unOrganizationId :: Text }
  deriving stock (OrganizationId -> OrganizationId -> Bool
(OrganizationId -> OrganizationId -> Bool)
-> (OrganizationId -> OrganizationId -> Bool) -> Eq OrganizationId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrganizationId -> OrganizationId -> Bool
== :: OrganizationId -> OrganizationId -> Bool
$c/= :: OrganizationId -> OrganizationId -> Bool
/= :: OrganizationId -> OrganizationId -> Bool
Eq, Int -> OrganizationId -> ShowS
[OrganizationId] -> ShowS
OrganizationId -> String
(Int -> OrganizationId -> ShowS)
-> (OrganizationId -> String)
-> ([OrganizationId] -> ShowS)
-> Show OrganizationId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrganizationId -> ShowS
showsPrec :: Int -> OrganizationId -> ShowS
$cshow :: OrganizationId -> String
show :: OrganizationId -> String
$cshowList :: [OrganizationId] -> ShowS
showList :: [OrganizationId] -> ShowS
Show)
  deriving newtype (Text -> Either Text OrganizationId
ByteString -> Either Text OrganizationId
(Text -> Either Text OrganizationId)
-> (ByteString -> Either Text OrganizationId)
-> (Text -> Either Text OrganizationId)
-> FromHttpApiData OrganizationId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text OrganizationId
parseUrlPiece :: Text -> Either Text OrganizationId
$cparseHeader :: ByteString -> Either Text OrganizationId
parseHeader :: ByteString -> Either Text OrganizationId
$cparseQueryParam :: Text -> Either Text OrganizationId
parseQueryParam :: Text -> Either Text OrganizationId
FromHttpApiData, Maybe OrganizationId
Value -> Parser [OrganizationId]
Value -> Parser OrganizationId
(Value -> Parser OrganizationId)
-> (Value -> Parser [OrganizationId])
-> Maybe OrganizationId
-> FromJSON OrganizationId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser OrganizationId
parseJSON :: Value -> Parser OrganizationId
$cparseJSONList :: Value -> Parser [OrganizationId]
parseJSONList :: Value -> Parser [OrganizationId]
$comittedField :: Maybe OrganizationId
omittedField :: Maybe OrganizationId
FromJSON, OrganizationId -> Text
OrganizationId -> ByteString
OrganizationId -> Builder
(OrganizationId -> Text)
-> (OrganizationId -> Builder)
-> (OrganizationId -> ByteString)
-> (OrganizationId -> Text)
-> (OrganizationId -> Builder)
-> ToHttpApiData OrganizationId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: OrganizationId -> Text
toUrlPiece :: OrganizationId -> Text
$ctoEncodedUrlPiece :: OrganizationId -> Builder
toEncodedUrlPiece :: OrganizationId -> Builder
$ctoHeader :: OrganizationId -> ByteString
toHeader :: OrganizationId -> ByteString
$ctoQueryParam :: OrganizationId -> Text
toQueryParam :: OrganizationId -> Text
$ctoEncodedQueryParam :: OrganizationId -> Builder
toEncodedQueryParam :: OrganizationId -> Builder
ToHttpApiData, [OrganizationId] -> Value
[OrganizationId] -> Encoding
OrganizationId -> Bool
OrganizationId -> Value
OrganizationId -> Encoding
(OrganizationId -> Value)
-> (OrganizationId -> Encoding)
-> ([OrganizationId] -> Value)
-> ([OrganizationId] -> Encoding)
-> (OrganizationId -> Bool)
-> ToJSON OrganizationId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: OrganizationId -> Value
toJSON :: OrganizationId -> Value
$ctoEncoding :: OrganizationId -> Encoding
toEncoding :: OrganizationId -> Encoding
$ctoJSONList :: [OrganizationId] -> Value
toJSONList :: [OrganizationId] -> Value
$ctoEncodingList :: [OrganizationId] -> Encoding
toEncodingList :: [OrganizationId] -> Encoding
$comitField :: OrganizationId -> Bool
omitField :: OrganizationId -> Bool
ToJSON)

newtype ProjectId = ProjectId { ProjectId -> Text
unProjectId :: Text }
  deriving stock (ProjectId -> ProjectId -> Bool
(ProjectId -> ProjectId -> Bool)
-> (ProjectId -> ProjectId -> Bool) -> Eq ProjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectId -> ProjectId -> Bool
== :: ProjectId -> ProjectId -> Bool
$c/= :: ProjectId -> ProjectId -> Bool
/= :: ProjectId -> ProjectId -> Bool
Eq, Int -> ProjectId -> ShowS
[ProjectId] -> ShowS
ProjectId -> String
(Int -> ProjectId -> ShowS)
-> (ProjectId -> String)
-> ([ProjectId] -> ShowS)
-> Show ProjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectId -> ShowS
showsPrec :: Int -> ProjectId -> ShowS
$cshow :: ProjectId -> String
show :: ProjectId -> String
$cshowList :: [ProjectId] -> ShowS
showList :: [ProjectId] -> ShowS
Show)
  deriving newtype (Text -> Either Text ProjectId
ByteString -> Either Text ProjectId
(Text -> Either Text ProjectId)
-> (ByteString -> Either Text ProjectId)
-> (Text -> Either Text ProjectId)
-> FromHttpApiData ProjectId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text ProjectId
parseUrlPiece :: Text -> Either Text ProjectId
$cparseHeader :: ByteString -> Either Text ProjectId
parseHeader :: ByteString -> Either Text ProjectId
$cparseQueryParam :: Text -> Either Text ProjectId
parseQueryParam :: Text -> Either Text ProjectId
FromHttpApiData, Maybe ProjectId
Value -> Parser [ProjectId]
Value -> Parser ProjectId
(Value -> Parser ProjectId)
-> (Value -> Parser [ProjectId])
-> Maybe ProjectId
-> FromJSON ProjectId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ProjectId
parseJSON :: Value -> Parser ProjectId
$cparseJSONList :: Value -> Parser [ProjectId]
parseJSONList :: Value -> Parser [ProjectId]
$comittedField :: Maybe ProjectId
omittedField :: Maybe ProjectId
FromJSON, ProjectId -> Text
ProjectId -> ByteString
ProjectId -> Builder
(ProjectId -> Text)
-> (ProjectId -> Builder)
-> (ProjectId -> ByteString)
-> (ProjectId -> Text)
-> (ProjectId -> Builder)
-> ToHttpApiData ProjectId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: ProjectId -> Text
toUrlPiece :: ProjectId -> Text
$ctoEncodedUrlPiece :: ProjectId -> Builder
toEncodedUrlPiece :: ProjectId -> Builder
$ctoHeader :: ProjectId -> ByteString
toHeader :: ProjectId -> ByteString
$ctoQueryParam :: ProjectId -> Text
toQueryParam :: ProjectId -> Text
$ctoEncodedQueryParam :: ProjectId -> Builder
toEncodedQueryParam :: ProjectId -> Builder
ToHttpApiData, [ProjectId] -> Value
[ProjectId] -> Encoding
ProjectId -> Bool
ProjectId -> Value
ProjectId -> Encoding
(ProjectId -> Value)
-> (ProjectId -> Encoding)
-> ([ProjectId] -> Value)
-> ([ProjectId] -> Encoding)
-> (ProjectId -> Bool)
-> ToJSON ProjectId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ProjectId -> Value
toJSON :: ProjectId -> Value
$ctoEncoding :: ProjectId -> Encoding
toEncoding :: ProjectId -> Encoding
$ctoJSONList :: [ProjectId] -> Value
toJSONList :: [ProjectId] -> Value
$ctoEncodingList :: [ProjectId] -> Encoding
toEncodingList :: [ProjectId] -> Encoding
$comitField :: ProjectId -> Bool
omitField :: ProjectId -> Bool
ToJSON)

newtype ServerId = ServerId { ServerId -> Text
unServerId :: Text }
  deriving stock (ServerId -> ServerId -> Bool
(ServerId -> ServerId -> Bool)
-> (ServerId -> ServerId -> Bool) -> Eq ServerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerId -> ServerId -> Bool
== :: ServerId -> ServerId -> Bool
$c/= :: ServerId -> ServerId -> Bool
/= :: ServerId -> ServerId -> Bool
Eq, Int -> ServerId -> ShowS
[ServerId] -> ShowS
ServerId -> String
(Int -> ServerId -> ShowS)
-> (ServerId -> String) -> ([ServerId] -> ShowS) -> Show ServerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerId -> ShowS
showsPrec :: Int -> ServerId -> ShowS
$cshow :: ServerId -> String
show :: ServerId -> String
$cshowList :: [ServerId] -> ShowS
showList :: [ServerId] -> ShowS
Show)
  deriving newtype (Text -> Either Text ServerId
ByteString -> Either Text ServerId
(Text -> Either Text ServerId)
-> (ByteString -> Either Text ServerId)
-> (Text -> Either Text ServerId)
-> FromHttpApiData ServerId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text ServerId
parseUrlPiece :: Text -> Either Text ServerId
$cparseHeader :: ByteString -> Either Text ServerId
parseHeader :: ByteString -> Either Text ServerId
$cparseQueryParam :: Text -> Either Text ServerId
parseQueryParam :: Text -> Either Text ServerId
FromHttpApiData, Maybe ServerId
Value -> Parser [ServerId]
Value -> Parser ServerId
(Value -> Parser ServerId)
-> (Value -> Parser [ServerId])
-> Maybe ServerId
-> FromJSON ServerId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ServerId
parseJSON :: Value -> Parser ServerId
$cparseJSONList :: Value -> Parser [ServerId]
parseJSONList :: Value -> Parser [ServerId]
$comittedField :: Maybe ServerId
omittedField :: Maybe ServerId
FromJSON, ServerId -> Text
ServerId -> ByteString
ServerId -> Builder
(ServerId -> Text)
-> (ServerId -> Builder)
-> (ServerId -> ByteString)
-> (ServerId -> Text)
-> (ServerId -> Builder)
-> ToHttpApiData ServerId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: ServerId -> Text
toUrlPiece :: ServerId -> Text
$ctoEncodedUrlPiece :: ServerId -> Builder
toEncodedUrlPiece :: ServerId -> Builder
$ctoHeader :: ServerId -> ByteString
toHeader :: ServerId -> ByteString
$ctoQueryParam :: ServerId -> Text
toQueryParam :: ServerId -> Text
$ctoEncodedQueryParam :: ServerId -> Builder
toEncodedQueryParam :: ServerId -> Builder
ToHttpApiData, [ServerId] -> Value
[ServerId] -> Encoding
ServerId -> Bool
ServerId -> Value
ServerId -> Encoding
(ServerId -> Value)
-> (ServerId -> Encoding)
-> ([ServerId] -> Value)
-> ([ServerId] -> Encoding)
-> (ServerId -> Bool)
-> ToJSON ServerId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ServerId -> Value
toJSON :: ServerId -> Value
$ctoEncoding :: ServerId -> Encoding
toEncoding :: ServerId -> Encoding
$ctoJSONList :: [ServerId] -> Value
toJSONList :: [ServerId] -> Value
$ctoEncodingList :: [ServerId] -> Encoding
toEncodingList :: [ServerId] -> Encoding
$comitField :: ServerId -> Bool
omitField :: ServerId -> Bool
ToJSON)

newtype VolumeId = VolumeId { VolumeId -> Text
unVolumeId :: Text }
  deriving stock (VolumeId -> VolumeId -> Bool
(VolumeId -> VolumeId -> Bool)
-> (VolumeId -> VolumeId -> Bool) -> Eq VolumeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VolumeId -> VolumeId -> Bool
== :: VolumeId -> VolumeId -> Bool
$c/= :: VolumeId -> VolumeId -> Bool
/= :: VolumeId -> VolumeId -> Bool
Eq, Int -> VolumeId -> ShowS
[VolumeId] -> ShowS
VolumeId -> String
(Int -> VolumeId -> ShowS)
-> (VolumeId -> String) -> ([VolumeId] -> ShowS) -> Show VolumeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VolumeId -> ShowS
showsPrec :: Int -> VolumeId -> ShowS
$cshow :: VolumeId -> String
show :: VolumeId -> String
$cshowList :: [VolumeId] -> ShowS
showList :: [VolumeId] -> ShowS
Show)
  deriving newtype (Text -> Either Text VolumeId
ByteString -> Either Text VolumeId
(Text -> Either Text VolumeId)
-> (ByteString -> Either Text VolumeId)
-> (Text -> Either Text VolumeId)
-> FromHttpApiData VolumeId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text VolumeId
parseUrlPiece :: Text -> Either Text VolumeId
$cparseHeader :: ByteString -> Either Text VolumeId
parseHeader :: ByteString -> Either Text VolumeId
$cparseQueryParam :: Text -> Either Text VolumeId
parseQueryParam :: Text -> Either Text VolumeId
FromHttpApiData, Maybe VolumeId
Value -> Parser [VolumeId]
Value -> Parser VolumeId
(Value -> Parser VolumeId)
-> (Value -> Parser [VolumeId])
-> Maybe VolumeId
-> FromJSON VolumeId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VolumeId
parseJSON :: Value -> Parser VolumeId
$cparseJSONList :: Value -> Parser [VolumeId]
parseJSONList :: Value -> Parser [VolumeId]
$comittedField :: Maybe VolumeId
omittedField :: Maybe VolumeId
FromJSON, VolumeId -> Text
VolumeId -> ByteString
VolumeId -> Builder
(VolumeId -> Text)
-> (VolumeId -> Builder)
-> (VolumeId -> ByteString)
-> (VolumeId -> Text)
-> (VolumeId -> Builder)
-> ToHttpApiData VolumeId
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: VolumeId -> Text
toUrlPiece :: VolumeId -> Text
$ctoEncodedUrlPiece :: VolumeId -> Builder
toEncodedUrlPiece :: VolumeId -> Builder
$ctoHeader :: VolumeId -> ByteString
toHeader :: VolumeId -> ByteString
$ctoQueryParam :: VolumeId -> Text
toQueryParam :: VolumeId -> Text
$ctoEncodedQueryParam :: VolumeId -> Builder
toEncodedQueryParam :: VolumeId -> Builder
ToHttpApiData, [VolumeId] -> Value
[VolumeId] -> Encoding
VolumeId -> Bool
VolumeId -> Value
VolumeId -> Encoding
(VolumeId -> Value)
-> (VolumeId -> Encoding)
-> ([VolumeId] -> Value)
-> ([VolumeId] -> Encoding)
-> (VolumeId -> Bool)
-> ToJSON VolumeId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VolumeId -> Value
toJSON :: VolumeId -> Value
$ctoEncoding :: VolumeId -> Encoding
toEncoding :: VolumeId -> Encoding
$ctoJSONList :: [VolumeId] -> Value
toJSONList :: [VolumeId] -> Value
$ctoEncodingList :: [VolumeId] -> Encoding
toEncodingList :: [VolumeId] -> Encoding
$comitField :: VolumeId -> Bool
omitField :: VolumeId -> Bool
ToJSON)

newtype UserDataKey = UserDataKey { UserDataKey -> Text
unUserDataKey :: Text }
  deriving stock (UserDataKey -> UserDataKey -> Bool
(UserDataKey -> UserDataKey -> Bool)
-> (UserDataKey -> UserDataKey -> Bool) -> Eq UserDataKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserDataKey -> UserDataKey -> Bool
== :: UserDataKey -> UserDataKey -> Bool
$c/= :: UserDataKey -> UserDataKey -> Bool
/= :: UserDataKey -> UserDataKey -> Bool
Eq, Int -> UserDataKey -> ShowS
[UserDataKey] -> ShowS
UserDataKey -> String
(Int -> UserDataKey -> ShowS)
-> (UserDataKey -> String)
-> ([UserDataKey] -> ShowS)
-> Show UserDataKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserDataKey -> ShowS
showsPrec :: Int -> UserDataKey -> ShowS
$cshow :: UserDataKey -> String
show :: UserDataKey -> String
$cshowList :: [UserDataKey] -> ShowS
showList :: [UserDataKey] -> ShowS
Show)
  deriving newtype (Text -> Either Text UserDataKey
ByteString -> Either Text UserDataKey
(Text -> Either Text UserDataKey)
-> (ByteString -> Either Text UserDataKey)
-> (Text -> Either Text UserDataKey)
-> FromHttpApiData UserDataKey
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text UserDataKey
parseUrlPiece :: Text -> Either Text UserDataKey
$cparseHeader :: ByteString -> Either Text UserDataKey
parseHeader :: ByteString -> Either Text UserDataKey
$cparseQueryParam :: Text -> Either Text UserDataKey
parseQueryParam :: Text -> Either Text UserDataKey
FromHttpApiData, Maybe UserDataKey
Value -> Parser [UserDataKey]
Value -> Parser UserDataKey
(Value -> Parser UserDataKey)
-> (Value -> Parser [UserDataKey])
-> Maybe UserDataKey
-> FromJSON UserDataKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UserDataKey
parseJSON :: Value -> Parser UserDataKey
$cparseJSONList :: Value -> Parser [UserDataKey]
parseJSONList :: Value -> Parser [UserDataKey]
$comittedField :: Maybe UserDataKey
omittedField :: Maybe UserDataKey
FromJSON, UserDataKey -> Text
UserDataKey -> ByteString
UserDataKey -> Builder
(UserDataKey -> Text)
-> (UserDataKey -> Builder)
-> (UserDataKey -> ByteString)
-> (UserDataKey -> Text)
-> (UserDataKey -> Builder)
-> ToHttpApiData UserDataKey
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: UserDataKey -> Text
toUrlPiece :: UserDataKey -> Text
$ctoEncodedUrlPiece :: UserDataKey -> Builder
toEncodedUrlPiece :: UserDataKey -> Builder
$ctoHeader :: UserDataKey -> ByteString
toHeader :: UserDataKey -> ByteString
$ctoQueryParam :: UserDataKey -> Text
toQueryParam :: UserDataKey -> Text
$ctoEncodedQueryParam :: UserDataKey -> Builder
toEncodedQueryParam :: UserDataKey -> Builder
ToHttpApiData, [UserDataKey] -> Value
[UserDataKey] -> Encoding
UserDataKey -> Bool
UserDataKey -> Value
UserDataKey -> Encoding
(UserDataKey -> Value)
-> (UserDataKey -> Encoding)
-> ([UserDataKey] -> Value)
-> ([UserDataKey] -> Encoding)
-> (UserDataKey -> Bool)
-> ToJSON UserDataKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UserDataKey -> Value
toJSON :: UserDataKey -> Value
$ctoEncoding :: UserDataKey -> Encoding
toEncoding :: UserDataKey -> Encoding
$ctoJSONList :: [UserDataKey] -> Value
toJSONList :: [UserDataKey] -> Value
$ctoEncodingList :: [UserDataKey] -> Encoding
toEncodingList :: [UserDataKey] -> Encoding
$comitField :: UserDataKey -> Bool
omitField :: UserDataKey -> Bool
ToJSON)

newtype UserData = UserData { UserData -> Text
unUserData :: Text }
  deriving stock (UserData -> UserData -> Bool
(UserData -> UserData -> Bool)
-> (UserData -> UserData -> Bool) -> Eq UserData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserData -> UserData -> Bool
== :: UserData -> UserData -> Bool
$c/= :: UserData -> UserData -> Bool
/= :: UserData -> UserData -> Bool
Eq, Int -> UserData -> ShowS
[UserData] -> ShowS
UserData -> String
(Int -> UserData -> ShowS)
-> (UserData -> String) -> ([UserData] -> ShowS) -> Show UserData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserData -> ShowS
showsPrec :: Int -> UserData -> ShowS
$cshow :: UserData -> String
show :: UserData -> String
$cshowList :: [UserData] -> ShowS
showList :: [UserData] -> ShowS
Show)
  deriving newtype (MimeRender PlainTextNoUTF8, MimeUnrender PlainTextNoUTF8)

data ServersReqVolume = ServersReqVolume
  { {- name :: Text
  , -} ServersReqVolume -> Int
size :: Int
  , ServersReqVolume -> Text
volumeType :: Text
  }
  deriving stock Int -> ServersReqVolume -> ShowS
[ServersReqVolume] -> ShowS
ServersReqVolume -> String
(Int -> ServersReqVolume -> ShowS)
-> (ServersReqVolume -> String)
-> ([ServersReqVolume] -> ShowS)
-> Show ServersReqVolume
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServersReqVolume -> ShowS
showsPrec :: Int -> ServersReqVolume -> ShowS
$cshow :: ServersReqVolume -> String
show :: ServersReqVolume -> String
$cshowList :: [ServersReqVolume] -> ShowS
showList :: [ServersReqVolume] -> ShowS
Show

instance ToJSON ServersReqVolume where
  toJSON :: ServersReqVolume -> Value
toJSON ServersReqVolume
volume =
    [Pair] -> Value
object
      [ {- "name" .= volume.name
      , -} Key
"size" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReqVolume
volume.size
      , Key
"volume_type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReqVolume
volume.volumeType
      ]

data ServersRespVolume = ServersRespVolume
  { ServersRespVolume -> VolumeId
id :: VolumeId
  , ServersRespVolume -> Text
name :: Text
  , ServersRespVolume -> Int
size :: Int
  , ServersRespVolume -> Text
volumeType :: Text
  }
  deriving stock Int -> ServersRespVolume -> ShowS
[ServersRespVolume] -> ShowS
ServersRespVolume -> String
(Int -> ServersRespVolume -> ShowS)
-> (ServersRespVolume -> String)
-> ([ServersRespVolume] -> ShowS)
-> Show ServersRespVolume
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServersRespVolume -> ShowS
showsPrec :: Int -> ServersRespVolume -> ShowS
$cshow :: ServersRespVolume -> String
show :: ServersRespVolume -> String
$cshowList :: [ServersRespVolume] -> ShowS
showList :: [ServersRespVolume] -> ShowS
Show

instance FromJSON ServersRespVolume where
  parseJSON :: Value -> Parser ServersRespVolume
  parseJSON :: Value -> Parser ServersRespVolume
parseJSON = String
-> (Object -> Parser ServersRespVolume)
-> Value
-> Parser ServersRespVolume
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ServersRespVolume" ((Object -> Parser ServersRespVolume)
 -> Value -> Parser ServersRespVolume)
-> (Object -> Parser ServersRespVolume)
-> Value
-> Parser ServersRespVolume
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    VolumeId
id_ <- Object
o Object -> Key -> Parser VolumeId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
name <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Int
size <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
    Text
volumeType <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"volume_type"
    ServersRespVolume -> Parser ServersRespVolume
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServersRespVolume { $sel:id:ServersRespVolume :: VolumeId
id = VolumeId
id_, Text
$sel:name:ServersRespVolume :: Text
name :: Text
name, Int
$sel:size:ServersRespVolume :: Int
size :: Int
size, Text
$sel:volumeType:ServersRespVolume :: Text
volumeType :: Text
volumeType }

data IpsReq = IpsReq
  { IpsReq -> Text
type_ :: Text
  , IpsReq -> ProjectId
project :: ProjectId
  }
  deriving stock Int -> IpsReq -> ShowS
[IpsReq] -> ShowS
IpsReq -> String
(Int -> IpsReq -> ShowS)
-> (IpsReq -> String) -> ([IpsReq] -> ShowS) -> Show IpsReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IpsReq -> ShowS
showsPrec :: Int -> IpsReq -> ShowS
$cshow :: IpsReq -> String
show :: IpsReq -> String
$cshowList :: [IpsReq] -> ShowS
showList :: [IpsReq] -> ShowS
Show

instance ToJSON IpsReq where
  toJSON :: IpsReq -> Value
toJSON IpsReq
ipsReq =
    [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IpsReq
ipsReq.type_
      , Key
"project" Key -> ProjectId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IpsReq
ipsReq.project
      ]

data IpsResp = IpsResp
  { IpsResp -> IpId
id :: IpId
  , IpsResp -> Text
address :: Text
  , IpsResp -> OrganizationId
organization :: OrganizationId
  , IpsResp -> ProjectId
project :: ProjectId
  , IpsResp -> Zone
zone :: Zone
  }
  deriving stock Int -> IpsResp -> ShowS
[IpsResp] -> ShowS
IpsResp -> String
(Int -> IpsResp -> ShowS)
-> (IpsResp -> String) -> ([IpsResp] -> ShowS) -> Show IpsResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IpsResp -> ShowS
showsPrec :: Int -> IpsResp -> ShowS
$cshow :: IpsResp -> String
show :: IpsResp -> String
$cshowList :: [IpsResp] -> ShowS
showList :: [IpsResp] -> ShowS
Show

instance FromJSON IpsResp where
  parseJSON :: Value -> Parser IpsResp
  parseJSON :: Value -> Parser IpsResp
parseJSON = String -> (Object -> Parser IpsResp) -> Value -> Parser IpsResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IpsResp outer wrapper" ((Object -> Parser IpsResp) -> Value -> Parser IpsResp)
-> (Object -> Parser IpsResp) -> Value -> Parser IpsResp
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
innerObj <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip"
    IpId
id_ <- Object
innerObj Object -> Key -> Parser IpId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
address <- Object
innerObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
    OrganizationId
organization <- Object
innerObj Object -> Key -> Parser OrganizationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"organization"
    ProjectId
project <- Object
innerObj Object -> Key -> Parser ProjectId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"
    Zone
zone <- Object
innerObj Object -> Key -> Parser Zone
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"zone"
    IpsResp -> Parser IpsResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IpsResp { $sel:id:IpsResp :: IpId
id = IpId
id_, Text
$sel:address:IpsResp :: Text
address :: Text
address, OrganizationId
$sel:organization:IpsResp :: OrganizationId
organization :: OrganizationId
organization, ProjectId
$sel:project:IpsResp :: ProjectId
project :: ProjectId
project, Zone
$sel:zone:IpsResp :: Zone
zone :: Zone
zone }

data ServersReq = ServersReq
  { ServersReq -> Text
bootType :: Text
  , ServersReq -> Text
commercialType :: Text
  , ServersReq -> ImageId
image :: ImageId
  , ServersReq -> Text
name :: Text
  , ServersReq -> [IpId]
publicIps :: [IpId]
  , ServersReq -> [Text]
tags :: [Text]
  , ServersReq -> Map Text ServersReqVolume
volumes :: Map Text ServersReqVolume
  , ServersReq -> ProjectId
project :: ProjectId
  }
  deriving stock Int -> ServersReq -> ShowS
[ServersReq] -> ShowS
ServersReq -> String
(Int -> ServersReq -> ShowS)
-> (ServersReq -> String)
-> ([ServersReq] -> ShowS)
-> Show ServersReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServersReq -> ShowS
showsPrec :: Int -> ServersReq -> ShowS
$cshow :: ServersReq -> String
show :: ServersReq -> String
$cshowList :: [ServersReq] -> ShowS
showList :: [ServersReq] -> ShowS
Show

instance ToJSON ServersReq where
  toJSON :: ServersReq -> Value
toJSON ServersReq
serversReq =
    [Pair] -> Value
object
      [ Key
"boot_type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.bootType
      , Key
"commercial_type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.commercialType
      , Key
"image" Key -> ImageId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.image
      , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.name
      , Key
"public_ips" Key -> [IpId] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.publicIps
      , Key
"tags" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.tags
      , Key
"volumes" Key -> Map Text ServersReqVolume -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.volumes
      , Key
"project" Key -> ProjectId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersReq
serversReq.project
      ]

data ServersResp = ServersResp
  { ServersResp -> ServerId
id :: ServerId
  , ServersResp -> Text
name :: Text
  , ServersResp -> Map Text ServersRespVolume
volumes :: Map Text ServersRespVolume
  , ServersResp -> Text
state :: Text
  }
  deriving stock Int -> ServersResp -> ShowS
[ServersResp] -> ShowS
ServersResp -> String
(Int -> ServersResp -> ShowS)
-> (ServersResp -> String)
-> ([ServersResp] -> ShowS)
-> Show ServersResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServersResp -> ShowS
showsPrec :: Int -> ServersResp -> ShowS
$cshow :: ServersResp -> String
show :: ServersResp -> String
$cshowList :: [ServersResp] -> ShowS
showList :: [ServersResp] -> ShowS
Show

instance FromJSON ServersResp where
  parseJSON :: Value -> Parser ServersResp
  parseJSON :: Value -> Parser ServersResp
parseJSON = String
-> (Object -> Parser ServersResp) -> Value -> Parser ServersResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ServersResp outer wrapper" ((Object -> Parser ServersResp) -> Value -> Parser ServersResp)
-> (Object -> Parser ServersResp) -> Value -> Parser ServersResp
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
innerObj <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server"
    ServerId
id_ <- Object
innerObj Object -> Key -> Parser ServerId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
name <- Object
innerObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Map Text ServersRespVolume
volumes <- Object
innerObj Object -> Key -> Parser (Map Text ServersRespVolume)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"volumes"
    Text
state <- Object
innerObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
    ServersResp -> Parser ServersResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServersResp { $sel:id:ServersResp :: ServerId
id = ServerId
id_, Text
$sel:name:ServersResp :: Text
name :: Text
name, Map Text ServersRespVolume
$sel:volumes:ServersResp :: Map Text ServersRespVolume
volumes :: Map Text ServersRespVolume
volumes, Text
$sel:state:ServersResp :: Text
state :: Text
state }

data ServersActionReq = ServersActionReq
  { ServersActionReq -> Text
action :: Text
  }
  deriving stock Int -> ServersActionReq -> ShowS
[ServersActionReq] -> ShowS
ServersActionReq -> String
(Int -> ServersActionReq -> ShowS)
-> (ServersActionReq -> String)
-> ([ServersActionReq] -> ShowS)
-> Show ServersActionReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServersActionReq -> ShowS
showsPrec :: Int -> ServersActionReq -> ShowS
$cshow :: ServersActionReq -> String
show :: ServersActionReq -> String
$cshowList :: [ServersActionReq] -> ShowS
showList :: [ServersActionReq] -> ShowS
Show

instance ToJSON ServersActionReq where
  toJSON :: ServersActionReq -> Value
toJSON ServersActionReq
serversActionReq =
    [Pair] -> Value
object
      [ Key
"action" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ServersActionReq
serversActionReq.action
      ]

data VolumesReq = VolumesReq
  { VolumesReq -> Text
name :: Text
  }
  deriving stock Int -> VolumesReq -> ShowS
[VolumesReq] -> ShowS
VolumesReq -> String
(Int -> VolumesReq -> ShowS)
-> (VolumesReq -> String)
-> ([VolumesReq] -> ShowS)
-> Show VolumesReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VolumesReq -> ShowS
showsPrec :: Int -> VolumesReq -> ShowS
$cshow :: VolumesReq -> String
show :: VolumesReq -> String
$cshowList :: [VolumesReq] -> ShowS
showList :: [VolumesReq] -> ShowS
Show

instance ToJSON VolumesReq where
  toJSON :: VolumesReq -> Value
toJSON VolumesReq
volumesReq =
    [Pair] -> Value
object
      [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VolumesReq
volumesReq.name
      ]

data TaskResp = TaskResp
  { TaskResp -> Text
id :: Text
  , TaskResp -> Text
description :: Text
  , TaskResp -> Text
status :: Text
  }
  deriving stock Int -> TaskResp -> ShowS
[TaskResp] -> ShowS
TaskResp -> String
(Int -> TaskResp -> ShowS)
-> (TaskResp -> String) -> ([TaskResp] -> ShowS) -> Show TaskResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskResp -> ShowS
showsPrec :: Int -> TaskResp -> ShowS
$cshow :: TaskResp -> String
show :: TaskResp -> String
$cshowList :: [TaskResp] -> ShowS
showList :: [TaskResp] -> ShowS
Show

instance FromJSON TaskResp where
  parseJSON :: Value -> Parser TaskResp
  parseJSON :: Value -> Parser TaskResp
parseJSON = String -> (Object -> Parser TaskResp) -> Value -> Parser TaskResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TaskResp outer wrapper" ((Object -> Parser TaskResp) -> Value -> Parser TaskResp)
-> (Object -> Parser TaskResp) -> Value -> Parser TaskResp
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
innerObj <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task"
    Text
id_ <- Object
innerObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
description <- Object
innerObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Text
status <- Object
innerObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
    TaskResp -> Parser TaskResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TaskResp { $sel:id:TaskResp :: Text
id = Text
id_, Text
$sel:description:TaskResp :: Text
description :: Text
description, Text
$sel:status:TaskResp :: Text
status :: Text
status }

data VolumeConstraint = VolumeConstraint
  { VolumeConstraint -> Int
minSize :: Int
  , VolumeConstraint -> Int
maxSize :: Int
  }
  deriving stock Int -> VolumeConstraint -> ShowS
[VolumeConstraint] -> ShowS
VolumeConstraint -> String
(Int -> VolumeConstraint -> ShowS)
-> (VolumeConstraint -> String)
-> ([VolumeConstraint] -> ShowS)
-> Show VolumeConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VolumeConstraint -> ShowS
showsPrec :: Int -> VolumeConstraint -> ShowS
$cshow :: VolumeConstraint -> String
show :: VolumeConstraint -> String
$cshowList :: [VolumeConstraint] -> ShowS
showList :: [VolumeConstraint] -> ShowS
Show

instance FromJSON VolumeConstraint where
  parseJSON :: Value -> Parser VolumeConstraint
  parseJSON :: Value -> Parser VolumeConstraint
parseJSON = String
-> (Object -> Parser VolumeConstraint)
-> Value
-> Parser VolumeConstraint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"VolumeConstraint" ((Object -> Parser VolumeConstraint)
 -> Value -> Parser VolumeConstraint)
-> (Object -> Parser VolumeConstraint)
-> Value
-> Parser VolumeConstraint
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
minSize <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"min_size"
    Int
maxSize <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_size"
    VolumeConstraint -> Parser VolumeConstraint
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VolumeConstraint { Int
$sel:minSize:VolumeConstraint :: Int
minSize :: Int
minSize, Int
$sel:maxSize:VolumeConstraint :: Int
maxSize :: Int
maxSize }

newtype ProductServersResp = ProductServersResp
  { ProductServersResp -> Map Text ProductServer
unProductServersResp :: Map Text ProductServer }
  deriving stock Int -> ProductServersResp -> ShowS
[ProductServersResp] -> ShowS
ProductServersResp -> String
(Int -> ProductServersResp -> ShowS)
-> (ProductServersResp -> String)
-> ([ProductServersResp] -> ShowS)
-> Show ProductServersResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProductServersResp -> ShowS
showsPrec :: Int -> ProductServersResp -> ShowS
$cshow :: ProductServersResp -> String
show :: ProductServersResp -> String
$cshowList :: [ProductServersResp] -> ShowS
showList :: [ProductServersResp] -> ShowS
Show

instance FromJSON ProductServersResp where
  parseJSON :: Value -> Parser ProductServersResp
  parseJSON :: Value -> Parser ProductServersResp
parseJSON = String
-> (Object -> Parser ProductServersResp)
-> Value
-> Parser ProductServersResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProductServersResp outer wrapper" ((Object -> Parser ProductServersResp)
 -> Value -> Parser ProductServersResp)
-> (Object -> Parser ProductServersResp)
-> Value
-> Parser ProductServersResp
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Map Text ProductServer
productServers <- Object
o Object -> Key -> Parser (Map Text ProductServer)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"servers"
    ProductServersResp -> Parser ProductServersResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProductServersResp -> Parser ProductServersResp)
-> ProductServersResp -> Parser ProductServersResp
forall a b. (a -> b) -> a -> b
$ Map Text ProductServer -> ProductServersResp
ProductServersResp Map Text ProductServer
productServers

data ProductServer = ProductServer
  { ProductServer -> Float
monthlyPrice :: Float
  , ProductServer -> Int
ncpus :: Int
  , ProductServer -> Int
ram :: Int
  , ProductServer -> Text
arch :: Text
  , ProductServer -> Int
sumInternetBandwidth :: Int
  , ProductServer -> [Text]
altNames :: [Text]
  , ProductServer -> VolumeConstraint
volumesConstraint :: VolumeConstraint
  }
  deriving stock Int -> ProductServer -> ShowS
[ProductServer] -> ShowS
ProductServer -> String
(Int -> ProductServer -> ShowS)
-> (ProductServer -> String)
-> ([ProductServer] -> ShowS)
-> Show ProductServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProductServer -> ShowS
showsPrec :: Int -> ProductServer -> ShowS
$cshow :: ProductServer -> String
show :: ProductServer -> String
$cshowList :: [ProductServer] -> ShowS
showList :: [ProductServer] -> ShowS
Show

instance FromJSON ProductServer where
  parseJSON :: Value -> Parser ProductServer
  parseJSON :: Value -> Parser ProductServer
parseJSON = String
-> (Object -> Parser ProductServer)
-> Value
-> Parser ProductServer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProductServer" ((Object -> Parser ProductServer) -> Value -> Parser ProductServer)
-> (Object -> Parser ProductServer)
-> Value
-> Parser ProductServer
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Text]
altNames <- Object
o Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"alt_names"
    Float
monthlyPrice <- Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"monthly_price"
    Int
ncpus <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ncpus"
    Int
ram <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ram"
    Text
arch <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"arch"
    VolumeConstraint
volumesConstraint <- Object
o Object -> Key -> Parser VolumeConstraint
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"volumes_constraint"
    Object
networkObj <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"network"
    Int
sumInternetBandwidth <- Object
networkObj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sum_internal_bandwidth"
    ProductServer -> Parser ProductServer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProductServer
      { Float
$sel:monthlyPrice:ProductServer :: Float
monthlyPrice :: Float
monthlyPrice
      , Int
$sel:ncpus:ProductServer :: Int
ncpus :: Int
ncpus
      , Int
$sel:ram:ProductServer :: Int
ram :: Int
ram
      , Int
$sel:sumInternetBandwidth:ProductServer :: Int
sumInternetBandwidth :: Int
sumInternetBandwidth
      , Text
$sel:arch:ProductServer :: Text
arch :: Text
arch
      , [Text]
$sel:altNames:ProductServer :: [Text]
altNames :: [Text]
altNames
      , VolumeConstraint
$sel:volumesConstraint:ProductServer :: VolumeConstraint
volumesConstraint :: VolumeConstraint
volumesConstraint
      }

newtype ProductServersAvailabilityResp = ProductServersAvailabilityResp { ProductServersAvailabilityResp -> Map Text Text
unProductServersAvailabilityResp :: Map Text Text }
  deriving stock Int -> ProductServersAvailabilityResp -> ShowS
[ProductServersAvailabilityResp] -> ShowS
ProductServersAvailabilityResp -> String
(Int -> ProductServersAvailabilityResp -> ShowS)
-> (ProductServersAvailabilityResp -> String)
-> ([ProductServersAvailabilityResp] -> ShowS)
-> Show ProductServersAvailabilityResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProductServersAvailabilityResp -> ShowS
showsPrec :: Int -> ProductServersAvailabilityResp -> ShowS
$cshow :: ProductServersAvailabilityResp -> String
show :: ProductServersAvailabilityResp -> String
$cshowList :: [ProductServersAvailabilityResp] -> ShowS
showList :: [ProductServersAvailabilityResp] -> ShowS
Show

instance FromJSON ProductServersAvailabilityResp where
  parseJSON :: Value -> Parser ProductServersAvailabilityResp
  parseJSON :: Value -> Parser ProductServersAvailabilityResp
parseJSON = String
-> (Object -> Parser ProductServersAvailabilityResp)
-> Value
-> Parser ProductServersAvailabilityResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProductServersAvailabilityResp outer wrapper" ((Object -> Parser ProductServersAvailabilityResp)
 -> Value -> Parser ProductServersAvailabilityResp)
-> (Object -> Parser ProductServersAvailabilityResp)
-> Value
-> Parser ProductServersAvailabilityResp
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Map Text Value
serversObj :: Map Text Value <- Object
o Object -> Key -> Parser (Map Text Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"servers"
    Map Text Text
availabilityMap <- (Value -> Parser Text) -> Map Text Value -> Parser (Map Text Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text b)
traverse Value -> Parser Text
parseAvail Map Text Value
serversObj
    ProductServersAvailabilityResp
-> Parser ProductServersAvailabilityResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProductServersAvailabilityResp
 -> Parser ProductServersAvailabilityResp)
-> ProductServersAvailabilityResp
-> Parser ProductServersAvailabilityResp
forall a b. (a -> b) -> a -> b
$ Map Text Text -> ProductServersAvailabilityResp
ProductServersAvailabilityResp Map Text Text
availabilityMap
    where
      parseAvail :: Value -> Parser Text
      parseAvail :: Value -> Parser Text
parseAvail = String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProductServersAvailability availability obj" ((Object -> Parser Text) -> Value -> Parser Text)
-> (Object -> Parser Text) -> Value -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Object
a -> Object
a Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"availability"

newtype ImagesResp = ImagesResp { ImagesResp -> [Image]
unImagesResp :: [Image] }
  deriving stock Int -> ImagesResp -> ShowS
[ImagesResp] -> ShowS
ImagesResp -> String
(Int -> ImagesResp -> ShowS)
-> (ImagesResp -> String)
-> ([ImagesResp] -> ShowS)
-> Show ImagesResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImagesResp -> ShowS
showsPrec :: Int -> ImagesResp -> ShowS
$cshow :: ImagesResp -> String
show :: ImagesResp -> String
$cshowList :: [ImagesResp] -> ShowS
showList :: [ImagesResp] -> ShowS
Show

instance FromJSON ImagesResp where
  parseJSON :: Value -> Parser ImagesResp
  parseJSON :: Value -> Parser ImagesResp
parseJSON = String
-> (Object -> Parser ImagesResp) -> Value -> Parser ImagesResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ImagesResp outer wrapper" ((Object -> Parser ImagesResp) -> Value -> Parser ImagesResp)
-> (Object -> Parser ImagesResp) -> Value -> Parser ImagesResp
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Image]
images <- Object
o Object -> Key -> Parser [Image]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"images"
    ImagesResp -> Parser ImagesResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImagesResp -> Parser ImagesResp)
-> ImagesResp -> Parser ImagesResp
forall a b. (a -> b) -> a -> b
$ [Image] -> ImagesResp
ImagesResp [Image]
images

data Image = Image
  { Image -> Text
id :: Text
  , Image -> Text
name :: Text
  , Image -> Text
arch :: Text
  , Image -> UTCTime
creationDate :: UTCTime
  , Image -> UTCTime
modificationDate :: UTCTime
  , Image -> Text
state :: Text
  , Image -> Text
rootVolId :: Text
  , Image -> Text
rootVolName :: Text
  , Image -> Text
rootVolType :: Text
  , Image -> Int
rootVolSize :: Int
  }
  deriving stock Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Image -> ShowS
showsPrec :: Int -> Image -> ShowS
$cshow :: Image -> String
show :: Image -> String
$cshowList :: [Image] -> ShowS
showList :: [Image] -> ShowS
Show

instance FromJSON Image where
  parseJSON :: Value -> Parser Image
  parseJSON :: Value -> Parser Image
parseJSON = String -> (Object -> Parser Image) -> Value -> Parser Image
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Image" ((Object -> Parser Image) -> Value -> Parser Image)
-> (Object -> Parser Image) -> Value -> Parser Image
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
id' <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
name <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Text
arch <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"arch"
    UTCTime
creationDate <- Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creation_date"
    UTCTime
modificationDate <- Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modification_date"
    Text
state <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
    Object
rootVol <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"root_volume"
    Text
rootVolId <- Object
rootVol Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
rootVolName <- Object
rootVol Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Text
rootVolType <- Object
rootVol Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"volume_type"
    Int
rootVolSize <- Object
rootVol Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
    Image -> Parser Image
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Image
        { $sel:id:Image :: Text
id = Text
id'
        , Text
$sel:name:Image :: Text
name :: Text
name
        , Text
$sel:arch:Image :: Text
arch :: Text
arch
        , UTCTime
$sel:creationDate:Image :: UTCTime
creationDate :: UTCTime
creationDate
        , UTCTime
$sel:modificationDate:Image :: UTCTime
modificationDate :: UTCTime
modificationDate
        , Text
$sel:state:Image :: Text
state :: Text
state
        , Text
$sel:rootVolId:Image :: Text
rootVolId :: Text
rootVolId
        , Text
$sel:rootVolName:Image :: Text
rootVolName :: Text
rootVolName
        , Text
$sel:rootVolType:Image :: Text
rootVolType :: Text
rootVolType
        , Int
$sel:rootVolSize:Image :: Int
rootVolSize :: Int
rootVolSize
        }

type InstanceIpsPostApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "ips" :>
  ReqBody '[JSON] IpsReq :>
  PostCreated '[JSON] IpsResp

type InstanceIpsDeleteApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "ips" :>
  Capture "ip_id" IpId :>
  DeleteNoContent

type InstanceServersPostApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "servers" :>
  ReqBody '[JSON] ServersReq :>
  PostCreated '[JSON] ServersResp

type InstanceServersGetApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "servers" :>
  Capture "server_id" ServerId :>
  Get '[JSON] ServersResp

type InstanceServersActionPostApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "servers" :>
  Capture "server_id" ServerId :>
  "action" :>
  ReqBody '[JSON] ServersActionReq :>
  PostAccepted '[JSON] TaskResp

type InstanceServersUserDataGetApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "servers" :>
  Capture "server_id" ServerId :>
  "user_data" :>
  Capture "key" UserDataKey :>
  Get '[PlainTextNoUTF8] UserData

type InstanceServersUserDataPatchApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "servers" :>
  Capture "server_id" ServerId :>
  "user_data" :>
  Capture "key" UserDataKey :>
  ReqBody '[PlainTextNoUTF8] UserData :>
  PatchNoContent

type InstanceVolumesPatchApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "volumes" :>
  Capture "volume_id" VolumeId :>
  ReqBody '[JSON] VolumesReq :>
  Patch '[JSON] Value

type InstanceProductsServersGetApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "products" :>
  "servers" :>
  QueryParam "per_page" PerPage :>
  Get '[JSON] ProductServersResp

type InstanceProductsServersAvailabilityGetApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "products" :>
  "servers" :>
  "availability" :>
  QueryParam "per_page" PerPage :>
  Get '[JSON] ProductServersAvailabilityResp

type InstanceImagesGetApi =
  AuthProtect "auth-token" :>
  "instance" :>
  "v1" :>
  "zones" :>
  Capture "zone" Zone :>
  "images" :>
  QueryParam "arch" Text :>
  Paged Get '[JSON] ImagesResp

type ScalewayApi =
  InstanceIpsPostApi :<|>
  InstanceIpsDeleteApi :<|>
  InstanceServersPostApi :<|>
  InstanceServersGetApi :<|>
  InstanceServersActionPostApi :<|>
  InstanceServersUserDataGetApi :<|>
  InstanceServersUserDataPatchApi :<|>
  InstanceVolumesPatchApi :<|>
  InstanceProductsServersGetApi :<|>
  InstanceProductsServersAvailabilityGetApi :<|>
  InstanceImagesGetApi

scalewayApi :: Proxy ScalewayApi
scalewayApi :: Proxy ScalewayApi
scalewayApi = Proxy
  (InstanceIpsPostApi
   :<|> (InstanceIpsDeleteApi
         :<|> (InstanceServersPostApi
               :<|> (InstanceServersGetApi
                     :<|> (InstanceServersActionPostApi
                           :<|> (InstanceServersUserDataGetApi
                                 :<|> (InstanceServersUserDataPatchApi
                                       :<|> (InstanceVolumesPatchApi
                                             :<|> (InstanceProductsServersGetApi
                                                   :<|> (InstanceProductsServersAvailabilityGetApi
                                                         :<|> (AuthProtect "auth-token"
                                                               :> ("instance"
                                                                   :> ("v1"
                                                                       :> ("zones"
                                                                           :> (Capture "zone" Zone
                                                                               :> ("images"
                                                                                   :> (QueryParam
                                                                                         "arch" Text
                                                                                       :> (QueryParam
                                                                                             "per_page"
                                                                                             PerPage
                                                                                           :> (QueryParam
                                                                                                 "page"
                                                                                                 PageNum
                                                                                               :> Verb
                                                                                                    'GET
                                                                                                    200
                                                                                                    '[JSON]
                                                                                                    (Headers
                                                                                                       '[Header
                                                                                                           "x-total-count"
                                                                                                           Int]
                                                                                                       ImagesResp))))))))))))))))))))
Proxy ScalewayApi
forall {k} (t :: k). Proxy t
Proxy

ipsPostApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  IpsReq ->
  ClientM IpsResp

ipsDeleteApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  IpId ->
  ClientM NoContent

serversPostApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  ServersReq ->
  ClientM ServersResp

serversGetApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  ServerId ->
  ClientM ServersResp

serversActionPostApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  ServerId ->
  ServersActionReq ->
  ClientM TaskResp

serversUserDataGetApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  ServerId ->
  UserDataKey ->
  ClientM UserData

serversUserDataPatchApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  ServerId ->
  UserDataKey ->
  UserData ->
  ClientM NoContent

volumesPatchApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  VolumeId ->
  VolumesReq ->
  ClientM Value

productsServersGetApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  Maybe PerPage ->
  ClientM ProductServersResp

productsServersAvailabilityGetApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  Maybe PerPage ->
  ClientM ProductServersAvailabilityResp

imagesGetApi ::
  AuthenticatedRequest (AuthProtect "auth-token") ->
  Zone ->
  Maybe Text ->
  Maybe PerPage ->
  Maybe PageNum ->
  ClientM (Headers '[Header "x-total-count" Int] ImagesResp)

AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> IpsReq -> ClientM IpsResp
ipsPostApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> IpId -> ClientM NoContent
ipsDeleteApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> ServersReq -> ClientM ServersResp
serversPostApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> ServerId -> ClientM ServersResp
serversGetApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> ServerId -> ServersActionReq -> ClientM TaskResp
serversActionPostApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> ServerId -> UserDataKey -> ClientM UserData
serversUserDataGetApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> ServerId -> UserDataKey -> UserData -> ClientM NoContent
serversUserDataPatchApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> VolumeId -> VolumesReq -> ClientM Value
volumesPatchApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> Maybe PerPage -> ClientM ProductServersResp
productsServersGetApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> Maybe PerPage -> ClientM ProductServersAvailabilityResp
productsServersAvailabilityGetApi
  :<|> AuthenticatedRequest (AuthProtect "auth-token")
-> Zone
-> Maybe Text
-> Maybe PerPage
-> Maybe PageNum
-> ClientM (Headers '[Header "x-total-count" Int] ImagesResp)
imagesGetApi = Proxy
  (InstanceIpsPostApi
   :<|> (InstanceIpsDeleteApi
         :<|> (InstanceServersPostApi
               :<|> (InstanceServersGetApi
                     :<|> (InstanceServersActionPostApi
                           :<|> (InstanceServersUserDataGetApi
                                 :<|> (InstanceServersUserDataPatchApi
                                       :<|> (InstanceVolumesPatchApi
                                             :<|> (InstanceProductsServersGetApi
                                                   :<|> (InstanceProductsServersAvailabilityGetApi
                                                         :<|> (AuthProtect "auth-token"
                                                               :> ("instance"
                                                                   :> ("v1"
                                                                       :> ("zones"
                                                                           :> (Capture "zone" Zone
                                                                               :> ("images"
                                                                                   :> (QueryParam
                                                                                         "arch" Text
                                                                                       :> (QueryParam
                                                                                             "per_page"
                                                                                             PerPage
                                                                                           :> (QueryParam
                                                                                                 "page"
                                                                                                 PageNum
                                                                                               :> Verb
                                                                                                    'GET
                                                                                                    200
                                                                                                    '[JSON]
                                                                                                    (Headers
                                                                                                       '[Header
                                                                                                           "x-total-count"
                                                                                                           Int]
                                                                                                       ImagesResp))))))))))))))))))))
-> Client
     ClientM
     (InstanceIpsPostApi
      :<|> (InstanceIpsDeleteApi
            :<|> (InstanceServersPostApi
                  :<|> (InstanceServersGetApi
                        :<|> (InstanceServersActionPostApi
                              :<|> (InstanceServersUserDataGetApi
                                    :<|> (InstanceServersUserDataPatchApi
                                          :<|> (InstanceVolumesPatchApi
                                                :<|> (InstanceProductsServersGetApi
                                                      :<|> (InstanceProductsServersAvailabilityGetApi
                                                            :<|> (AuthProtect "auth-token"
                                                                  :> ("instance"
                                                                      :> ("v1"
                                                                          :> ("zones"
                                                                              :> (Capture
                                                                                    "zone" Zone
                                                                                  :> ("images"
                                                                                      :> (QueryParam
                                                                                            "arch"
                                                                                            Text
                                                                                          :> (QueryParam
                                                                                                "per_page"
                                                                                                PerPage
                                                                                              :> (QueryParam
                                                                                                    "page"
                                                                                                    PageNum
                                                                                                  :> Verb
                                                                                                       'GET
                                                                                                       200
                                                                                                       '[JSON]
                                                                                                       (Headers
                                                                                                          '[Header
                                                                                                              "x-total-count"
                                                                                                              Int]
                                                                                                          ImagesResp))))))))))))))))))))
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy
  (InstanceIpsPostApi
   :<|> (InstanceIpsDeleteApi
         :<|> (InstanceServersPostApi
               :<|> (InstanceServersGetApi
                     :<|> (InstanceServersActionPostApi
                           :<|> (InstanceServersUserDataGetApi
                                 :<|> (InstanceServersUserDataPatchApi
                                       :<|> (InstanceVolumesPatchApi
                                             :<|> (InstanceProductsServersGetApi
                                                   :<|> (InstanceProductsServersAvailabilityGetApi
                                                         :<|> (AuthProtect "auth-token"
                                                               :> ("instance"
                                                                   :> ("v1"
                                                                       :> ("zones"
                                                                           :> (Capture "zone" Zone
                                                                               :> ("images"
                                                                                   :> (QueryParam
                                                                                         "arch" Text
                                                                                       :> (QueryParam
                                                                                             "per_page"
                                                                                             PerPage
                                                                                           :> (QueryParam
                                                                                                 "page"
                                                                                                 PageNum
                                                                                               :> Verb
                                                                                                    'GET
                                                                                                    200
                                                                                                    '[JSON]
                                                                                                    (Headers
                                                                                                       '[Header
                                                                                                           "x-total-count"
                                                                                                           Int]
                                                                                                       ImagesResp))))))))))))))))))))
Proxy ScalewayApi
scalewayApi