{-# OPTIONS_GHC -Wall #-}
{-# language DeriveFunctor, DerivingStrategies, DeriveDataTypeable, DeriveGeneric #-}

module Stripe.Concepts
  (
  -- * Modes
    Mode (..), BothModes (..), applyMode
  -- ** Conversion with Bool
  , isLiveMode, isTestMode, isLiveMode', isTestMode'

  -- * Keys
  -- $keys
  -- ** Publishable API key
  , PublishableApiKey (..)
  -- ** Secret API key
  , ApiSecretKey (..), textToApiSecretKey
  -- ** Webhook secret
  , WebhookSecretKey (..), textToWebhookSecretKey

  -- * Identifiers
  , TokenId (..), CustomerId (..), ProductId (..)
  , PlanId (..), SubscriptionId (..), InvoiceId (..)
  , CouponId (..)

  -- * API Versioning
  , ApiVersion (..), RequestApiVersion (..)

  ) where

-- base
import Data.Data (Data)
import GHC.Generics (Generic)

-- bytestring
import qualified Data.ByteString

-- text
import qualified Data.Text
import qualified Data.Text.Encoding

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

{- | "To make the API as explorable as possible, accounts have test mode and
live mode API keys. There is no 'switch' for changing between modes, just use
the appropriate key to perform a live or test transaction. Requests made with
test mode credentials never hit the banking networks and incur no cost." -
<https://stripe.com/docs/api Stripe>

This library provides functions to convert back and forth between 'Mode' and
'Bool':

- 'isLiveMode' (and its inverse, 'isLiveMode'')
- 'isTestMode' (and its inverse, 'isTestMode'') -}

data Mode = LiveMode | TestMode
  deriving stock (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
(Mode -> Mode)
-> (Mode -> Mode)
-> (Int -> Mode)
-> (Mode -> Int)
-> (Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> Mode -> [Mode])
-> Enum Mode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum, Mode
Mode -> Mode -> Bounded Mode
forall a. a -> a -> Bounded a
maxBound :: Mode
$cmaxBound :: Mode
minBound :: Mode
$cminBound :: Mode
Bounded, Typeable Mode
DataType
Constr
Typeable Mode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Mode -> c Mode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Mode)
-> (Mode -> Constr)
-> (Mode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Mode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode))
-> ((forall b. Data b => b -> b) -> Mode -> Mode)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r)
-> (forall u. (forall d. Data d => d -> u) -> Mode -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> Data Mode
Mode -> DataType
Mode -> Constr
(forall b. Data b => b -> b) -> Mode -> Mode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
forall u. (forall d. Data d => d -> u) -> Mode -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cTestMode :: Constr
$cLiveMode :: Constr
$tMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapMp :: (forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapM :: (forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapQi :: Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQ :: (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
$cgmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Mode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
dataTypeOf :: Mode -> DataType
$cdataTypeOf :: Mode -> DataType
toConstr :: Mode -> Constr
$ctoConstr :: Mode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cp1Data :: Typeable Mode
Data, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mode x -> Mode
$cfrom :: forall x. Mode -> Rep Mode x
Generic)

-- | LiveMode → True; TestMode → False
isLiveMode :: Mode -> Bool
isLiveMode :: Mode -> Bool
isLiveMode Mode
LiveMode = Bool
True
isLiveMode Mode
TestMode = Bool
False

-- | True → LiveMode; False → TestMode
isLiveMode' :: Bool -> Mode
isLiveMode' :: Bool -> Mode
isLiveMode' Bool
True  = Mode
LiveMode
isLiveMode' Bool
False = Mode
TestMode

-- | LiveMode → False; TestMode → True
isTestMode :: Mode -> Bool
isTestMode :: Mode -> Bool
isTestMode Mode
LiveMode = Bool
False
isTestMode Mode
TestMode = Bool
True

-- | True → TestMode; False → LiveMode
isTestMode' :: Bool -> Mode
isTestMode' :: Bool -> Mode
isTestMode' Bool
True  = Mode
TestMode
isTestMode' Bool
False = Mode
LiveMode

{- | A pair of values of the same type, one for live mode and one for test mode.

For example, you may wish to use a value of type @'BothModes'
'PublishableApiKey'@ to represent your publishable API keys for both live mode
and test mode. -}

data BothModes a = BothModes { BothModes a -> a
liveMode :: a, BothModes a -> a
testMode :: a }
  deriving stock (BothModes a -> BothModes a -> Bool
(BothModes a -> BothModes a -> Bool)
-> (BothModes a -> BothModes a -> Bool) -> Eq (BothModes a)
forall a. Eq a => BothModes a -> BothModes a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BothModes a -> BothModes a -> Bool
$c/= :: forall a. Eq a => BothModes a -> BothModes a -> Bool
== :: BothModes a -> BothModes a -> Bool
$c== :: forall a. Eq a => BothModes a -> BothModes a -> Bool
Eq, Int -> BothModes a -> ShowS
[BothModes a] -> ShowS
BothModes a -> String
(Int -> BothModes a -> ShowS)
-> (BothModes a -> String)
-> ([BothModes a] -> ShowS)
-> Show (BothModes a)
forall a. Show a => Int -> BothModes a -> ShowS
forall a. Show a => [BothModes a] -> ShowS
forall a. Show a => BothModes a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BothModes a] -> ShowS
$cshowList :: forall a. Show a => [BothModes a] -> ShowS
show :: BothModes a -> String
$cshow :: forall a. Show a => BothModes a -> String
showsPrec :: Int -> BothModes a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BothModes a -> ShowS
Show, Typeable (BothModes a)
DataType
Constr
Typeable (BothModes a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BothModes a -> c (BothModes a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (BothModes a))
-> (BothModes a -> Constr)
-> (BothModes a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (BothModes a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (BothModes a)))
-> ((forall b. Data b => b -> b) -> BothModes a -> BothModes a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BothModes a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BothModes a -> r)
-> (forall u. (forall d. Data d => d -> u) -> BothModes a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BothModes a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a))
-> Data (BothModes a)
BothModes a -> DataType
BothModes a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (BothModes a))
(forall b. Data b => b -> b) -> BothModes a -> BothModes a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BothModes a -> c (BothModes a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BothModes a)
forall a. Data a => Typeable (BothModes a)
forall a. Data a => BothModes a -> DataType
forall a. Data a => BothModes a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> BothModes a -> BothModes a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> BothModes a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> BothModes a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BothModes a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BothModes a -> c (BothModes a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BothModes a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BothModes a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BothModes a -> u
forall u. (forall d. Data d => d -> u) -> BothModes a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BothModes a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BothModes a -> c (BothModes a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (BothModes a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BothModes a))
$cBothModes :: Constr
$tBothModes :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
gmapMp :: (forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
gmapM :: (forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> BothModes a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> BothModes a -> u
gmapQ :: (forall d. Data d => d -> u) -> BothModes a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> BothModes a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
gmapT :: (forall b. Data b => b -> b) -> BothModes a -> BothModes a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> BothModes a -> BothModes a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BothModes a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BothModes a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (BothModes a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BothModes a))
dataTypeOf :: BothModes a -> DataType
$cdataTypeOf :: forall a. Data a => BothModes a -> DataType
toConstr :: BothModes a -> Constr
$ctoConstr :: forall a. Data a => BothModes a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BothModes a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BothModes a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BothModes a -> c (BothModes a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BothModes a -> c (BothModes a)
$cp1Data :: forall a. Data a => Typeable (BothModes a)
Data, (forall x. BothModes a -> Rep (BothModes a) x)
-> (forall x. Rep (BothModes a) x -> BothModes a)
-> Generic (BothModes a)
forall x. Rep (BothModes a) x -> BothModes a
forall x. BothModes a -> Rep (BothModes a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BothModes a) x -> BothModes a
forall a x. BothModes a -> Rep (BothModes a) x
$cto :: forall a x. Rep (BothModes a) x -> BothModes a
$cfrom :: forall a x. BothModes a -> Rep (BothModes a) x
Generic, a -> BothModes b -> BothModes a
(a -> b) -> BothModes a -> BothModes b
(forall a b. (a -> b) -> BothModes a -> BothModes b)
-> (forall a b. a -> BothModes b -> BothModes a)
-> Functor BothModes
forall a b. a -> BothModes b -> BothModes a
forall a b. (a -> b) -> BothModes a -> BothModes b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BothModes b -> BothModes a
$c<$ :: forall a b. a -> BothModes b -> BothModes a
fmap :: (a -> b) -> BothModes a -> BothModes b
$cfmap :: forall a b. (a -> b) -> BothModes a -> BothModes b
Functor)

applyMode :: Mode -> BothModes a -> a
applyMode :: Mode -> BothModes a -> a
applyMode Mode
LiveMode = BothModes a -> a
forall a. BothModes a -> a
liveMode
applyMode Mode
TestMode = BothModes a -> a
forall a. BothModes a -> a
testMode

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

{- $keys

Each Stripe account has a pair of API keys involved in making requests to the
Stripe API:

  * The publishable key ('PublishableApiKey')
  * The secret key ('ApiSecretKey')

Each webhook endpoint you set up has a "signing secret" ('WebhookSecretKey')
that you use to verify the authenticity of the webhook events you receive *from*
Stripe. -}

{- | API secret keys are used to make requests to Stripe.

"Authenticate your account when using the API by including your secret API key
in the request. You can manage your API keys in the Dashboard. Your API keys
carry many privileges, so be sure to keep them secret!" -
<https://stripe.com/docs/api#authentication Stripe>

The key is represented here as a 'Data.ByteString.ByteString', but you are
likely have the data as a 'Data.Text.Text' value. You can use
'textToApiSecretKey' to do this conversion. -}

newtype ApiSecretKey = ApiSecretKey Data.ByteString.ByteString
  deriving stock (ApiSecretKey -> ApiSecretKey -> Bool
(ApiSecretKey -> ApiSecretKey -> Bool)
-> (ApiSecretKey -> ApiSecretKey -> Bool) -> Eq ApiSecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiSecretKey -> ApiSecretKey -> Bool
$c/= :: ApiSecretKey -> ApiSecretKey -> Bool
== :: ApiSecretKey -> ApiSecretKey -> Bool
$c== :: ApiSecretKey -> ApiSecretKey -> Bool
Eq, Eq ApiSecretKey
Eq ApiSecretKey
-> (ApiSecretKey -> ApiSecretKey -> Ordering)
-> (ApiSecretKey -> ApiSecretKey -> Bool)
-> (ApiSecretKey -> ApiSecretKey -> Bool)
-> (ApiSecretKey -> ApiSecretKey -> Bool)
-> (ApiSecretKey -> ApiSecretKey -> Bool)
-> (ApiSecretKey -> ApiSecretKey -> ApiSecretKey)
-> (ApiSecretKey -> ApiSecretKey -> ApiSecretKey)
-> Ord ApiSecretKey
ApiSecretKey -> ApiSecretKey -> Bool
ApiSecretKey -> ApiSecretKey -> Ordering
ApiSecretKey -> ApiSecretKey -> ApiSecretKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
$cmin :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
max :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
$cmax :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
>= :: ApiSecretKey -> ApiSecretKey -> Bool
$c>= :: ApiSecretKey -> ApiSecretKey -> Bool
> :: ApiSecretKey -> ApiSecretKey -> Bool
$c> :: ApiSecretKey -> ApiSecretKey -> Bool
<= :: ApiSecretKey -> ApiSecretKey -> Bool
$c<= :: ApiSecretKey -> ApiSecretKey -> Bool
< :: ApiSecretKey -> ApiSecretKey -> Bool
$c< :: ApiSecretKey -> ApiSecretKey -> Bool
compare :: ApiSecretKey -> ApiSecretKey -> Ordering
$ccompare :: ApiSecretKey -> ApiSecretKey -> Ordering
$cp1Ord :: Eq ApiSecretKey
Ord)

{- | Publishable API keys are used in client-side code.

"Publishable API keys are meant solely to identify your account with Stripe,
they aren’t secret. In other words, they can safely be published in places like
your Stripe.js JavaScript code, or in an Android or iPhone app. Publishable keys
only have the power to create tokens." - <https://stripe.com/docs/keys Stripe>
-}

newtype PublishableApiKey = PublishableApiKey Data.Text.Text
  deriving stock (PublishableApiKey -> PublishableApiKey -> Bool
(PublishableApiKey -> PublishableApiKey -> Bool)
-> (PublishableApiKey -> PublishableApiKey -> Bool)
-> Eq PublishableApiKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishableApiKey -> PublishableApiKey -> Bool
$c/= :: PublishableApiKey -> PublishableApiKey -> Bool
== :: PublishableApiKey -> PublishableApiKey -> Bool
$c== :: PublishableApiKey -> PublishableApiKey -> Bool
Eq, Eq PublishableApiKey
Eq PublishableApiKey
-> (PublishableApiKey -> PublishableApiKey -> Ordering)
-> (PublishableApiKey -> PublishableApiKey -> Bool)
-> (PublishableApiKey -> PublishableApiKey -> Bool)
-> (PublishableApiKey -> PublishableApiKey -> Bool)
-> (PublishableApiKey -> PublishableApiKey -> Bool)
-> (PublishableApiKey -> PublishableApiKey -> PublishableApiKey)
-> (PublishableApiKey -> PublishableApiKey -> PublishableApiKey)
-> Ord PublishableApiKey
PublishableApiKey -> PublishableApiKey -> Bool
PublishableApiKey -> PublishableApiKey -> Ordering
PublishableApiKey -> PublishableApiKey -> PublishableApiKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
$cmin :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
max :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
$cmax :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
>= :: PublishableApiKey -> PublishableApiKey -> Bool
$c>= :: PublishableApiKey -> PublishableApiKey -> Bool
> :: PublishableApiKey -> PublishableApiKey -> Bool
$c> :: PublishableApiKey -> PublishableApiKey -> Bool
<= :: PublishableApiKey -> PublishableApiKey -> Bool
$c<= :: PublishableApiKey -> PublishableApiKey -> Bool
< :: PublishableApiKey -> PublishableApiKey -> Bool
$c< :: PublishableApiKey -> PublishableApiKey -> Bool
compare :: PublishableApiKey -> PublishableApiKey -> Ordering
$ccompare :: PublishableApiKey -> PublishableApiKey -> Ordering
$cp1Ord :: Eq PublishableApiKey
Ord, Int -> PublishableApiKey -> ShowS
[PublishableApiKey] -> ShowS
PublishableApiKey -> String
(Int -> PublishableApiKey -> ShowS)
-> (PublishableApiKey -> String)
-> ([PublishableApiKey] -> ShowS)
-> Show PublishableApiKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishableApiKey] -> ShowS
$cshowList :: [PublishableApiKey] -> ShowS
show :: PublishableApiKey -> String
$cshow :: PublishableApiKey -> String
showsPrec :: Int -> PublishableApiKey -> ShowS
$cshowsPrec :: Int -> PublishableApiKey -> ShowS
Show, Typeable PublishableApiKey
DataType
Constr
Typeable PublishableApiKey
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> PublishableApiKey
    -> c PublishableApiKey)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PublishableApiKey)
-> (PublishableApiKey -> Constr)
-> (PublishableApiKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PublishableApiKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PublishableApiKey))
-> ((forall b. Data b => b -> b)
    -> PublishableApiKey -> PublishableApiKey)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PublishableApiKey -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PublishableApiKey -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PublishableApiKey -> m PublishableApiKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PublishableApiKey -> m PublishableApiKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PublishableApiKey -> m PublishableApiKey)
-> Data PublishableApiKey
PublishableApiKey -> DataType
PublishableApiKey -> Constr
(forall b. Data b => b -> b)
-> PublishableApiKey -> PublishableApiKey
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublishableApiKey -> c PublishableApiKey
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublishableApiKey
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PublishableApiKey -> u
forall u. (forall d. Data d => d -> u) -> PublishableApiKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublishableApiKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublishableApiKey -> c PublishableApiKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublishableApiKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublishableApiKey)
$cPublishableApiKey :: Constr
$tPublishableApiKey :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
gmapMp :: (forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
gmapM :: (forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
gmapQi :: Int -> (forall d. Data d => d -> u) -> PublishableApiKey -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PublishableApiKey -> u
gmapQ :: (forall d. Data d => d -> u) -> PublishableApiKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PublishableApiKey -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
gmapT :: (forall b. Data b => b -> b)
-> PublishableApiKey -> PublishableApiKey
$cgmapT :: (forall b. Data b => b -> b)
-> PublishableApiKey -> PublishableApiKey
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublishableApiKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublishableApiKey)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PublishableApiKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublishableApiKey)
dataTypeOf :: PublishableApiKey -> DataType
$cdataTypeOf :: PublishableApiKey -> DataType
toConstr :: PublishableApiKey -> Constr
$ctoConstr :: PublishableApiKey -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublishableApiKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublishableApiKey
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublishableApiKey -> c PublishableApiKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublishableApiKey -> c PublishableApiKey
$cp1Data :: Typeable PublishableApiKey
Data, (forall x. PublishableApiKey -> Rep PublishableApiKey x)
-> (forall x. Rep PublishableApiKey x -> PublishableApiKey)
-> Generic PublishableApiKey
forall x. Rep PublishableApiKey x -> PublishableApiKey
forall x. PublishableApiKey -> Rep PublishableApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublishableApiKey x -> PublishableApiKey
$cfrom :: forall x. PublishableApiKey -> Rep PublishableApiKey x
Generic)

{- | Webhook secrets are used to verify the authenticity of webhook events that
you receive from Stripe.

"Stripe can optionally sign the webhook events it sends to your endpoints. We do
so by including a signature in each event’s Stripe-Signature header. This allows
you to validate that the events were sent by Stripe, not by a third party. [...]
Before you can verify signatures, you need to retrieve your endpoint’s secret
from your Dashboard’s Webhooks settings. -
<https://stripe.com/docs/webhooks/signatures Stripe>

The key is represented here as a 'Data.ByteString.ByteString', but you are
likely have the data as a 'Data.Text.Text' value. You can use
'textToWebhookSecretKey' to do this conversion. -}

newtype WebhookSecretKey = WebhookSecretKey Data.ByteString.ByteString
  deriving stock (WebhookSecretKey -> WebhookSecretKey -> Bool
(WebhookSecretKey -> WebhookSecretKey -> Bool)
-> (WebhookSecretKey -> WebhookSecretKey -> Bool)
-> Eq WebhookSecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c/= :: WebhookSecretKey -> WebhookSecretKey -> Bool
== :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c== :: WebhookSecretKey -> WebhookSecretKey -> Bool
Eq, Eq WebhookSecretKey
Eq WebhookSecretKey
-> (WebhookSecretKey -> WebhookSecretKey -> Ordering)
-> (WebhookSecretKey -> WebhookSecretKey -> Bool)
-> (WebhookSecretKey -> WebhookSecretKey -> Bool)
-> (WebhookSecretKey -> WebhookSecretKey -> Bool)
-> (WebhookSecretKey -> WebhookSecretKey -> Bool)
-> (WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey)
-> (WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey)
-> Ord WebhookSecretKey
WebhookSecretKey -> WebhookSecretKey -> Bool
WebhookSecretKey -> WebhookSecretKey -> Ordering
WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
$cmin :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
max :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
$cmax :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
>= :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c>= :: WebhookSecretKey -> WebhookSecretKey -> Bool
> :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c> :: WebhookSecretKey -> WebhookSecretKey -> Bool
<= :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c<= :: WebhookSecretKey -> WebhookSecretKey -> Bool
< :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c< :: WebhookSecretKey -> WebhookSecretKey -> Bool
compare :: WebhookSecretKey -> WebhookSecretKey -> Ordering
$ccompare :: WebhookSecretKey -> WebhookSecretKey -> Ordering
$cp1Ord :: Eq WebhookSecretKey
Ord)

{- | Convert a 'Data.Text.Text' representation of a Stripe API key (that looks
something like @"sk_test_BQokikJOvBiI2HlWgH4olfQ2"@) to an 'ApiSecretKey'. -}

textToApiSecretKey :: Data.Text.Text -> ApiSecretKey
textToApiSecretKey :: Text -> ApiSecretKey
textToApiSecretKey = ByteString -> ApiSecretKey
ApiSecretKey (ByteString -> ApiSecretKey)
-> (Text -> ByteString) -> Text -> ApiSecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Data.Text.Encoding.encodeUtf8

{- | Convert a 'Data.Text.Text' representation of a Stripe webhook secret (that
looks something like @"whsec_ojm5cmJMGMTw3w7ngjI7mgkRsFGLRtCt"@) to a
'WebhookSecretKey'. -}

textToWebhookSecretKey :: Data.Text.Text -> WebhookSecretKey
textToWebhookSecretKey :: Text -> WebhookSecretKey
textToWebhookSecretKey = ByteString -> WebhookSecretKey
WebhookSecretKey (ByteString -> WebhookSecretKey)
-> (Text -> ByteString) -> Text -> WebhookSecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Data.Text.Encoding.encodeUtf8

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

{- | Identifier of a Stripe "token", which represents a payment source that was
submitted by a user to Stripe.

"This ensures that no sensitive card data touches your server, and allows your
integration to operate in a PCI-compliant way." -
<https://stripe.com/docs/api/tokens Stripe> -}

newtype TokenId = TokenId Data.Text.Text
  deriving stock (TokenId -> TokenId -> Bool
(TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool) -> Eq TokenId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenId -> TokenId -> Bool
$c/= :: TokenId -> TokenId -> Bool
== :: TokenId -> TokenId -> Bool
$c== :: TokenId -> TokenId -> Bool
Eq, Eq TokenId
Eq TokenId
-> (TokenId -> TokenId -> Ordering)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> Bool)
-> (TokenId -> TokenId -> TokenId)
-> (TokenId -> TokenId -> TokenId)
-> Ord TokenId
TokenId -> TokenId -> Bool
TokenId -> TokenId -> Ordering
TokenId -> TokenId -> TokenId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TokenId -> TokenId -> TokenId
$cmin :: TokenId -> TokenId -> TokenId
max :: TokenId -> TokenId -> TokenId
$cmax :: TokenId -> TokenId -> TokenId
>= :: TokenId -> TokenId -> Bool
$c>= :: TokenId -> TokenId -> Bool
> :: TokenId -> TokenId -> Bool
$c> :: TokenId -> TokenId -> Bool
<= :: TokenId -> TokenId -> Bool
$c<= :: TokenId -> TokenId -> Bool
< :: TokenId -> TokenId -> Bool
$c< :: TokenId -> TokenId -> Bool
compare :: TokenId -> TokenId -> Ordering
$ccompare :: TokenId -> TokenId -> Ordering
$cp1Ord :: Eq TokenId
Ord, Int -> TokenId -> ShowS
[TokenId] -> ShowS
TokenId -> String
(Int -> TokenId -> ShowS)
-> (TokenId -> String) -> ([TokenId] -> ShowS) -> Show TokenId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenId] -> ShowS
$cshowList :: [TokenId] -> ShowS
show :: TokenId -> String
$cshow :: TokenId -> String
showsPrec :: Int -> TokenId -> ShowS
$cshowsPrec :: Int -> TokenId -> ShowS
Show, Typeable TokenId
DataType
Constr
Typeable TokenId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TokenId -> c TokenId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TokenId)
-> (TokenId -> Constr)
-> (TokenId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TokenId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenId))
-> ((forall b. Data b => b -> b) -> TokenId -> TokenId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenId -> r)
-> (forall u. (forall d. Data d => d -> u) -> TokenId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TokenId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TokenId -> m TokenId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenId -> m TokenId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenId -> m TokenId)
-> Data TokenId
TokenId -> DataType
TokenId -> Constr
(forall b. Data b => b -> b) -> TokenId -> TokenId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenId -> c TokenId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TokenId -> u
forall u. (forall d. Data d => d -> u) -> TokenId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenId -> m TokenId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenId -> m TokenId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenId -> c TokenId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenId)
$cTokenId :: Constr
$tTokenId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TokenId -> m TokenId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenId -> m TokenId
gmapMp :: (forall d. Data d => d -> m d) -> TokenId -> m TokenId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenId -> m TokenId
gmapM :: (forall d. Data d => d -> m d) -> TokenId -> m TokenId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenId -> m TokenId
gmapQi :: Int -> (forall d. Data d => d -> u) -> TokenId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenId -> u
gmapQ :: (forall d. Data d => d -> u) -> TokenId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
gmapT :: (forall b. Data b => b -> b) -> TokenId -> TokenId
$cgmapT :: (forall b. Data b => b -> b) -> TokenId -> TokenId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TokenId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenId)
dataTypeOf :: TokenId -> DataType
$cdataTypeOf :: TokenId -> DataType
toConstr :: TokenId -> Constr
$ctoConstr :: TokenId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenId -> c TokenId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenId -> c TokenId
$cp1Data :: Typeable TokenId
Data, (forall x. TokenId -> Rep TokenId x)
-> (forall x. Rep TokenId x -> TokenId) -> Generic TokenId
forall x. Rep TokenId x -> TokenId
forall x. TokenId -> Rep TokenId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenId x -> TokenId
$cfrom :: forall x. TokenId -> Rep TokenId x
Generic)

