{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator.
{-# LANGUAGE OverloadedStrings #-}

-- | Contains the different functions to run the operation list_external_subscription_external_payment_phases
module RecurlyClient.Operations.List_external_subscription_external_payment_phases where

import qualified Control.Monad.Fail
import qualified Control.Monad.Trans.Reader
import qualified Data.Aeson
import qualified Data.Aeson as Data.Aeson.Encoding.Internal
import qualified Data.Aeson as Data.Aeson.Types
import qualified Data.Aeson as Data.Aeson.Types.FromJSON
import qualified Data.Aeson as Data.Aeson.Types.Internal
import qualified Data.Aeson as Data.Aeson.Types.ToJSON
import qualified Data.ByteString
import qualified Data.ByteString as Data.ByteString.Internal
import qualified Data.ByteString as Data.ByteString.Internal.Type
import qualified Data.Either
import qualified Data.Foldable
import qualified Data.Functor
import qualified Data.Maybe
import qualified Data.Scientific
import qualified Data.Text
import qualified Data.Text as Data.Text.Internal
import qualified Data.Time.Calendar as Data.Time.Calendar.Days
import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime
import qualified Data.Vector
import qualified GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified Network.HTTP.Client
import qualified Network.HTTP.Client as Network.HTTP.Client.Request
import qualified Network.HTTP.Client as Network.HTTP.Client.Types
import qualified Network.HTTP.Simple
import qualified Network.HTTP.Types
import qualified Network.HTTP.Types as Network.HTTP.Types.Status
import qualified Network.HTTP.Types as Network.HTTP.Types.URI
import qualified RecurlyClient.Common
import RecurlyClient.Types
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

{- | > GET /external_subscriptions/{external_subscription_id}/external_payment_phases

See the [Pagination Guide](\/developers\/guides\/pagination.html) to learn how to use pagination in the API and Client Libraries.
-}
list_external_subscription_external_payment_phases ::
    forall m.
    (RecurlyClient.Common.MonadHTTP m) =>
    -- | Contains all available parameters of this operation (query and path parameters)
    List_external_subscription_external_payment_phasesParameters ->
    -- | Monadic computation which returns the result of the operation
    RecurlyClient.Common.ClientT m (Network.HTTP.Client.Types.Response List_external_subscription_external_payment_phasesResponse)
list_external_subscription_external_payment_phases :: forall (m :: * -> *).
MonadHTTP m =>
List_external_subscription_external_payment_phasesParameters
-> ClientT
     m
     (Response
        List_external_subscription_external_payment_phasesResponse)
list_external_subscription_external_payment_phases List_external_subscription_external_payment_phasesParameters
parameters =
    (Response ByteString
 -> Response
      List_external_subscription_external_payment_phasesResponse)
-> ClientT m (Response ByteString)
-> ClientT
     m
     (Response
        List_external_subscription_external_payment_phasesResponse)
forall a b. (a -> b) -> ClientT m a -> ClientT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
        ( \Response ByteString
response_0 ->
            (ByteString
 -> List_external_subscription_external_payment_phasesResponse)
-> Response ByteString
-> Response
     List_external_subscription_external_payment_phasesResponse
forall a b. (a -> b) -> Response a -> Response b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
                ( (String
 -> List_external_subscription_external_payment_phasesResponse)
-> (List_external_subscription_external_payment_phasesResponse
    -> List_external_subscription_external_payment_phasesResponse)
-> Either
     String List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String
-> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponseError List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
forall a. a -> a
GHC.Base.id
                    (Either
   String List_external_subscription_external_payment_phasesResponse
 -> List_external_subscription_external_payment_phasesResponse)
-> (ByteString
    -> Either
         String List_external_subscription_external_payment_phasesResponse)
-> ByteString
-> List_external_subscription_external_payment_phasesResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. ( \Response ByteString
response ByteString
body ->
                                    if
                                        | (\Status
status_1 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
200) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                            ExternalPaymentPhaseList
-> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponse200
                                                (ExternalPaymentPhaseList
 -> List_external_subscription_external_payment_phasesResponse)
-> Either String ExternalPaymentPhaseList
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String ExternalPaymentPhaseList
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                                    Data.Either.Either
                                                                        GHC.Base.String
                                                                        ExternalPaymentPhaseList
                                                                 )
                                        | (\Status
status_2 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
404) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                            Error -> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponse404
                                                (Error
 -> List_external_subscription_external_payment_phasesResponse)
-> Either String Error
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                                    Data.Either.Either
                                                                        GHC.Base.String
                                                                        Error
                                                                 )
                                        | Bool -> Status -> Bool
forall a b. a -> b -> a
GHC.Base.const Bool
GHC.Types.True (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                            Error -> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponseDefault
                                                (Error
 -> List_external_subscription_external_payment_phasesResponse)
-> Either String Error
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                                    Data.Either.Either
                                                                        GHC.Base.String
                                                                        Error
                                                                 )
                                        | Bool
GHC.Base.otherwise -> String
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall a b. a -> Either a b
Data.Either.Left String
"Missing default response type"
                               )
                        Response ByteString
response_0
                )
                Response ByteString
response_0
        )
        ( Text -> Text -> [QueryParameter] -> ClientT m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Text -> Text -> [QueryParameter] -> ClientT m (Response ByteString)
RecurlyClient.Common.doCallWithConfigurationM
            (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.Internal.pack String
"GET")
            Text
"/external_subscriptions/{external_subscription_id}/external_payment_phases"
            [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"sort") (List_external_subscription_external_payment_phasesParametersQuerySort
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQuerySort
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
            , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"limit") (Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
            , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"order") (List_external_subscription_external_payment_phasesParametersQueryOrder
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQueryOrder
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
            ]
        )

