module Stripe.Concepts
  ( -- * Modes
    Mode (..),
    BothModes (..),
    applyMode,

    -- ** Conversion with Bool
    isLiveMode,
    isTestMode,
    isLiveMode',
    isTestMode',

    -- * Keys
    -- $keys
    PublishableApiKey (..),

    -- ** Secret API key
    ApiSecretKey (..),
    textToApiSecretKey,

    -- ** Webhook secret
    WebhookSecretKey (..),
    textToWebhookSecretKey,

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

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

import Data.ByteString qualified
import Data.Data (Data)
import Data.Text qualified
import Data.Text.Encoding qualified
import GHC.Generics (Generic)

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

-- | "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
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: 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
$ccompare :: Mode -> Mode -> Ordering
compare :: Mode -> Mode -> Ordering
$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
>= :: Mode -> Mode -> Bool
$cmax :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
min :: Mode -> Mode -> 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
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [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
$csucc :: Mode -> Mode
succ :: Mode -> Mode
$cpred :: Mode -> Mode
pred :: Mode -> Mode
$ctoEnum :: Int -> Mode
toEnum :: Int -> Mode
$cfromEnum :: Mode -> Int
fromEnum :: Mode -> Int
$cenumFrom :: Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
Enum, Mode
Mode -> Mode -> Bounded Mode
forall a. a -> a -> Bounded a
$cminBound :: Mode
minBound :: Mode
$cmaxBound :: Mode
maxBound :: Mode
Bounded, Typeable Mode
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 -> Constr
Mode -> DataType
(forall b. Data b => b -> b) -> Mode -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
$ctoConstr :: Mode -> Constr
toConstr :: Mode -> Constr
$cdataTypeOf :: Mode -> DataType
dataTypeOf :: Mode -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cgmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
gmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m 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
$cfrom :: forall x. Mode -> Rep Mode x
from :: forall x. Mode -> Rep Mode x
$cto :: forall x. Rep Mode x -> Mode
to :: forall x. Rep Mode x -> Mode
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 {forall a. BothModes a -> a
liveMode :: a, forall 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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> BothModes a -> ShowS
showsPrec :: Int -> BothModes a -> ShowS
$cshow :: forall a. Show a => BothModes a -> String
show :: BothModes a -> String
$cshowList :: forall a. Show a => [BothModes a] -> ShowS
showList :: [BothModes a] -> ShowS
Show, Typeable (BothModes a)
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 -> Constr
BothModes a -> DataType
(forall b. Data b => b -> b) -> BothModes a -> BothModes a
forall a. Data a => Typeable (BothModes a)
forall a. Data a => BothModes a -> Constr
forall a. Data a => BothModes a -> DataType
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))
$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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BothModes a -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (BothModes a)
$ctoConstr :: forall a. Data a => BothModes a -> Constr
toConstr :: BothModes a -> Constr
$cdataTypeOf :: forall a. Data a => BothModes a -> DataType
dataTypeOf :: BothModes a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (BothModes a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (BothModes a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> BothModes a -> BothModes a
gmapT :: (forall b. Data b => b -> b) -> BothModes a -> BothModes a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BothModes a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> BothModes a -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BothModes a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> BothModes a -> m (BothModes a)
gmapM :: forall (m :: * -> *).
Monad m =>
(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)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BothModes a -> m (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
$cfrom :: forall a x. BothModes a -> Rep (BothModes a) x
from :: forall x. BothModes a -> Rep (BothModes a) x
$cto :: forall a x. Rep (BothModes a) x -> BothModes a
to :: forall x. Rep (BothModes a) x -> BothModes a
Generic, (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
$cfmap :: forall a b. (a -> b) -> BothModes a -> BothModes b
fmap :: forall a b. (a -> b) -> BothModes a -> BothModes b
$c<$ :: forall a b. a -> BothModes b -> BothModes a
<$ :: forall a b. a -> BothModes b -> BothModes a
Functor)

applyMode :: Mode -> BothModes a -> a
applyMode :: forall a. 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
$c== :: ApiSecretKey -> ApiSecretKey -> Bool
== :: ApiSecretKey -> ApiSecretKey -> Bool
$c/= :: ApiSecretKey -> ApiSecretKey -> Bool
/= :: 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
$ccompare :: ApiSecretKey -> ApiSecretKey -> Ordering
compare :: ApiSecretKey -> ApiSecretKey -> Ordering
$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
>= :: ApiSecretKey -> ApiSecretKey -> Bool
$cmax :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
max :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
$cmin :: ApiSecretKey -> ApiSecretKey -> ApiSecretKey
min :: ApiSecretKey -> ApiSecretKey -> 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
$c== :: PublishableApiKey -> PublishableApiKey -> Bool
== :: PublishableApiKey -> PublishableApiKey -> Bool
$c/= :: PublishableApiKey -> PublishableApiKey -> Bool
/= :: 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
$ccompare :: PublishableApiKey -> PublishableApiKey -> Ordering
compare :: PublishableApiKey -> PublishableApiKey -> Ordering
$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
>= :: PublishableApiKey -> PublishableApiKey -> Bool
$cmax :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
max :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
$cmin :: PublishableApiKey -> PublishableApiKey -> PublishableApiKey
min :: PublishableApiKey -> PublishableApiKey -> 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
$cshowsPrec :: Int -> PublishableApiKey -> ShowS
showsPrec :: Int -> PublishableApiKey -> ShowS
$cshow :: PublishableApiKey -> String
show :: PublishableApiKey -> String
$cshowList :: [PublishableApiKey] -> ShowS
showList :: [PublishableApiKey] -> ShowS
Show, Typeable PublishableApiKey
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 -> Constr
PublishableApiKey -> DataType
(forall b. Data b => b -> b)
-> PublishableApiKey -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublishableApiKey -> c PublishableApiKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PublishableApiKey -> c PublishableApiKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublishableApiKey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PublishableApiKey
$ctoConstr :: PublishableApiKey -> Constr
toConstr :: PublishableApiKey -> Constr
$cdataTypeOf :: PublishableApiKey -> DataType
dataTypeOf :: PublishableApiKey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublishableApiKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PublishableApiKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublishableApiKey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PublishableApiKey)
$cgmapT :: (forall b. Data b => b -> b)
-> PublishableApiKey -> PublishableApiKey
gmapT :: (forall b. Data b => b -> b)
-> PublishableApiKey -> PublishableApiKey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PublishableApiKey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PublishableApiKey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PublishableApiKey -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PublishableApiKey -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PublishableApiKey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m PublishableApiKey
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PublishableApiKey -> m 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
$cfrom :: forall x. PublishableApiKey -> Rep PublishableApiKey x
from :: forall x. PublishableApiKey -> Rep PublishableApiKey x
$cto :: forall x. Rep PublishableApiKey x -> PublishableApiKey
to :: forall x. Rep PublishableApiKey x -> PublishableApiKey
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
$c== :: WebhookSecretKey -> WebhookSecretKey -> Bool
== :: WebhookSecretKey -> WebhookSecretKey -> Bool
$c/= :: WebhookSecretKey -> WebhookSecretKey -> Bool
/= :: 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
$ccompare :: WebhookSecretKey -> WebhookSecretKey -> Ordering
compare :: WebhookSecretKey -> WebhookSecretKey -> Ordering
$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
>= :: WebhookSecretKey -> WebhookSecretKey -> Bool
$cmax :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
max :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
$cmin :: WebhookSecretKey -> WebhookSecretKey -> WebhookSecretKey
min :: WebhookSecretKey -> WebhookSecretKey -> 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
$c== :: TokenId -> TokenId -> Bool
== :: TokenId -> TokenId -> Bool
$c/= :: TokenId -> TokenId -> Bool
/= :: 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
$ccompare :: TokenId -> TokenId -> Ordering
compare :: TokenId -> TokenId -> Ordering
$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
>= :: TokenId -> TokenId -> Bool
$cmax :: TokenId -> TokenId -> TokenId
max :: TokenId -> TokenId -> TokenId
$cmin :: TokenId -> TokenId -> TokenId
min :: TokenId -> TokenId -> 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
$cshowsPrec :: Int -> TokenId -> ShowS
showsPrec :: Int -> TokenId -> ShowS
$cshow :: TokenId -> String
show :: TokenId -> String
$cshowList :: [TokenId] -> ShowS
showList :: [TokenId] -> ShowS
Show, Typeable TokenId
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 -> Constr
TokenId -> DataType
(forall b. Data b => b -> b) -> TokenId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenId -> c TokenId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenId -> c TokenId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenId
$ctoConstr :: TokenId -> Constr
toConstr :: TokenId -> Constr
$cdataTypeOf :: TokenId -> DataType
dataTypeOf :: TokenId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenId)
$cgmapT :: (forall b. Data b => b -> b) -> TokenId -> TokenId
gmapT :: (forall b. Data b => b -> b) -> TokenId -> TokenId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TokenId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenId -> m TokenId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenId -> m 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
$cfrom :: forall x. TokenId -> Rep TokenId x
from :: forall x. TokenId -> Rep TokenId x
$cto :: forall x. Rep TokenId x -> TokenId
to :: forall x. Rep TokenId x -> TokenId
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
$c== :: CustomerId -> CustomerId -> Bool
== :: CustomerId -> CustomerId -> Bool
$c/= :: CustomerId -> CustomerId -> Bool
/= :: 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
$ccompare :: CustomerId -> CustomerId -> Ordering
compare :: CustomerId -> CustomerId -> Ordering
$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
>= :: CustomerId -> CustomerId -> Bool
$cmax :: CustomerId -> CustomerId -> CustomerId
max :: CustomerId -> CustomerId -> CustomerId
$cmin :: CustomerId -> CustomerId -> CustomerId
min :: CustomerId -> CustomerId -> 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
$cshowsPrec :: Int -> CustomerId -> ShowS
showsPrec :: Int -> CustomerId -> ShowS
$cshow :: CustomerId -> String
show :: CustomerId -> String
$cshowList :: [CustomerId] -> ShowS
showList :: [CustomerId] -> ShowS
Show, Typeable CustomerId
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 -> Constr
CustomerId -> DataType
(forall b. Data b => b -> b) -> CustomerId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CustomerId -> c CustomerId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CustomerId -> c CustomerId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomerId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CustomerId
$ctoConstr :: CustomerId -> Constr
toConstr :: CustomerId -> Constr
$cdataTypeOf :: CustomerId -> DataType
dataTypeOf :: CustomerId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomerId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CustomerId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CustomerId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CustomerId)
$cgmapT :: (forall b. Data b => b -> b) -> CustomerId -> CustomerId
gmapT :: (forall b. Data b => b -> b) -> CustomerId -> CustomerId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CustomerId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CustomerId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CustomerId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CustomerId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CustomerId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CustomerId -> m CustomerId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CustomerId -> m 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
$cfrom :: forall x. CustomerId -> Rep CustomerId x
from :: forall x. CustomerId -> Rep CustomerId x
$cto :: forall x. Rep CustomerId x -> CustomerId
to :: forall x. Rep CustomerId x -> CustomerId
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
$c== :: ProductId -> ProductId -> Bool
== :: ProductId -> ProductId -> Bool
$c/= :: ProductId -> ProductId -> Bool
/= :: 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
$ccompare :: ProductId -> ProductId -> Ordering
compare :: ProductId -> ProductId -> Ordering
$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
>= :: ProductId -> ProductId -> Bool
$cmax :: ProductId -> ProductId -> ProductId
max :: ProductId -> ProductId -> ProductId
$cmin :: ProductId -> ProductId -> ProductId
min :: ProductId -> ProductId -> 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
$cshowsPrec :: Int -> ProductId -> ShowS
showsPrec :: Int -> ProductId -> ShowS
$cshow :: ProductId -> String
show :: ProductId -> String
$cshowList :: [ProductId] -> ShowS
showList :: [ProductId] -> ShowS
Show, Typeable ProductId
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 -> Constr
ProductId -> DataType
(forall b. Data b => b -> b) -> ProductId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProductId -> c ProductId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProductId -> c ProductId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProductId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProductId
$ctoConstr :: ProductId -> Constr
toConstr :: ProductId -> Constr
$cdataTypeOf :: ProductId -> DataType
dataTypeOf :: ProductId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProductId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProductId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProductId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProductId)
$cgmapT :: (forall b. Data b => b -> b) -> ProductId -> ProductId
gmapT :: (forall b. Data b => b -> b) -> ProductId -> ProductId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProductId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ProductId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ProductId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProductId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProductId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProductId -> m ProductId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProductId -> m 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
$cfrom :: forall x. ProductId -> Rep ProductId x
from :: forall x. ProductId -> Rep ProductId x
$cto :: forall x. Rep ProductId x -> ProductId
to :: forall x. Rep ProductId x -> ProductId
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
$c== :: PlanId -> PlanId -> Bool
== :: PlanId -> PlanId -> Bool
$c/= :: PlanId -> PlanId -> Bool
/= :: 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
$ccompare :: PlanId -> PlanId -> Ordering
compare :: PlanId -> PlanId -> Ordering
$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
>= :: PlanId -> PlanId -> Bool
$cmax :: PlanId -> PlanId -> PlanId
max :: PlanId -> PlanId -> PlanId
$cmin :: PlanId -> PlanId -> PlanId
min :: PlanId -> PlanId -> 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
$cshowsPrec :: Int -> PlanId -> ShowS
showsPrec :: Int -> PlanId -> ShowS
$cshow :: PlanId -> String
show :: PlanId -> String
$cshowList :: [PlanId] -> ShowS
showList :: [PlanId] -> ShowS
Show, Typeable PlanId
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 -> Constr
PlanId -> DataType
(forall b. Data b => b -> b) -> PlanId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanId -> c PlanId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanId -> c PlanId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanId
$ctoConstr :: PlanId -> Constr
toConstr :: PlanId -> Constr
$cdataTypeOf :: PlanId -> DataType
dataTypeOf :: PlanId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlanId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlanId)
$cgmapT :: (forall b. Data b => b -> b) -> PlanId -> PlanId
gmapT :: (forall b. Data b => b -> b) -> PlanId -> PlanId
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PlanId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlanId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PlanId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlanId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlanId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlanId -> m PlanId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlanId -> m 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
$cfrom :: forall x. PlanId -> Rep PlanId x
from :: forall x. PlanId -> Rep PlanId x
$cto :: forall x. Rep PlanId x -> PlanId
to :: forall x. Rep PlanId x -> PlanId
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
$c== :: SubscriptionId -> SubscriptionId -> Bool
== :: SubscriptionId -> SubscriptionId -> Bool
$c/= :: SubscriptionId -> SubscriptionId -> Bool
/= :: 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
$ccompare :: SubscriptionId -> SubscriptionId -> Ordering
compare :: SubscriptionId -> SubscriptionId -> Ordering
$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
>= :: SubscriptionId -> SubscriptionId -> Bool
$cmax :: SubscriptionId -> SubscriptionId -> SubscriptionId
max :: SubscriptionId -> SubscriptionId -> SubscriptionId
$cmin :: SubscriptionId -> SubscriptionId -> SubscriptionId
min :: SubscriptionId -> SubscriptionId -> 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
$cshowsPrec :: Int -> SubscriptionId -> ShowS
showsPrec :: Int -> SubscriptionId -> ShowS
$cshow :: SubscriptionId -> String
show :: SubscriptionId -> String
$cshowList :: [SubscriptionId] -> ShowS
showList :: [SubscriptionId] -> ShowS
Show, Typeable SubscriptionId
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 -> Constr
SubscriptionId -> DataType
(forall b. Data b => b -> b) -> SubscriptionId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SubscriptionId -> c SubscriptionId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubscriptionId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SubscriptionId
$ctoConstr :: SubscriptionId -> Constr
toConstr :: SubscriptionId -> Constr
$cdataTypeOf :: SubscriptionId -> DataType
dataTypeOf :: SubscriptionId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubscriptionId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SubscriptionId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubscriptionId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubscriptionId)
$cgmapT :: (forall b. Data b => b -> b) -> SubscriptionId -> SubscriptionId
gmapT :: (forall b. Data b => b -> b) -> SubscriptionId -> SubscriptionId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SubscriptionId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SubscriptionId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SubscriptionId -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SubscriptionId -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SubscriptionId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m SubscriptionId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubscriptionId -> m 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
$cfrom :: forall x. SubscriptionId -> Rep SubscriptionId x
from :: forall x. SubscriptionId -> Rep SubscriptionId x
$cto :: forall x. Rep SubscriptionId x -> SubscriptionId
to :: forall x. Rep SubscriptionId x -> SubscriptionId
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
$c== :: InvoiceId -> InvoiceId -> Bool
== :: InvoiceId -> InvoiceId -> Bool
$c/= :: InvoiceId -> InvoiceId -> Bool
/= :: 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
$ccompare :: InvoiceId -> InvoiceId -> Ordering
compare :: InvoiceId -> InvoiceId -> Ordering
$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
>= :: InvoiceId -> InvoiceId -> Bool
$cmax :: InvoiceId -> InvoiceId -> InvoiceId
max :: InvoiceId -> InvoiceId -> InvoiceId
$cmin :: InvoiceId -> InvoiceId -> InvoiceId
min :: InvoiceId -> InvoiceId -> 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
$cshowsPrec :: Int -> InvoiceId -> ShowS
showsPrec :: Int -> InvoiceId -> ShowS
$cshow :: InvoiceId -> String
show :: InvoiceId -> String
$cshowList :: [InvoiceId] -> ShowS
showList :: [InvoiceId] -> ShowS
Show, Typeable InvoiceId
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 -> Constr
InvoiceId -> DataType
(forall b. Data b => b -> b) -> InvoiceId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvoiceId -> c InvoiceId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvoiceId -> c InvoiceId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvoiceId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvoiceId
$ctoConstr :: InvoiceId -> Constr
toConstr :: InvoiceId -> Constr
$cdataTypeOf :: InvoiceId -> DataType
dataTypeOf :: InvoiceId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvoiceId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvoiceId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InvoiceId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InvoiceId)
$cgmapT :: (forall b. Data b => b -> b) -> InvoiceId -> InvoiceId
gmapT :: (forall b. Data b => b -> b) -> InvoiceId -> InvoiceId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvoiceId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InvoiceId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> InvoiceId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InvoiceId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InvoiceId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m InvoiceId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InvoiceId -> m 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
$cfrom :: forall x. InvoiceId -> Rep InvoiceId x
from :: forall x. InvoiceId -> Rep InvoiceId x
$cto :: forall x. Rep InvoiceId x -> InvoiceId
to :: forall x. Rep InvoiceId x -> InvoiceId
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
$c== :: CouponId -> CouponId -> Bool
== :: CouponId -> CouponId -> Bool
$c/= :: CouponId -> CouponId -> Bool
/= :: 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
$ccompare :: CouponId -> CouponId -> Ordering
compare :: CouponId -> CouponId -> Ordering
$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
>= :: CouponId -> CouponId -> Bool
$cmax :: CouponId -> CouponId -> CouponId
max :: CouponId -> CouponId -> CouponId
$cmin :: CouponId -> CouponId -> CouponId
min :: CouponId -> CouponId -> 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
$cshowsPrec :: Int -> CouponId -> ShowS
showsPrec :: Int -> CouponId -> ShowS
$cshow :: CouponId -> String
show :: CouponId -> String
$cshowList :: [CouponId] -> ShowS
showList :: [CouponId] -> ShowS
Show, Typeable CouponId
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 -> Constr
CouponId -> DataType
(forall b. Data b => b -> b) -> CouponId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CouponId -> c CouponId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CouponId -> c CouponId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CouponId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CouponId
$ctoConstr :: CouponId -> Constr
toConstr :: CouponId -> Constr
$cdataTypeOf :: CouponId -> DataType
dataTypeOf :: CouponId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CouponId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CouponId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CouponId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CouponId)
$cgmapT :: (forall b. Data b => b -> b) -> CouponId -> CouponId
gmapT :: (forall b. Data b => b -> b) -> CouponId -> CouponId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CouponId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CouponId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CouponId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CouponId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CouponId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CouponId -> m CouponId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CouponId -> m 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
$cfrom :: forall x. CouponId -> Rep CouponId x
from :: forall x. CouponId -> Rep CouponId x
$cto :: forall x. Rep CouponId x -> CouponId
to :: forall x. Rep CouponId x -> CouponId
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
$c== :: ApiVersion -> ApiVersion -> Bool
== :: ApiVersion -> ApiVersion -> Bool
$c/= :: ApiVersion -> ApiVersion -> Bool
/= :: 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
$ccompare :: ApiVersion -> ApiVersion -> Ordering
compare :: ApiVersion -> ApiVersion -> Ordering
$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
>= :: ApiVersion -> ApiVersion -> Bool
$cmax :: ApiVersion -> ApiVersion -> ApiVersion
max :: ApiVersion -> ApiVersion -> ApiVersion
$cmin :: ApiVersion -> ApiVersion -> ApiVersion
min :: ApiVersion -> ApiVersion -> 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
$cshowsPrec :: Int -> ApiVersion -> ShowS
showsPrec :: Int -> ApiVersion -> ShowS
$cshow :: ApiVersion -> String
show :: ApiVersion -> String
$cshowList :: [ApiVersion] -> ShowS
showList :: [ApiVersion] -> ShowS
Show, Typeable ApiVersion
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 -> Constr
ApiVersion -> DataType
(forall b. Data b => b -> b) -> ApiVersion -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiVersion -> c ApiVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApiVersion -> c ApiVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiVersion
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApiVersion
$ctoConstr :: ApiVersion -> Constr
toConstr :: ApiVersion -> Constr
$cdataTypeOf :: ApiVersion -> DataType
dataTypeOf :: ApiVersion -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApiVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApiVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApiVersion)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApiVersion)
$cgmapT :: (forall b. Data b => b -> b) -> ApiVersion -> ApiVersion
gmapT :: (forall b. Data b => b -> b) -> ApiVersion -> ApiVersion
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApiVersion -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ApiVersion -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ApiVersion -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApiVersion -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApiVersion -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m ApiVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApiVersion -> m 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
$cfrom :: forall x. ApiVersion -> Rep ApiVersion x
from :: forall x. ApiVersion -> Rep ApiVersion x
$cto :: forall x. Rep ApiVersion x -> ApiVersion
to :: forall x. Rep ApiVersion x -> ApiVersion
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
  = -- | Use the default API version specified by your account settings.
    DefaultApiVersion
  | -- | 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.)
    OverrideApiVersion ApiVersion
  deriving stock (RequestApiVersion -> RequestApiVersion -> Bool
(RequestApiVersion -> RequestApiVersion -> Bool)
-> (RequestApiVersion -> RequestApiVersion -> Bool)
-> Eq RequestApiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestApiVersion -> RequestApiVersion -> Bool
== :: RequestApiVersion -> RequestApiVersion -> Bool
$c/= :: RequestApiVersion -> RequestApiVersion -> Bool
/= :: 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
$ccompare :: RequestApiVersion -> RequestApiVersion -> Ordering
compare :: RequestApiVersion -> RequestApiVersion -> Ordering
$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
>= :: RequestApiVersion -> RequestApiVersion -> Bool
$cmax :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
max :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
$cmin :: RequestApiVersion -> RequestApiVersion -> RequestApiVersion
min :: RequestApiVersion -> RequestApiVersion -> 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
$cshowsPrec :: Int -> RequestApiVersion -> ShowS
showsPrec :: Int -> RequestApiVersion -> ShowS
$cshow :: RequestApiVersion -> String
show :: RequestApiVersion -> String
$cshowList :: [RequestApiVersion] -> ShowS
showList :: [RequestApiVersion] -> ShowS
Show, Typeable RequestApiVersion
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 -> Constr
RequestApiVersion -> DataType
(forall b. Data b => b -> b)
-> RequestApiVersion -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RequestApiVersion -> c RequestApiVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RequestApiVersion -> c RequestApiVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestApiVersion
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RequestApiVersion
$ctoConstr :: RequestApiVersion -> Constr
toConstr :: RequestApiVersion -> Constr
$cdataTypeOf :: RequestApiVersion -> DataType
dataTypeOf :: RequestApiVersion -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RequestApiVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RequestApiVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestApiVersion)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RequestApiVersion)
$cgmapT :: (forall b. Data b => b -> b)
-> RequestApiVersion -> RequestApiVersion
gmapT :: (forall b. Data b => b -> b)
-> RequestApiVersion -> RequestApiVersion
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RequestApiVersion -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RequestApiVersion -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RequestApiVersion -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RequestApiVersion -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RequestApiVersion -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m RequestApiVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RequestApiVersion -> m 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
$cfrom :: forall x. RequestApiVersion -> Rep RequestApiVersion x
from :: forall x. RequestApiVersion -> Rep RequestApiVersion x
$cto :: forall x. Rep RequestApiVersion x -> RequestApiVersion
to :: forall x. Rep RequestApiVersion x -> RequestApiVersion
Generic)