{- | A customer identifier assigned by Stripe.

"Customer objects allow you to perform recurring charges, and to track multiple
charges, that are associated with the same customer." -
<https://stripe.com/docs/api/customers Stripe> -}

newtype CustomerId = CustomerId Data.Text.Text
  deriving stock (CustomerId -> CustomerId -> Bool
(CustomerId -> CustomerId -> Bool)
-> (CustomerId -> CustomerId -> Bool) -> Eq CustomerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomerId -> CustomerId -> Bool
$c/= :: CustomerId -> CustomerId -> Bool
== :: CustomerId -> CustomerId -> Bool
$c== :: CustomerId -> CustomerId -> Bool
Eq, Eq CustomerId
Eq CustomerId
-> (CustomerId -> CustomerId -> Ordering)
-> (CustomerId -> CustomerId -> Bool)
-> (CustomerId -> CustomerId -> Bool)
-> (CustomerId -> CustomerId -> Bool)
-> (CustomerId -> CustomerId -> Bool)
-> (CustomerId -> CustomerId -> CustomerId)
-> (CustomerId -> CustomerId -> CustomerId)
-> Ord CustomerId
CustomerId -> CustomerId -> Bool
CustomerId -> CustomerId -> Ordering
CustomerId -> CustomerId -> CustomerId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CustomerId -> CustomerId -> CustomerId
$cmin :: CustomerId -> CustomerId -> CustomerId
max :: CustomerId -> CustomerId -> CustomerId
$cmax :: CustomerId -> CustomerId -> CustomerId
>= :: CustomerId -> CustomerId -> Bool
$c>= :: CustomerId -> CustomerId -> Bool
> :: CustomerId -> CustomerId -> Bool
$c> :: CustomerId -> CustomerId -> Bool
<= :: CustomerId -> CustomerId -> Bool
$c<= :: CustomerId -> CustomerId -> Bool
< :: CustomerId -> CustomerId -> Bool
$c< :: CustomerId -> CustomerId -> Bool
compare :: CustomerId -> CustomerId -> Ordering
$ccompare :: CustomerId -> CustomerId -> Ordering
$cp1Ord :: Eq CustomerId
Ord, Int -> CustomerId -> ShowS
[CustomerId] -> ShowS
CustomerId -> String
(Int -> CustomerId -> ShowS)
-> (CustomerId -> String)
-> ([CustomerId] -> ShowS)
-> Show CustomerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomerId] -> ShowS
$cshowList :: [CustomerId] -> ShowS
show :: CustomerId -> String
$cshow :: CustomerId -> String
showsPrec :: Int -> CustomerId -> ShowS
$cshowsPrec :: Int -> CustomerId -> ShowS
Show, Typeable CustomerId
DataType
Constr
Typeable CustomerId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CustomerId -> c CustomerId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CustomerId)
-> (CustomerId -> Constr)
-> (CustomerId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CustomerId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CustomerId))
-> ((forall b. Data b => b -> b) -> CustomerId -> CustomerId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CustomerId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CustomerId -> r)
-> (forall u. (forall d. Data d => d -> u) -> CustomerId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CustomerId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CustomerId -> m CustomerId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CustomerId -> m CustomerId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CustomerId -> m CustomerId)
-> Data CustomerId
CustomerId -> DataType
CustomerId -> Constr
(forall b. Data b => b -> b) -> CustomerId -> CustomerId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CustomerId -> c CustomerId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomerId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CustomerId -> u
forall u. (forall d. Data d => d -> u) -> CustomerId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomerId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CustomerId -> c CustomerId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomerId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CustomerId)
$cCustomerId :: Constr
$tCustomerId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
gmapMp :: (forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
gmapM :: (forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
gmapQi :: Int -> (forall d. Data d => d -> u) -> CustomerId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CustomerId -> u
gmapQ :: (forall d. Data d => d -> u) -> CustomerId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CustomerId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
gmapT :: (forall b. Data b => b -> b) -> CustomerId -> CustomerId
$cgmapT :: (forall b. Data b => b -> b) -> CustomerId -> CustomerId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CustomerId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CustomerId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CustomerId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomerId)
dataTypeOf :: CustomerId -> DataType
$cdataTypeOf :: CustomerId -> DataType
toConstr :: CustomerId -> Constr
$ctoConstr :: CustomerId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomerId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomerId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CustomerId -> c CustomerId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CustomerId -> c CustomerId
$cp1Data :: Typeable CustomerId
Data, (forall x. CustomerId -> Rep CustomerId x)
-> (forall x. Rep CustomerId x -> CustomerId) -> Generic CustomerId
forall x. Rep CustomerId x -> CustomerId
forall x. CustomerId -> Rep CustomerId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomerId x -> CustomerId
$cfrom :: forall x. CustomerId -> Rep CustomerId x
Generic)