-- | Defines the object schema located at @paths.\/external_subscriptions\/{external_subscription_id}\/external_payment_phases.GET.parameters@ in the specification.
data List_external_subscription_external_payment_phasesParameters = List_external_subscription_external_payment_phasesParameters
    { List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit :: (GHC.Maybe.Maybe GHC.Types.Int)
    -- ^ queryLimit: Represents the parameter named \'limit\'
    --
    -- Limit number of records 1-200.
    --
    -- Constraints:
    --
    -- * Maxium  of 200.0
    -- * Minimum  of 1.0
    , List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder :: (GHC.Maybe.Maybe List_external_subscription_external_payment_phasesParametersQueryOrder)
    -- ^ queryOrder: Represents the parameter named \'order\'
    --
    -- Sort order.
    , List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort :: (GHC.Maybe.Maybe List_external_subscription_external_payment_phasesParametersQuerySort)
    -- ^ querySort: Represents the parameter named \'sort\'
    --
    -- Sort field. You *really* only want to sort by \`updated_at\` in ascending
    -- order. In descending order updated records will move behind the cursor and could
    -- prevent some records from being returned.
    }
    deriving
        ( Int
-> List_external_subscription_external_payment_phasesParameters
-> ShowS
[List_external_subscription_external_payment_phasesParameters]
-> ShowS
List_external_subscription_external_payment_phasesParameters
-> String
(Int
 -> List_external_subscription_external_payment_phasesParameters
 -> ShowS)
-> (List_external_subscription_external_payment_phasesParameters
    -> String)
-> ([List_external_subscription_external_payment_phasesParameters]
    -> ShowS)
-> Show
     List_external_subscription_external_payment_phasesParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> List_external_subscription_external_payment_phasesParameters
-> ShowS
showsPrec :: Int
-> List_external_subscription_external_payment_phasesParameters
-> ShowS
$cshow :: List_external_subscription_external_payment_phasesParameters
-> String
show :: List_external_subscription_external_payment_phasesParameters
-> String
$cshowList :: [List_external_subscription_external_payment_phasesParameters]
-> ShowS
showList :: [List_external_subscription_external_payment_phasesParameters]
-> ShowS
GHC.Show.Show
        , List_external_subscription_external_payment_phasesParameters
-> List_external_subscription_external_payment_phasesParameters
-> Bool
(List_external_subscription_external_payment_phasesParameters
 -> List_external_subscription_external_payment_phasesParameters
 -> Bool)
-> (List_external_subscription_external_payment_phasesParameters
    -> List_external_subscription_external_payment_phasesParameters
    -> Bool)
-> Eq List_external_subscription_external_payment_phasesParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: List_external_subscription_external_payment_phasesParameters
-> List_external_subscription_external_payment_phasesParameters
-> Bool
== :: List_external_subscription_external_payment_phasesParameters
-> List_external_subscription_external_payment_phasesParameters
-> Bool
$c/= :: List_external_subscription_external_payment_phasesParameters
-> List_external_subscription_external_payment_phasesParameters
-> Bool
/= :: List_external_subscription_external_payment_phasesParameters
-> List_external_subscription_external_payment_phasesParameters
-> Bool
GHC.Classes.Eq
        )

instance Data.Aeson.Types.ToJSON.ToJSON List_external_subscription_external_payment_phasesParameters where
    toJSON :: List_external_subscription_external_payment_phasesParameters
-> Value
toJSON List_external_subscription_external_payment_phasesParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object ([[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.Foldable.concat ([Pair] -> (Int -> [Pair]) -> Maybe Int -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair]) -> (Int -> Pair) -> Int -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"queryLimit" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit List_external_subscription_external_payment_phasesParameters
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair]
-> (List_external_subscription_external_payment_phasesParametersQueryOrder
    -> [Pair])
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair])
-> (List_external_subscription_external_payment_phasesParametersQueryOrder
    -> Pair)
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"queryOrder" Key
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder List_external_subscription_external_payment_phasesParameters
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair]
-> (List_external_subscription_external_payment_phasesParametersQuerySort
    -> [Pair])
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair])
-> (List_external_subscription_external_payment_phasesParametersQuerySort
    -> Pair)
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"querySort" Key
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort List_external_subscription_external_payment_phasesParameters
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [[Pair]]
forall a. Monoid a => a
GHC.Base.mempty))
    toEncoding :: List_external_subscription_external_payment_phasesParameters
-> Encoding
toEncoding List_external_subscription_external_payment_phasesParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ([Series] -> Series
forall a. Monoid a => [a] -> a
GHC.Base.mconcat ([[Series]] -> [Series]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.Foldable.concat ([Series] -> (Int -> [Series]) -> Maybe Int -> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series]) -> (Int -> Series) -> Int -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"queryLimit" Key -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit List_external_subscription_external_payment_phasesParameters
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> (List_external_subscription_external_payment_phasesParametersQueryOrder
    -> [Series])
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series])
-> (List_external_subscription_external_payment_phasesParametersQueryOrder
    -> Series)
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"queryOrder" Key
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder List_external_subscription_external_payment_phasesParameters
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> (List_external_subscription_external_payment_phasesParametersQuerySort
    -> [Series])
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series])
-> (List_external_subscription_external_payment_phasesParametersQuerySort
    -> Series)
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"querySort" Key
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort List_external_subscription_external_payment_phasesParameters
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [[Series]]
forall a. Monoid a => a
GHC.Base.mempty)))
instance Data.Aeson.Types.FromJSON.FromJSON List_external_subscription_external_payment_phasesParameters where
    parseJSON :: Value
-> Parser
     List_external_subscription_external_payment_phasesParameters
parseJSON = String
-> (Object
    -> Parser
         List_external_subscription_external_payment_phasesParameters)
-> Value
-> Parser
     List_external_subscription_external_payment_phasesParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"List_external_subscription_external_payment_phasesParameters" (\Object
obj -> (((Maybe Int
 -> Maybe
      List_external_subscription_external_payment_phasesParametersQueryOrder
 -> Maybe
      List_external_subscription_external_payment_phasesParametersQuerySort
 -> List_external_subscription_external_payment_phasesParameters)
-> Parser
     (Maybe Int
      -> Maybe
           List_external_subscription_external_payment_phasesParametersQueryOrder
      -> Maybe
           List_external_subscription_external_payment_phasesParametersQuerySort
      -> List_external_subscription_external_payment_phasesParameters)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> List_external_subscription_external_payment_phasesParameters
List_external_subscription_external_payment_phasesParameters Parser
  (Maybe Int
   -> Maybe
        List_external_subscription_external_payment_phasesParametersQueryOrder
   -> Maybe
        List_external_subscription_external_payment_phasesParametersQuerySort
   -> List_external_subscription_external_payment_phasesParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe
        List_external_subscription_external_payment_phasesParametersQueryOrder
      -> Maybe
           List_external_subscription_external_payment_phasesParametersQuerySort
      -> List_external_subscription_external_payment_phasesParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"queryLimit")) Parser
  (Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
   -> Maybe
        List_external_subscription_external_payment_phasesParametersQuerySort
   -> List_external_subscription_external_payment_phasesParameters)
-> Parser
     (Maybe
        List_external_subscription_external_payment_phasesParametersQueryOrder)
-> Parser
     (Maybe
        List_external_subscription_external_payment_phasesParametersQuerySort
      -> List_external_subscription_external_payment_phasesParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Key
-> Parser
     (Maybe
        List_external_subscription_external_payment_phasesParametersQueryOrder)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"queryOrder")) Parser
  (Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
   -> List_external_subscription_external_payment_phasesParameters)
-> Parser
     (Maybe
        List_external_subscription_external_payment_phasesParametersQuerySort)
-> Parser
     List_external_subscription_external_payment_phasesParameters
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Key
-> Parser
     (Maybe
        List_external_subscription_external_payment_phasesParametersQuerySort)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"querySort"))

-- | Create a new 'List_external_subscription_external_payment_phasesParameters' with all required fields.
mkList_external_subscription_external_payment_phasesParameters :: List_external_subscription_external_payment_phasesParameters
mkList_external_subscription_external_payment_phasesParameters :: List_external_subscription_external_payment_phasesParameters
mkList_external_subscription_external_payment_phasesParameters =
    List_external_subscription_external_payment_phasesParameters
        { list_external_subscription_external_payment_phasesParametersQueryLimit :: Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing
        , list_external_subscription_external_payment_phasesParametersQueryOrder :: Maybe
  List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder = Maybe
  List_external_subscription_external_payment_phasesParametersQueryOrder
forall a. Maybe a
GHC.Maybe.Nothing
        , list_external_subscription_external_payment_phasesParametersQuerySort :: Maybe
  List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort = Maybe
  List_external_subscription_external_payment_phasesParametersQuerySort
forall a. Maybe a
GHC.Maybe.Nothing
        }

{- | Defines the enum schema located at @paths.\/external_subscriptions\/{external_subscription_id}\/external_payment_phases.GET.parameters.properties.queryOrder@ in the specification.

Represents the parameter named \'order\'

Sort order.
-}
data List_external_subscription_external_payment_phasesParametersQueryOrder
    = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
      List_external_subscription_external_payment_phasesParametersQueryOrderOther Data.Aeson.Types.Internal.Value
    | -- | This constructor can be used to send values to the server which are not present in the specification yet.
      List_external_subscription_external_payment_phasesParametersQueryOrderTyped Data.Text.Internal.Text
    | -- | Represents the JSON value @"asc"@
      List_external_subscription_external_payment_phasesParametersQueryOrderEnumAsc
    | -- | Represents the JSON value @"desc"@
      List_external_subscription_external_payment_phasesParametersQueryOrderEnumDesc
    deriving (Int
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> ShowS
[List_external_subscription_external_payment_phasesParametersQueryOrder]
-> ShowS
List_external_subscription_external_payment_phasesParametersQueryOrder
-> String
(Int
 -> List_external_subscription_external_payment_phasesParametersQueryOrder
 -> ShowS)
-> (List_external_subscription_external_payment_phasesParametersQueryOrder
    -> String)
-> ([List_external_subscription_external_payment_phasesParametersQueryOrder]
    -> ShowS)
-> Show
     List_external_subscription_external_payment_phasesParametersQueryOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> ShowS
showsPrec :: Int
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> ShowS
$cshow :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> String
show :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> String
$cshowList :: [List_external_subscription_external_payment_phasesParametersQueryOrder]
-> ShowS
showList :: [List_external_subscription_external_payment_phasesParametersQueryOrder]
-> ShowS
GHC.Show.Show, List_external_subscription_external_payment_phasesParametersQueryOrder
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Bool
(List_external_subscription_external_payment_phasesParametersQueryOrder
 -> List_external_subscription_external_payment_phasesParametersQueryOrder
 -> Bool)
-> (List_external_subscription_external_payment_phasesParametersQueryOrder
    -> List_external_subscription_external_payment_phasesParametersQueryOrder
    -> Bool)
-> Eq
     List_external_subscription_external_payment_phasesParametersQueryOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Bool
== :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Bool
$c/= :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Bool
/= :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> List_external_subscription_external_payment_phasesParametersQueryOrder
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON List_external_subscription_external_payment_phasesParametersQueryOrder where
    toJSON :: List_external_subscription_external_payment_phasesParametersQueryOrder
-> Value
toJSON (List_external_subscription_external_payment_phasesParametersQueryOrderOther Value
val) = Value
val
    toJSON (List_external_subscription_external_payment_phasesParametersQueryOrderTyped Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
    toJSON (List_external_subscription_external_payment_phasesParametersQueryOrder
List_external_subscription_external_payment_phasesParametersQueryOrderEnumAsc) = Value
"asc"
    toJSON (List_external_subscription_external_payment_phasesParametersQueryOrder
List_external_subscription_external_payment_phasesParametersQueryOrderEnumDesc) = Value
"desc"
instance Data.Aeson.Types.FromJSON.FromJSON List_external_subscription_external_payment_phasesParametersQueryOrder where
    parseJSON :: Value
-> Parser
     List_external_subscription_external_payment_phasesParametersQueryOrder
parseJSON Value
val =
        List_external_subscription_external_payment_phasesParametersQueryOrder
-> Parser
     List_external_subscription_external_payment_phasesParametersQueryOrder
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
            ( if
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"asc" -> List_external_subscription_external_payment_phasesParametersQueryOrder
List_external_subscription_external_payment_phasesParametersQueryOrderEnumAsc
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"desc" -> List_external_subscription_external_payment_phasesParametersQueryOrder
List_external_subscription_external_payment_phasesParametersQueryOrderEnumDesc
                | Bool
GHC.Base.otherwise -> Value
-> List_external_subscription_external_payment_phasesParametersQueryOrder
List_external_subscription_external_payment_phasesParametersQueryOrderOther Value
val
            )

{- | Defines the enum schema located at @paths.\/external_subscriptions\/{external_subscription_id}\/external_payment_phases.GET.parameters.properties.querySort@ in the specification.

Represents the parameter named \'sort\'

Sort field. You *really* only want to sort by \`updated_at\` in ascending
order. In descending order updated records will move behind the cursor and could
prevent some records from being returned.
-}
data List_external_subscription_external_payment_phasesParametersQuerySort
    = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
      List_external_subscription_external_payment_phasesParametersQuerySortOther Data.Aeson.Types.Internal.Value
    | -- | This constructor can be used to send values to the server which are not present in the specification yet.
      List_external_subscription_external_payment_phasesParametersQuerySortTyped Data.Text.Internal.Text
    | -- | Represents the JSON value @"created_at"@
      List_external_subscription_external_payment_phasesParametersQuerySortEnumCreated_at
    | -- | Represents the JSON value @"updated_at"@
      List_external_subscription_external_payment_phasesParametersQuerySortEnumUpdated_at
    deriving (Int
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> ShowS
[List_external_subscription_external_payment_phasesParametersQuerySort]
-> ShowS
List_external_subscription_external_payment_phasesParametersQuerySort
-> String
(Int
 -> List_external_subscription_external_payment_phasesParametersQuerySort
 -> ShowS)
-> (List_external_subscription_external_payment_phasesParametersQuerySort
    -> String)
-> ([List_external_subscription_external_payment_phasesParametersQuerySort]
    -> ShowS)
-> Show
     List_external_subscription_external_payment_phasesParametersQuerySort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> ShowS
showsPrec :: Int
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> ShowS
$cshow :: List_external_subscription_external_payment_phasesParametersQuerySort
-> String
show :: List_external_subscription_external_payment_phasesParametersQuerySort
-> String
$cshowList :: [List_external_subscription_external_payment_phasesParametersQuerySort]
-> ShowS
showList :: [List_external_subscription_external_payment_phasesParametersQuerySort]
-> ShowS
GHC.Show.Show, List_external_subscription_external_payment_phasesParametersQuerySort
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Bool
(List_external_subscription_external_payment_phasesParametersQuerySort
 -> List_external_subscription_external_payment_phasesParametersQuerySort
 -> Bool)
-> (List_external_subscription_external_payment_phasesParametersQuerySort
    -> List_external_subscription_external_payment_phasesParametersQuerySort
    -> Bool)
-> Eq
     List_external_subscription_external_payment_phasesParametersQuerySort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: List_external_subscription_external_payment_phasesParametersQuerySort
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Bool
== :: List_external_subscription_external_payment_phasesParametersQuerySort
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Bool
$c/= :: List_external_subscription_external_payment_phasesParametersQuerySort
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Bool
/= :: List_external_subscription_external_payment_phasesParametersQuerySort
-> List_external_subscription_external_payment_phasesParametersQuerySort
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON List_external_subscription_external_payment_phasesParametersQuerySort where
    toJSON :: List_external_subscription_external_payment_phasesParametersQuerySort
-> Value
toJSON (List_external_subscription_external_payment_phasesParametersQuerySortOther Value
val) = Value
val
    toJSON (List_external_subscription_external_payment_phasesParametersQuerySortTyped Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
    toJSON (List_external_subscription_external_payment_phasesParametersQuerySort
List_external_subscription_external_payment_phasesParametersQuerySortEnumCreated_at) = Value
"created_at"
    toJSON (List_external_subscription_external_payment_phasesParametersQuerySort
List_external_subscription_external_payment_phasesParametersQuerySortEnumUpdated_at) = Value
"updated_at"
instance Data.Aeson.Types.FromJSON.FromJSON List_external_subscription_external_payment_phasesParametersQuerySort where
    parseJSON :: Value
-> Parser
     List_external_subscription_external_payment_phasesParametersQuerySort
parseJSON Value
val =
        List_external_subscription_external_payment_phasesParametersQuerySort
-> Parser
     List_external_subscription_external_payment_phasesParametersQuerySort
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
            ( if
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"created_at" -> List_external_subscription_external_payment_phasesParametersQuerySort
List_external_subscription_external_payment_phasesParametersQuerySortEnumCreated_at
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"updated_at" -> List_external_subscription_external_payment_phasesParametersQuerySort
List_external_subscription_external_payment_phasesParametersQuerySortEnumUpdated_at
                | Bool
GHC.Base.otherwise -> Value
-> List_external_subscription_external_payment_phasesParametersQuerySort
List_external_subscription_external_payment_phasesParametersQuerySortOther Value
val
            )

{- | Represents a response of the operation 'list_external_subscription_external_payment_phases'.

The response constructor is chosen by the status code of the response. If no case matches (no specific case for the response code, no range case, no default case), 'List_external_subscription_external_payment_phasesResponseError' is used.
-}
data List_external_subscription_external_payment_phasesResponse
    = -- | Means either no matching case available or a parse error
      List_external_subscription_external_payment_phasesResponseError GHC.Base.String
    | -- | A list of the the external_payment_phases on a site.
      List_external_subscription_external_payment_phasesResponse200 ExternalPaymentPhaseList
    | -- | Incorrect site.
      List_external_subscription_external_payment_phasesResponse404 Error
    | -- | Unexpected error.
      List_external_subscription_external_payment_phasesResponseDefault Error
    deriving (Int
-> List_external_subscription_external_payment_phasesResponse
-> ShowS
[List_external_subscription_external_payment_phasesResponse]
-> ShowS
List_external_subscription_external_payment_phasesResponse
-> String
(Int
 -> List_external_subscription_external_payment_phasesResponse
 -> ShowS)
-> (List_external_subscription_external_payment_phasesResponse
    -> String)
-> ([List_external_subscription_external_payment_phasesResponse]
    -> ShowS)
-> Show List_external_subscription_external_payment_phasesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int
-> List_external_subscription_external_payment_phasesResponse
-> ShowS
showsPrec :: Int
-> List_external_subscription_external_payment_phasesResponse
-> ShowS
$cshow :: List_external_subscription_external_payment_phasesResponse
-> String
show :: List_external_subscription_external_payment_phasesResponse
-> String
$cshowList :: [List_external_subscription_external_payment_phasesResponse]
-> ShowS
showList :: [List_external_subscription_external_payment_phasesResponse]
-> ShowS
GHC.Show.Show, List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
-> Bool
(List_external_subscription_external_payment_phasesResponse
 -> List_external_subscription_external_payment_phasesResponse
 -> Bool)
-> (List_external_subscription_external_payment_phasesResponse
    -> List_external_subscription_external_payment_phasesResponse
    -> Bool)
-> Eq List_external_subscription_external_payment_phasesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
-> Bool
== :: List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
-> Bool
$c/= :: List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
-> Bool
/= :: List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
-> Bool
GHC.Classes.Eq)

{- | > GET /external_subscriptions/{external_subscription_id}/external_payment_phases

The same as 'list_external_subscription_external_payment_phases' but accepts an explicit configuration.
-}
list_external_subscription_external_payment_phasesWithConfiguration ::
    forall m.
    (RecurlyClient.Common.MonadHTTP m) =>
    -- | The configuration to use in the request
    RecurlyClient.Common.Configuration ->
    -- | Contains all available parameters of this operation (query and path parameters)
    List_external_subscription_external_payment_phasesParameters ->
    -- | Monadic computation which returns the result of the operation
    m (Network.HTTP.Client.Types.Response List_external_subscription_external_payment_phasesResponse)
list_external_subscription_external_payment_phasesWithConfiguration :: forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> List_external_subscription_external_payment_phasesParameters
-> m (Response
        List_external_subscription_external_payment_phasesResponse)
list_external_subscription_external_payment_phasesWithConfiguration
    Configuration
config
    List_external_subscription_external_payment_phasesParameters
parameters =
        (Response ByteString
 -> Response
      List_external_subscription_external_payment_phasesResponse)
-> m (Response ByteString)
-> m (Response
        List_external_subscription_external_payment_phasesResponse)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( \Response ByteString
response_3 ->
                (ByteString
 -> List_external_subscription_external_payment_phasesResponse)
-> Response ByteString
-> Response
     List_external_subscription_external_payment_phasesResponse
forall a b. (a -> b) -> Response a -> Response b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
                    ( (String
 -> List_external_subscription_external_payment_phasesResponse)
-> (List_external_subscription_external_payment_phasesResponse
    -> List_external_subscription_external_payment_phasesResponse)
-> Either
     String List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String
-> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponseError List_external_subscription_external_payment_phasesResponse
-> List_external_subscription_external_payment_phasesResponse
forall a. a -> a
GHC.Base.id
                        (Either
   String List_external_subscription_external_payment_phasesResponse
 -> List_external_subscription_external_payment_phasesResponse)
-> (ByteString
    -> Either
         String List_external_subscription_external_payment_phasesResponse)
-> ByteString
-> List_external_subscription_external_payment_phasesResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. ( \Response ByteString
response ByteString
body ->
                                        if
                                            | (\Status
status_4 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
200) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                                ExternalPaymentPhaseList
-> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponse200
                                                    (ExternalPaymentPhaseList
 -> List_external_subscription_external_payment_phasesResponse)
-> Either String ExternalPaymentPhaseList
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String ExternalPaymentPhaseList
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                                        Data.Either.Either
                                                                            GHC.Base.String
                                                                            ExternalPaymentPhaseList
                                                                     )
                                            | (\Status
status_5 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_5 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
404) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                                Error -> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponse404
                                                    (Error
 -> List_external_subscription_external_payment_phasesResponse)
-> Either String Error
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                                        Data.Either.Either
                                                                            GHC.Base.String
                                                                            Error
                                                                     )
                                            | Bool -> Status -> Bool
forall a b. a -> b -> a
GHC.Base.const Bool
GHC.Types.True (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                                Error -> List_external_subscription_external_payment_phasesResponse
List_external_subscription_external_payment_phasesResponseDefault
                                                    (Error
 -> List_external_subscription_external_payment_phasesResponse)
-> Either String Error
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                                        Data.Either.Either
                                                                            GHC.Base.String
                                                                            Error
                                                                     )
                                            | Bool
GHC.Base.otherwise -> String
-> Either
     String List_external_subscription_external_payment_phasesResponse
forall a b. a -> Either a b
Data.Either.Left String
"Missing default response type"
                                   )
                            Response ByteString
response_3
                    )
                    Response ByteString
response_3
            )
            ( Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
RecurlyClient.Common.doCallWithConfiguration
                Configuration
config
                (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.Internal.pack String
"GET")
                Text
"/external_subscriptions/{external_subscription_id}/external_payment_phases"
                [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"sort") (List_external_subscription_external_payment_phasesParametersQuerySort
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQuerySort
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
                , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"limit") (Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
                , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"order") (List_external_subscription_external_payment_phasesParametersQueryOrder
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQueryOrder
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
                ]
            )

{- | > GET /external_subscriptions/{external_subscription_id}/external_payment_phases

The same as 'list_external_subscription_external_payment_phases' but returns the raw 'Data.ByteString.ByteString'.
-}
list_external_subscription_external_payment_phasesRaw ::
    forall m.
    (RecurlyClient.Common.MonadHTTP m) =>
    -- | Contains all available parameters of this operation (query and path parameters)
    List_external_subscription_external_payment_phasesParameters ->
    -- | Monadic computation which returns the result of the operation
    RecurlyClient.Common.ClientT m (Network.HTTP.Client.Types.Response Data.ByteString.Internal.Type.ByteString)
list_external_subscription_external_payment_phasesRaw :: forall (m :: * -> *).
MonadHTTP m =>
List_external_subscription_external_payment_phasesParameters
-> ClientT m (Response ByteString)
list_external_subscription_external_payment_phasesRaw List_external_subscription_external_payment_phasesParameters
parameters =
    ClientT m (Response ByteString) -> ClientT m (Response ByteString)
forall a. a -> a
GHC.Base.id
        ( Text -> Text -> [QueryParameter] -> ClientT m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Text -> Text -> [QueryParameter] -> ClientT m (Response ByteString)
RecurlyClient.Common.doCallWithConfigurationM
            (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.Internal.pack String
"GET")
            Text
"/external_subscriptions/{external_subscription_id}/external_payment_phases"
            [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"sort") (List_external_subscription_external_payment_phasesParametersQuerySort
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQuerySort
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
            , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"limit") (Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
            , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"order") (List_external_subscription_external_payment_phasesParametersQueryOrder
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQueryOrder
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
            ]
        )

{- | > GET /external_subscriptions/{external_subscription_id}/external_payment_phases

The same as 'list_external_subscription_external_payment_phases' but accepts an explicit configuration and returns the raw 'Data.ByteString.ByteString'.
-}
list_external_subscription_external_payment_phasesWithConfigurationRaw ::
    forall m.
    (RecurlyClient.Common.MonadHTTP m) =>
    -- | The configuration to use in the request
    RecurlyClient.Common.Configuration ->
    -- | Contains all available parameters of this operation (query and path parameters)
    List_external_subscription_external_payment_phasesParameters ->
    -- | Monadic computation which returns the result of the operation
    m (Network.HTTP.Client.Types.Response Data.ByteString.Internal.Type.ByteString)
list_external_subscription_external_payment_phasesWithConfigurationRaw :: forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> List_external_subscription_external_payment_phasesParameters
-> m (Response ByteString)
list_external_subscription_external_payment_phasesWithConfigurationRaw
    Configuration
config
    List_external_subscription_external_payment_phasesParameters
parameters =
        m (Response ByteString) -> m (Response ByteString)
forall a. a -> a
GHC.Base.id
            ( Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
RecurlyClient.Common.doCallWithConfiguration
                Configuration
config
                (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.Internal.pack String
"GET")
                Text
"/external_subscriptions/{external_subscription_id}/external_payment_phases"
                [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"sort") (List_external_subscription_external_payment_phasesParametersQuerySort
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQuerySort
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQuerySort
list_external_subscription_external_payment_phasesParametersQuerySort List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
                , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"limit") (Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe Int
list_external_subscription_external_payment_phasesParametersQueryLimit List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
                , Text -> Maybe Value -> Text -> Bool -> QueryParameter
RecurlyClient.Common.QueryParameter (String -> Text
Data.Text.Internal.pack String
"order") (List_external_subscription_external_payment_phasesParametersQueryOrder
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (List_external_subscription_external_payment_phasesParametersQueryOrder
 -> Value)
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> List_external_subscription_external_payment_phasesParameters
-> Maybe
     List_external_subscription_external_payment_phasesParametersQueryOrder
list_external_subscription_external_payment_phasesParametersQueryOrder List_external_subscription_external_payment_phasesParameters
parameters) (String -> Text
Data.Text.Internal.pack String
"form") Bool
GHC.Types.False
                ]
            )