{- | The ID of a Stripe product.

"Product objects describe items that your customers can subscribe to with a
Subscription. An associated Plan determines the product pricing." -
<https://stripe.com/docs/api/service_products Stripe> -}

newtype ProductId = ProductId Data.Text.Text
  deriving stock (ProductId -> ProductId -> Bool
(ProductId -> ProductId -> Bool)
-> (ProductId -> ProductId -> Bool) -> Eq ProductId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductId -> ProductId -> Bool
$c/= :: ProductId -> ProductId -> Bool
== :: ProductId -> ProductId -> Bool
$c== :: ProductId -> ProductId -> Bool
Eq, Eq ProductId
Eq ProductId
-> (ProductId -> ProductId -> Ordering)
-> (ProductId -> ProductId -> Bool)
-> (ProductId -> ProductId -> Bool)
-> (ProductId -> ProductId -> Bool)
-> (ProductId -> ProductId -> Bool)
-> (ProductId -> ProductId -> ProductId)
-> (ProductId -> ProductId -> ProductId)
-> Ord ProductId
ProductId -> ProductId -> Bool
ProductId -> ProductId -> Ordering
ProductId -> ProductId -> ProductId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ProductId -> ProductId -> ProductId
$cmin :: ProductId -> ProductId -> ProductId
max :: ProductId -> ProductId -> ProductId
$cmax :: ProductId -> ProductId -> ProductId
>= :: ProductId -> ProductId -> Bool
$c>= :: ProductId -> ProductId -> Bool
> :: ProductId -> ProductId -> Bool
$c> :: ProductId -> ProductId -> Bool
<= :: ProductId -> ProductId -> Bool
$c<= :: ProductId -> ProductId -> Bool
< :: ProductId -> ProductId -> Bool
$c< :: ProductId -> ProductId -> Bool
compare :: ProductId -> ProductId -> Ordering
$ccompare :: ProductId -> ProductId -> Ordering
$cp1Ord :: Eq ProductId
Ord, Int -> ProductId -> ShowS
[ProductId] -> ShowS
ProductId -> String
(Int -> ProductId -> ShowS)
-> (ProductId -> String)
-> ([ProductId] -> ShowS)
-> Show ProductId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductId] -> ShowS
$cshowList :: [ProductId] -> ShowS
show :: ProductId -> String
$cshow :: ProductId -> String
showsPrec :: Int -> ProductId -> ShowS
$cshowsPrec :: Int -> ProductId -> ShowS
Show, Typeable ProductId
DataType
Constr
Typeable ProductId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ProductId -> c ProductId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ProductId)
-> (ProductId -> Constr)
-> (ProductId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ProductId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProductId))
-> ((forall b. Data b => b -> b) -> ProductId -> ProductId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ProductId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ProductId -> r)
-> (forall u. (forall d. Data d => d -> u) -> ProductId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ProductId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ProductId -> m ProductId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ProductId -> m ProductId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ProductId -> m ProductId)
-> Data ProductId
ProductId -> DataType
ProductId -> Constr
(forall b. Data b => b -> b) -> ProductId -> ProductId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProductId -> c ProductId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProductId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ProductId -> u
forall u. (forall d. Data d => d -> u) -> ProductId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProductId -> m ProductId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProductId -> m ProductId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProductId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProductId -> c ProductId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProductId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProductId)
$cProductId :: Constr
$tProductId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ProductId -> m ProductId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProductId -> m ProductId
gmapMp :: (forall d. Data d => d -> m d) -> ProductId -> m ProductId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProductId -> m ProductId
gmapM :: (forall d. Data d => d -> m d) -> ProductId -> m ProductId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProductId -> m ProductId
gmapQi :: Int -> (forall d. Data d => d -> u) -> ProductId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProductId -> u
gmapQ :: (forall d. Data d => d -> u) -> ProductId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ProductId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
gmapT :: (forall b. Data b => b -> b) -> ProductId -> ProductId
$cgmapT :: (forall b. Data b => b -> b) -> ProductId -> ProductId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProductId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProductId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ProductId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProductId)
dataTypeOf :: ProductId -> DataType
$cdataTypeOf :: ProductId -> DataType
toConstr :: ProductId -> Constr
$ctoConstr :: ProductId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProductId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProductId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProductId -> c ProductId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProductId -> c ProductId
$cp1Data :: Typeable ProductId
Data, (forall x. ProductId -> Rep ProductId x)
-> (forall x. Rep ProductId x -> ProductId) -> Generic ProductId
forall x. Rep ProductId x -> ProductId
forall x. ProductId -> Rep ProductId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProductId x -> ProductId
$cfrom :: forall x. ProductId -> Rep ProductId x
Generic)

{- | The ID of a Stripe subscription plan.

"Plans define the base price, currency, and billing cycle for subscriptions. For
example, you might have a $5/month plan that provides limited access to your
products, and a $15/month plan that allows full access." -
<https://stripe.com/docs/api/plans Stripe> -}

newtype PlanId = PlanId Data.Text.Text
  deriving stock (PlanId -> PlanId -> Bool
(PlanId -> PlanId -> Bool)
-> (PlanId -> PlanId -> Bool) -> Eq PlanId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanId -> PlanId -> Bool
$c/= :: PlanId -> PlanId -> Bool
== :: PlanId -> PlanId -> Bool
$c== :: PlanId -> PlanId -> Bool
Eq, Eq PlanId
Eq PlanId
-> (PlanId -> PlanId -> Ordering)
-> (PlanId -> PlanId -> Bool)
-> (PlanId -> PlanId -> Bool)
-> (PlanId -> PlanId -> Bool)
-> (PlanId -> PlanId -> Bool)
-> (PlanId -> PlanId -> PlanId)
-> (PlanId -> PlanId -> PlanId)
-> Ord PlanId
PlanId -> PlanId -> Bool
PlanId -> PlanId -> Ordering
PlanId -> PlanId -> PlanId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlanId -> PlanId -> PlanId
$cmin :: PlanId -> PlanId -> PlanId
max :: PlanId -> PlanId -> PlanId
$cmax :: PlanId -> PlanId -> PlanId
>= :: PlanId -> PlanId -> Bool
$c>= :: PlanId -> PlanId -> Bool
> :: PlanId -> PlanId -> Bool
$c> :: PlanId -> PlanId -> Bool
<= :: PlanId -> PlanId -> Bool
$c<= :: PlanId -> PlanId -> Bool
< :: PlanId -> PlanId -> Bool
$c< :: PlanId -> PlanId -> Bool
compare :: PlanId -> PlanId -> Ordering
$ccompare :: PlanId -> PlanId -> Ordering
$cp1Ord :: Eq PlanId
Ord, Int -> PlanId -> ShowS
[PlanId] -> ShowS
PlanId -> String
(Int -> PlanId -> ShowS)
-> (PlanId -> String) -> ([PlanId] -> ShowS) -> Show PlanId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlanId] -> ShowS
$cshowList :: [PlanId] -> ShowS
show :: PlanId -> String
$cshow :: PlanId -> String
showsPrec :: Int -> PlanId -> ShowS
$cshowsPrec :: Int -> PlanId -> ShowS
Show, Typeable PlanId
DataType
Constr
Typeable PlanId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PlanId -> c PlanId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PlanId)
-> (PlanId -> Constr)
-> (PlanId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PlanId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlanId))
-> ((forall b. Data b => b -> b) -> PlanId -> PlanId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PlanId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PlanId -> r)
-> (forall u. (forall d. Data d => d -> u) -> PlanId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PlanId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PlanId -> m PlanId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PlanId -> m PlanId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PlanId -> m PlanId)
-> Data PlanId
PlanId -> DataType
PlanId -> Constr
(forall b. Data b => b -> b) -> PlanId -> PlanId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanId -> c PlanId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PlanId -> u
forall u. (forall d. Data d => d -> u) -> PlanId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlanId -> m PlanId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanId -> m PlanId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanId -> c PlanId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlanId)
$cPlanId :: Constr
$tPlanId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PlanId -> m PlanId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanId -> m PlanId
gmapMp :: (forall d. Data d => d -> m d) -> PlanId -> m PlanId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanId -> m PlanId
gmapM :: (forall d. Data d => d -> m d) -> PlanId -> m PlanId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlanId -> m PlanId
gmapQi :: Int -> (forall d. Data d => d -> u) -> PlanId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlanId -> u
gmapQ :: (forall d. Data d => d -> u) -> PlanId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlanId -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
gmapT :: (forall b. Data b => b -> b) -> PlanId -> PlanId
$cgmapT :: (forall b. Data b => b -> b) -> PlanId -> PlanId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlanId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlanId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PlanId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanId)
dataTypeOf :: PlanId -> DataType
$cdataTypeOf :: PlanId -> DataType
toConstr :: PlanId -> Constr
$ctoConstr :: PlanId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanId -> c PlanId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanId -> c PlanId
$cp1Data :: Typeable PlanId
Data, (forall x. PlanId -> Rep PlanId x)
-> (forall x. Rep PlanId x -> PlanId) -> Generic PlanId
forall x. Rep PlanId x -> PlanId
forall x. PlanId -> Rep PlanId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlanId x -> PlanId
$cfrom :: forall x. PlanId -> Rep PlanId x
Generic)

{- | Identifier for a customer's subscription to a product.

"Subscriptions allow you to charge a customer on a recurring basis. A
subscription ties a customer to a particular plan you've created." -
<https://stripe.com/docs/api/subscriptions Stripe> -}

newtype SubscriptionId = SubscriptionId Data.Text.Text
  deriving stock (SubscriptionId -> SubscriptionId -> Bool
(SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool) -> Eq SubscriptionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscriptionId -> SubscriptionId -> Bool
$c/= :: SubscriptionId -> SubscriptionId -> Bool
== :: SubscriptionId -> SubscriptionId -> Bool
$c== :: SubscriptionId -> SubscriptionId -> Bool
Eq, Eq SubscriptionId
Eq SubscriptionId
-> (SubscriptionId -> SubscriptionId -> Ordering)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> Bool)
-> (SubscriptionId -> SubscriptionId -> SubscriptionId)
-> (SubscriptionId -> SubscriptionId -> SubscriptionId)
-> Ord SubscriptionId
SubscriptionId -> SubscriptionId -> Bool
SubscriptionId -> SubscriptionId -> Ordering
SubscriptionId -> SubscriptionId -> SubscriptionId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SubscriptionId -> SubscriptionId -> SubscriptionId
$cmin :: SubscriptionId -> SubscriptionId -> SubscriptionId
max :: SubscriptionId -> SubscriptionId -> SubscriptionId
$cmax :: SubscriptionId -> SubscriptionId -> SubscriptionId
>= :: SubscriptionId -> SubscriptionId -> Bool
$c>= :: SubscriptionId -> SubscriptionId -> Bool
> :: SubscriptionId -> SubscriptionId -> Bool
$c> :: SubscriptionId -> SubscriptionId -> Bool
<= :: SubscriptionId -> SubscriptionId -> Bool
$c<= :: SubscriptionId -> SubscriptionId -> Bool
< :: SubscriptionId -> SubscriptionId -> Bool
$c< :: SubscriptionId -> SubscriptionId -> Bool
compare :: SubscriptionId -> SubscriptionId -> Ordering
$ccompare :: SubscriptionId -> SubscriptionId -> Ordering
$cp1Ord :: Eq SubscriptionId
Ord, Int -> SubscriptionId -> ShowS
[SubscriptionId] -> ShowS
SubscriptionId -> String
(Int -> SubscriptionId -> ShowS)
-> (SubscriptionId -> String)
-> ([SubscriptionId] -> ShowS)
-> Show SubscriptionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionId] -> ShowS
$cshowList :: [SubscriptionId] -> ShowS
show :: SubscriptionId -> String
$cshow :: SubscriptionId -> String
showsPrec :: Int -> SubscriptionId -> ShowS
$cshowsPrec :: Int -> SubscriptionId -> ShowS
Show, Typeable SubscriptionId
DataType
Constr
Typeable SubscriptionId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SubscriptionId)
-> (SubscriptionId -> Constr)
-> (SubscriptionId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SubscriptionId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SubscriptionId))
-> ((forall b. Data b => b -> b)
    -> SubscriptionId -> SubscriptionId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SubscriptionId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SubscriptionId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SubscriptionId -> m SubscriptionId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubscriptionId -> m SubscriptionId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubscriptionId -> m SubscriptionId)
-> Data SubscriptionId
SubscriptionId -> DataType
SubscriptionId -> Constr
(forall b. Data b => b -> b) -> SubscriptionId -> SubscriptionId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubscriptionId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SubscriptionId -> u
forall u. (forall d. Data d => d -> u) -> SubscriptionId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubscriptionId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubscriptionId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubscriptionId)
$cSubscriptionId :: Constr
$tSubscriptionId :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
gmapMp :: (forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
gmapM :: (forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
gmapQi :: Int -> (forall d. Data d => d -> u) -> SubscriptionId -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SubscriptionId -> u
gmapQ :: (forall d. Data d => d -> u) -> SubscriptionId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SubscriptionId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
gmapT :: (forall b. Data b => b -> b) -> SubscriptionId -> SubscriptionId
$cgmapT :: (forall b. Data b => b -> b) -> SubscriptionId -> SubscriptionId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubscriptionId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubscriptionId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SubscriptionId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubscriptionId)
dataTypeOf :: SubscriptionId -> DataType
$cdataTypeOf :: SubscriptionId -> DataType
toConstr :: SubscriptionId -> Constr
$ctoConstr :: SubscriptionId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubscriptionId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubscriptionId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId
$cp1Data :: Typeable SubscriptionId
Data, (forall x. SubscriptionId -> Rep SubscriptionId x)
-> (forall x. Rep SubscriptionId x -> SubscriptionId)
-> Generic SubscriptionId
forall x. Rep SubscriptionId x -> SubscriptionId
forall x. SubscriptionId -> Rep SubscriptionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubscriptionId x -> SubscriptionId
$cfrom :: forall x. SubscriptionId -> Rep SubscriptionId x
Generic)

{- | The ID of a Stripe invoice.

"Invoices are statements of amounts owed by a customer, and are either generated
one-off, or generated periodically from a subscription." -
<https://stripe.com/docs/api/invoices Stripe> -}

newtype InvoiceId = InvoiceId Data.Text.Text
  deriving stock (InvoiceId -> InvoiceId -> Bool
(InvoiceId -> InvoiceId -> Bool)
-> (InvoiceId -> InvoiceId -> Bool) -> Eq InvoiceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvoiceId -> InvoiceId -> Bool
$c/= :: InvoiceId -> InvoiceId -> Bool
== :: InvoiceId -> InvoiceId -> Bool
$c== :: InvoiceId -> InvoiceId -> Bool
Eq, Eq InvoiceId
Eq InvoiceId
-> (InvoiceId -> InvoiceId -> Ordering)
-> (InvoiceId -> InvoiceId -> Bool)
-> (InvoiceId -> InvoiceId -> Bool)
-> (InvoiceId -> InvoiceId -> Bool)
-> (InvoiceId -> InvoiceId -> Bool)
-> (InvoiceId -> InvoiceId -> InvoiceId)
-> (InvoiceId -> InvoiceId -> InvoiceId)
-> Ord InvoiceId
InvoiceId -> InvoiceId -> Bool
InvoiceId -> InvoiceId -> Ordering
InvoiceId -> InvoiceId -> InvoiceId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InvoiceId -> InvoiceId -> InvoiceId
$cmin :: InvoiceId -> InvoiceId -> InvoiceId
max :: InvoiceId -> InvoiceId -> InvoiceId
$cmax :: InvoiceId -> InvoiceId -> InvoiceId
>= :: InvoiceId -> InvoiceId -> Bool
$c>= :: InvoiceId -> InvoiceId -> Bool
> :: InvoiceId -> InvoiceId -> Bool
$c> :: InvoiceId -> InvoiceId -> Bool
<= :: InvoiceId -> InvoiceId -> Bool
$c<= :: InvoiceId -> InvoiceId -> Bool
< :: InvoiceId -> InvoiceId -> Bool
$c< :: InvoiceId -> InvoiceId -> Bool
compare :: InvoiceId -> InvoiceId -> Ordering
$ccompare :: InvoiceId -> InvoiceId -> Ordering
$cp1Ord :: Eq InvoiceId
Ord, Int -> InvoiceId -> ShowS
[InvoiceId] -> ShowS
InvoiceId -> String
(Int -> InvoiceId -> ShowS)
-> (InvoiceId -> String)
-> ([InvoiceId] -> ShowS)
-> Show InvoiceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvoiceId] -> ShowS
$cshowList :: [InvoiceId] -> ShowS
show :: InvoiceId -> String
$cshow :: InvoiceId -> String
showsPrec :: Int -> InvoiceId -> ShowS
$cshowsPrec :: Int -> InvoiceId -> ShowS
Show, Typeable InvoiceId
DataType
Constr
Typeable InvoiceId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InvoiceId -> c InvoiceId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InvoiceId)
-> (InvoiceId -> Constr)
-> (InvoiceId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InvoiceId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InvoiceId))
-> ((forall b. Data b => b -> b) -> InvoiceId -> InvoiceId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InvoiceId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InvoiceId -> r)
-> (forall u. (forall d. Data d => d -> u) -> InvoiceId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InvoiceId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId)
-> Data InvoiceId
InvoiceId -> DataType
InvoiceId -> Constr
(forall b. Data b => b -> b) -> InvoiceId -> InvoiceId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvoiceId -> c InvoiceId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvoiceId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InvoiceId -> u
forall u. (forall d. Data d => d -> u) -> InvoiceId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvoiceId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvoiceId -> c InvoiceId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvoiceId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InvoiceId)
$cInvoiceId :: Constr
$tInvoiceId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
gmapMp :: (forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
gmapM :: (forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
gmapQi :: Int -> (forall d. Data d => d -> u) -> InvoiceId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InvoiceId -> u
gmapQ :: (forall d. Data d => d -> u) -> InvoiceId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InvoiceId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
gmapT :: (forall b. Data b => b -> b) -> InvoiceId -> InvoiceId
$cgmapT :: (forall b. Data b => b -> b) -> InvoiceId -> InvoiceId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InvoiceId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InvoiceId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InvoiceId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvoiceId)
dataTypeOf :: InvoiceId -> DataType
$cdataTypeOf :: InvoiceId -> DataType
toConstr :: InvoiceId -> Constr
$ctoConstr :: InvoiceId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvoiceId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvoiceId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvoiceId -> c InvoiceId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvoiceId -> c InvoiceId
$cp1Data :: Typeable InvoiceId
Data, (forall x. InvoiceId -> Rep InvoiceId x)
-> (forall x. Rep InvoiceId x -> InvoiceId) -> Generic InvoiceId
forall x. Rep InvoiceId x -> InvoiceId
forall x. InvoiceId -> Rep InvoiceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvoiceId x -> InvoiceId
$cfrom :: forall x. InvoiceId -> Rep InvoiceId x
Generic)

{- | The ID of a Stripe coupon.

"A coupon contains information about a percent-off or amount-off discount you
might want to apply to a customer. Coupons may be applied to invoices or
orders." -
<https://stripe.com/docs/api/coupons Stripe> -}

newtype CouponId = CouponId Data.Text.Text
  deriving stock (CouponId -> CouponId -> Bool
(CouponId -> CouponId -> Bool)
-> (CouponId -> CouponId -> Bool) -> Eq CouponId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CouponId -> CouponId -> Bool
$c/= :: CouponId -> CouponId -> Bool
== :: CouponId -> CouponId -> Bool
$c== :: CouponId -> CouponId -> Bool
Eq, Eq CouponId
Eq CouponId
-> (CouponId -> CouponId -> Ordering)
-> (CouponId -> CouponId -> Bool)
-> (CouponId -> CouponId -> Bool)
-> (CouponId -> CouponId -> Bool)
-> (CouponId -> CouponId -> Bool)
-> (CouponId -> CouponId -> CouponId)
-> (CouponId -> CouponId -> CouponId)
-> Ord CouponId
CouponId -> CouponId -> Bool
CouponId -> CouponId -> Ordering
CouponId -> CouponId -> CouponId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CouponId -> CouponId -> CouponId
$cmin :: CouponId -> CouponId -> CouponId
max :: CouponId -> CouponId -> CouponId
$cmax :: CouponId -> CouponId -> CouponId
>= :: CouponId -> CouponId -> Bool
$c>= :: CouponId -> CouponId -> Bool
> :: CouponId -> CouponId -> Bool
$c> :: CouponId -> CouponId -> Bool
<= :: CouponId -> CouponId -> Bool
$c<= :: CouponId -> CouponId -> Bool
< :: CouponId -> CouponId -> Bool
$c< :: CouponId -> CouponId -> Bool
compare :: CouponId -> CouponId -> Ordering
$ccompare :: CouponId -> CouponId -> Ordering
$cp1Ord :: Eq CouponId
Ord, Int -> CouponId -> ShowS
[CouponId] -> ShowS
CouponId -> String
(Int -> CouponId -> ShowS)
-> (CouponId -> String) -> ([CouponId] -> ShowS) -> Show CouponId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CouponId] -> ShowS
$cshowList :: [CouponId] -> ShowS
show :: CouponId -> String
$cshow :: CouponId -> String
showsPrec :: Int -> CouponId -> ShowS
$cshowsPrec :: Int -> CouponId -> ShowS
Show, Typeable CouponId
DataType
Constr
Typeable CouponId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CouponId -> c CouponId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CouponId)
-> (CouponId -> Constr)
-> (CouponId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CouponId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CouponId))
-> ((forall b. Data b => b -> b) -> CouponId -> CouponId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CouponId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CouponId -> r)
-> (forall u. (forall d. Data d => d -> u) -> CouponId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CouponId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CouponId -> m CouponId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CouponId -> m CouponId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CouponId -> m CouponId)
-> Data CouponId
CouponId -> DataType
CouponId -> Constr
(forall b. Data b => b -> b) -> CouponId -> CouponId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CouponId -> c CouponId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CouponId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CouponId -> u
forall u. (forall d. Data d => d -> u) -> CouponId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CouponId -> m CouponId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CouponId -> m CouponId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CouponId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CouponId -> c CouponId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CouponId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CouponId)
$cCouponId :: Constr
$tCouponId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CouponId -> m CouponId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CouponId -> m CouponId
gmapMp :: (forall d. Data d => d -> m d) -> CouponId -> m CouponId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CouponId -> m CouponId
gmapM :: (forall d. Data d => d -> m d) -> CouponId -> m CouponId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CouponId -> m CouponId
gmapQi :: Int -> (forall d. Data d => d -> u) -> CouponId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CouponId -> u
gmapQ :: (forall d. Data d => d -> u) -> CouponId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CouponId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
gmapT :: (forall b. Data b => b -> b) -> CouponId -> CouponId
$cgmapT :: (forall b. Data b => b -> b) -> CouponId -> CouponId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CouponId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CouponId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CouponId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CouponId)
dataTypeOf :: CouponId -> DataType
$cdataTypeOf :: CouponId -> DataType
toConstr :: CouponId -> Constr
$ctoConstr :: CouponId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CouponId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CouponId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CouponId -> c CouponId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CouponId -> c CouponId
$cp1Data :: Typeable CouponId
Data, (forall x. CouponId -> Rep CouponId x)
-> (forall x. Rep CouponId x -> CouponId) -> Generic CouponId
forall x. Rep CouponId x -> CouponId
forall x. CouponId -> Rep CouponId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CouponId x -> CouponId
$cfrom :: forall x. CouponId -> Rep CouponId x
Generic)

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

{- | When Stripe makes a backwards-incompatible change to the API, they release
a new API version. The versions are named by the date of their release (e.g.
"2019-09-09"). -}

newtype ApiVersion = ApiVersion Data.Text.Text
  deriving stock (ApiVersion -> ApiVersion -> Bool
(ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool) -> Eq ApiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiVersion -> ApiVersion -> Bool
$c/= :: ApiVersion -> ApiVersion -> Bool
== :: ApiVersion -> ApiVersion -> Bool
$c== :: ApiVersion -> ApiVersion -> Bool
Eq, Eq ApiVersion
Eq ApiVersion
-> (ApiVersion -> ApiVersion -> Ordering)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> ApiVersion)
-> (ApiVersion -> ApiVersion -> ApiVersion)
-> Ord ApiVersion
ApiVersion -> ApiVersion -> Bool
ApiVersion -> ApiVersion -> Ordering
ApiVersion -> ApiVersion -> ApiVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApiVersion -> ApiVersion -> ApiVersion
$cmin :: ApiVersion -> ApiVersion -> ApiVersion
max :: ApiVersion -> ApiVersion -> ApiVersion
$cmax :: ApiVersion -> ApiVersion -> ApiVersion
>= :: ApiVersion -> ApiVersion -> Bool
$c>= :: ApiVersion -> ApiVersion -> Bool
> :: ApiVersion -> ApiVersion -> Bool
$c> :: ApiVersion -> ApiVersion -> Bool
<= :: ApiVersion -> ApiVersion -> Bool
$c<= :: ApiVersion -> ApiVersion -> Bool
< :: ApiVersion -> ApiVersion -> Bool
$c< :: ApiVersion -> ApiVersion -> Bool
compare :: ApiVersion -> ApiVersion -> Ordering
$ccompare :: ApiVersion -> ApiVersion -> Ordering
$cp1Ord :: Eq ApiVersion
Ord, Int -> ApiVersion -> ShowS
[ApiVersion] -> ShowS
ApiVersion -> String
(Int -> ApiVersion -> ShowS)
-> (ApiVersion -> String)
-> ([ApiVersion] -> ShowS)
-> Show ApiVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiVersion] -> ShowS
$cshowList :: [ApiVersion] -> ShowS
show :: ApiVersion -> String
$cshow :: ApiVersion -> String
showsPrec :: Int -> ApiVersion -> ShowS
$cshowsPrec :: Int -> ApiVersion -> ShowS
Show, Typeable ApiVersion
DataType
Constr
Typeable ApiVersion
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ApiVersion -> c ApiVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ApiVersion)
-> (ApiVersion -> Constr)
-> (ApiVersion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ApiVersion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApiVersion))
-> ((forall b. Data b => b -> b) -> ApiVersion -> ApiVersion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ApiVersion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ApiVersion -> r)
-> (forall u. (forall d. Data d => d -> u) -> ApiVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ApiVersion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion)
-> Data ApiVersion
ApiVersion -> DataType
ApiVersion -> Constr
(forall b. Data b => b -> b) -> ApiVersion -> ApiVersion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiVersion -> c ApiVersion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiVersion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ApiVersion -> u
forall u. (forall d. Data d => d -> u) -> ApiVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiVersion -> c ApiVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApiVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApiVersion)
$cApiVersion :: Constr
$tApiVersion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
gmapMp :: (forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
gmapM :: (forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
gmapQi :: Int -> (forall d. Data d => d -> u) -> ApiVersion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApiVersion -> u
gmapQ :: (forall d. Data d => d -> u) -> ApiVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ApiVersion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
gmapT :: (forall b. Data b => b -> b) -> ApiVersion -> ApiVersion
$cgmapT :: (forall b. Data b => b -> b) -> ApiVersion -> ApiVersion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApiVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApiVersion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ApiVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApiVersion)
dataTypeOf :: ApiVersion -> DataType
$cdataTypeOf :: ApiVersion -> DataType
toConstr :: ApiVersion -> Constr
$ctoConstr :: ApiVersion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiVersion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiVersion -> c ApiVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiVersion -> c ApiVersion
$cp1Data :: Typeable ApiVersion
Data, (forall x. ApiVersion -> Rep ApiVersion x)
-> (forall x. Rep ApiVersion x -> ApiVersion) -> Generic ApiVersion
forall x. Rep ApiVersion x -> ApiVersion
forall x. ApiVersion -> Rep ApiVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiVersion x -> ApiVersion
$cfrom :: forall x. ApiVersion -> Rep ApiVersion x
Generic)

{- |  Your account API settings specify:

  - Which API version is used by default for requests;
  - Which API version is used for webhook events.

However, you can override the API version for specific requests. "To set the API
version on a specific request, send a @Stripe-Version@ header." -
<https://stripe.com/docs/api/versioning Stripe> -}

data RequestApiVersion =
    DefaultApiVersion
      -- ^ Use the default API version specified by your account settings.
  | OverrideApiVersion ApiVersion
      {- ^ Use a specific API version for this request. (Please note however
           that any webhook events generated as a result of this request will
           still use your account's default API version.) -}
    deriving stock (RequestApiVersion -> RequestApiVersion -> Bool
(RequestApiVersion -> RequestApiVersion -> Bool)
-> (RequestApiVersion -> RequestApiVersion -> Bool)
-> Eq RequestApiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestApiVersion -> RequestApiVersion -> Bool
$c/= :: RequestApiVersion -> RequestApiVersion -> Bool
== :: RequestApiVersion -> RequestApiVersion -> Bool
$c== :: RequestApiVersion -> RequestApiVersion -> Bool
Eq, Eq RequestApiVersion
Eq RequestApiVersion
-> (RequestApiVersion -> RequestApiVersion -> Ordering)
-> (RequestApiVersion -> RequestApiVersion -> Bool)
-> (RequestApiVersion -> RequestApiVersion -> Bool)
-> (RequestApiVersion -> RequestApiVersion -> Bool)
-> (RequestApiVersion -> RequestApiVersion -> Bool)
-> (RequestApiVersion -> RequestApiVersion -> RequestApiVersion)
-> (RequestApiVersion -> RequestApiVersion -> RequestApiVersion)
-> Ord RequestApiVersion
RequestApiVersion -> RequestApiVersion -> Bool
RequestApiVersion -> RequestApiVersion -> Ordering
RequestApiVersion -> RequestApiVersion -> RequestApiVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
$cmin :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
max :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
$cmax :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
>= :: RequestApiVersion -> RequestApiVersion -> Bool
$c>= :: RequestApiVersion -> RequestApiVersion -> Bool
> :: RequestApiVersion -> RequestApiVersion -> Bool
$c> :: RequestApiVersion -> RequestApiVersion -> Bool
<= :: RequestApiVersion -> RequestApiVersion -> Bool
$c<= :: RequestApiVersion -> RequestApiVersion -> Bool
< :: RequestApiVersion -> RequestApiVersion -> Bool
$c< :: RequestApiVersion -> RequestApiVersion -> Bool
compare :: RequestApiVersion -> RequestApiVersion -> Ordering
$ccompare :: RequestApiVersion -> RequestApiVersion -> Ordering
$cp1Ord :: Eq RequestApiVersion
Ord, Int -> RequestApiVersion -> ShowS
[RequestApiVersion] -> ShowS
RequestApiVersion -> String
(Int -> RequestApiVersion -> ShowS)
-> (RequestApiVersion -> String)
-> ([RequestApiVersion] -> ShowS)
-> Show RequestApiVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestApiVersion] -> ShowS
$cshowList :: [RequestApiVersion] -> ShowS
show :: RequestApiVersion -> String
$cshow :: RequestApiVersion -> String
showsPrec :: Int -> RequestApiVersion -> ShowS
$cshowsPrec :: Int -> RequestApiVersion -> ShowS
Show, Typeable RequestApiVersion
DataType
Constr
Typeable RequestApiVersion
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RequestApiVersion
    -> c RequestApiVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RequestApiVersion)
-> (RequestApiVersion -> Constr)
-> (RequestApiVersion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RequestApiVersion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RequestApiVersion))
-> ((forall b. Data b => b -> b)
    -> RequestApiVersion -> RequestApiVersion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RequestApiVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RequestApiVersion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RequestApiVersion -> m RequestApiVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RequestApiVersion -> m RequestApiVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RequestApiVersion -> m RequestApiVersion)
-> Data RequestApiVersion
RequestApiVersion -> DataType
RequestApiVersion -> Constr
(forall b. Data b => b -> b)
-> RequestApiVersion -> RequestApiVersion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RequestApiVersion -> c RequestApiVersion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestApiVersion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RequestApiVersion -> u
forall u. (forall d. Data d => d -> u) -> RequestApiVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestApiVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RequestApiVersion -> c RequestApiVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RequestApiVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestApiVersion)
$cOverrideApiVersion :: Constr
$cDefaultApiVersion :: Constr
$tRequestApiVersion :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
gmapMp :: (forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
gmapM :: (forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
gmapQi :: Int -> (forall d. Data d => d -> u) -> RequestApiVersion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RequestApiVersion -> u
gmapQ :: (forall d. Data d => d -> u) -> RequestApiVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RequestApiVersion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
gmapT :: (forall b. Data b => b -> b)
-> RequestApiVersion -> RequestApiVersion
$cgmapT :: (forall b. Data b => b -> b)
-> RequestApiVersion -> RequestApiVersion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestApiVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestApiVersion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RequestApiVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RequestApiVersion)
dataTypeOf :: RequestApiVersion -> DataType
$cdataTypeOf :: RequestApiVersion -> DataType
toConstr :: RequestApiVersion -> Constr
$ctoConstr :: RequestApiVersion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestApiVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestApiVersion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RequestApiVersion -> c RequestApiVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RequestApiVersion -> c RequestApiVersion
$cp1Data :: Typeable RequestApiVersion
Data, (forall x. RequestApiVersion -> Rep RequestApiVersion x)
-> (forall x. Rep RequestApiVersion x -> RequestApiVersion)
-> Generic RequestApiVersion
forall x. Rep RequestApiVersion x -> RequestApiVersion
forall x. RequestApiVersion -> Rep RequestApiVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestApiVersion x -> RequestApiVersion
$cfrom :: forall x. RequestApiVersion -> Rep RequestApiVersion x
Generic)