{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.ApplePaySession
       (newApplePaySession, supportsVersion, supportsVersion_,
        canMakePayments, canMakePayments_, canMakePaymentsWithActiveCard,
        canMakePaymentsWithActiveCard_, openPaymentSetup,
        openPaymentSetup_, begin, abort, completeMerchantValidation,
        completeShippingMethodSelectionUpdate,
        completeShippingContactSelectionUpdate,
        completePaymentMethodSelectionUpdate, completePaymentResult,
        completeShippingMethodSelection, completeShippingContactSelection,
        completePaymentMethodSelection, completePayment,
        pattern STATUS_SUCCESS, pattern STATUS_FAILURE,
        pattern STATUS_INVALID_BILLING_POSTAL_ADDRESS,
        pattern STATUS_INVALID_SHIPPING_POSTAL_ADDRESS,
        pattern STATUS_INVALID_SHIPPING_CONTACT,
        pattern STATUS_PIN_REQUIRED, pattern STATUS_PIN_INCORRECT,
        pattern STATUS_PIN_LOCKOUT, validatemerchant,
        paymentmethodselected, paymentauthorized, shippingmethodselected,
        shippingcontactselected, cancel, ApplePaySession(..),
        gTypeApplePaySession)
       where
import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, realToFrac, fmap, Show, Read, Eq, Ord, Maybe(..))
import qualified Prelude (error)
import Data.Typeable (Typeable)
import Data.Traversable (mapM)
import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, asyncFunction, new, array, jsUndefined, (!), (!!))
import Data.Int (Int64)
import Data.Word (Word, Word64)
import JSDOM.Types
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Lens.Operators ((^.))
import JSDOM.EventTargetClosures (EventName, unsafeEventName, unsafeEventNameAsync)
import JSDOM.Enums

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession Mozilla ApplePaySession documentation> 
newApplePaySession ::
                   (MonadDOM m) => Word -> ApplePayPaymentRequest -> m ApplePaySession
newApplePaySession :: forall (m :: * -> *).
MonadDOM m =>
Word -> ApplePayPaymentRequest -> m ApplePaySession
newApplePaySession Word
version ApplePayPaymentRequest
paymentRequest
  = DOM ApplePaySession -> m ApplePaySession
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> ApplePaySession
ApplePaySession (JSVal -> ApplePaySession) -> JSM JSVal -> DOM ApplePaySession
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession")
           [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
version, ApplePayPaymentRequest -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayPaymentRequest
paymentRequest])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.supportsVersion Mozilla ApplePaySession.supportsVersion documentation> 
supportsVersion :: (MonadDOM m) => Word -> m Bool
supportsVersion :: forall (m :: * -> *). MonadDOM m => Word -> m Bool
supportsVersion Word
version
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"supportsVersion"
          [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
version])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.supportsVersion Mozilla ApplePaySession.supportsVersion documentation> 
supportsVersion_ :: (MonadDOM m) => Word -> m ()
supportsVersion_ :: forall (m :: * -> *). MonadDOM m => Word -> m ()
supportsVersion_ Word
version
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"supportsVersion"
            [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
version]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.canMakePayments Mozilla ApplePaySession.canMakePayments documentation> 
canMakePayments :: (MonadDOM m) => m Bool
canMakePayments :: forall (m :: * -> *). MonadDOM m => m Bool
canMakePayments
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"canMakePayments" ()) JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.canMakePayments Mozilla ApplePaySession.canMakePayments documentation> 
canMakePayments_ :: (MonadDOM m) => m ()
canMakePayments_ :: forall (m :: * -> *). MonadDOM m => m ()
canMakePayments_
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"canMakePayments" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.canMakePaymentsWithActiveCard Mozilla ApplePaySession.canMakePaymentsWithActiveCard documentation> 
canMakePaymentsWithActiveCard ::
                              (MonadDOM m, ToJSString merchantIdentifier) =>
                                merchantIdentifier -> m Bool
canMakePaymentsWithActiveCard :: forall (m :: * -> *) merchantIdentifier.
(MonadDOM m, ToJSString merchantIdentifier) =>
merchantIdentifier -> m Bool
canMakePaymentsWithActiveCard merchantIdentifier
merchantIdentifier
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"canMakePaymentsWithActiveCard"
           [merchantIdentifier -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal merchantIdentifier
merchantIdentifier])
          JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSVal
readPromise)
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.canMakePaymentsWithActiveCard Mozilla ApplePaySession.canMakePaymentsWithActiveCard documentation> 
canMakePaymentsWithActiveCard_ ::
                               (MonadDOM m, ToJSString merchantIdentifier) =>
                                 merchantIdentifier -> m ()
canMakePaymentsWithActiveCard_ :: forall (m :: * -> *) merchantIdentifier.
(MonadDOM m, ToJSString merchantIdentifier) =>
merchantIdentifier -> m ()
canMakePaymentsWithActiveCard_ merchantIdentifier
merchantIdentifier
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"canMakePaymentsWithActiveCard"
            [merchantIdentifier -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal merchantIdentifier
merchantIdentifier]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.openPaymentSetup Mozilla ApplePaySession.openPaymentSetup documentation> 
openPaymentSetup ::
                 (MonadDOM m, ToJSString merchantIdentifier) =>
                   merchantIdentifier -> m Bool
openPaymentSetup :: forall (m :: * -> *) merchantIdentifier.
(MonadDOM m, ToJSString merchantIdentifier) =>
merchantIdentifier -> m Bool
openPaymentSetup merchantIdentifier
merchantIdentifier
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"openPaymentSetup"
           [merchantIdentifier -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal merchantIdentifier
merchantIdentifier])
          JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSVal
readPromise)
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.openPaymentSetup Mozilla ApplePaySession.openPaymentSetup documentation> 
openPaymentSetup_ ::
                  (MonadDOM m, ToJSString merchantIdentifier) =>
                    merchantIdentifier -> m ()
openPaymentSetup_ :: forall (m :: * -> *) merchantIdentifier.
(MonadDOM m, ToJSString merchantIdentifier) =>
merchantIdentifier -> m ()
openPaymentSetup_ merchantIdentifier
merchantIdentifier
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"ApplePaySession") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"openPaymentSetup"
            [merchantIdentifier -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal merchantIdentifier
merchantIdentifier]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.begin Mozilla ApplePaySession.begin documentation> 
begin :: (MonadDOM m) => ApplePaySession -> m ()
begin :: forall (m :: * -> *). MonadDOM m => ApplePaySession -> m ()
begin ApplePaySession
self = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"begin" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.abort Mozilla ApplePaySession.abort documentation> 
abort :: (MonadDOM m) => ApplePaySession -> m ()
abort :: forall (m :: * -> *). MonadDOM m => ApplePaySession -> m ()
abort ApplePaySession
self = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"abort" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completeMerchantValidation Mozilla ApplePaySession.completeMerchantValidation documentation> 
completeMerchantValidation ::
                           (MonadDOM m, ToJSVal merchantSession) =>
                             ApplePaySession -> merchantSession -> m ()
completeMerchantValidation :: forall (m :: * -> *) merchantSession.
(MonadDOM m, ToJSVal merchantSession) =>
ApplePaySession -> merchantSession -> m ()
completeMerchantValidation ApplePaySession
self merchantSession
merchantSession
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completeMerchantValidation"
            [merchantSession -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal merchantSession
merchantSession]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completeShippingMethodSelection Mozilla ApplePaySession.completeShippingMethodSelection documentation> 
completeShippingMethodSelectionUpdate ::
                                      (MonadDOM m) =>
                                        ApplePaySession -> ApplePayShippingMethodUpdate -> m ()
completeShippingMethodSelectionUpdate :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession -> ApplePayShippingMethodUpdate -> m ()
completeShippingMethodSelectionUpdate ApplePaySession
self ApplePayShippingMethodUpdate
update
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completeShippingMethodSelection" [ApplePayShippingMethodUpdate -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayShippingMethodUpdate
update]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completeShippingContactSelection Mozilla ApplePaySession.completeShippingContactSelection documentation> 
completeShippingContactSelectionUpdate ::
                                       (MonadDOM m) =>
                                         ApplePaySession -> ApplePayShippingContactUpdate -> m ()
completeShippingContactSelectionUpdate :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession -> ApplePayShippingContactUpdate -> m ()
completeShippingContactSelectionUpdate ApplePaySession
self ApplePayShippingContactUpdate
update
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completeShippingContactSelection" [ApplePayShippingContactUpdate -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayShippingContactUpdate
update]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completePaymentMethodSelection Mozilla ApplePaySession.completePaymentMethodSelection documentation> 
completePaymentMethodSelectionUpdate ::
                                     (MonadDOM m) =>
                                       ApplePaySession -> ApplePayPaymentMethodUpdate -> m ()
completePaymentMethodSelectionUpdate :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession -> ApplePayPaymentMethodUpdate -> m ()
completePaymentMethodSelectionUpdate ApplePaySession
self ApplePayPaymentMethodUpdate
update
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completePaymentMethodSelection" [ApplePayPaymentMethodUpdate -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayPaymentMethodUpdate
update]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completePayment Mozilla ApplePaySession.completePayment documentation> 
completePaymentResult ::
                      (MonadDOM m) =>
                        ApplePaySession -> ApplePayPaymentAuthorizationResult -> m ()
completePaymentResult :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession -> ApplePayPaymentAuthorizationResult -> m ()
completePaymentResult ApplePaySession
self ApplePayPaymentAuthorizationResult
result
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completePayment" [ApplePayPaymentAuthorizationResult -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayPaymentAuthorizationResult
result]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completeShippingMethodSelection Mozilla ApplePaySession.completeShippingMethodSelection documentation> 
completeShippingMethodSelection ::
                                (MonadDOM m) =>
                                  ApplePaySession ->
                                    Word -> ApplePayLineItem -> [ApplePayLineItem] -> m ()
completeShippingMethodSelection :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession
-> Word -> ApplePayLineItem -> [ApplePayLineItem] -> m ()
completeShippingMethodSelection ApplePaySession
self Word
status ApplePayLineItem
newTotal [ApplePayLineItem]
newLineItems
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completeShippingMethodSelection"
            [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
status, ApplePayLineItem -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayLineItem
newTotal, JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([ApplePayLineItem] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [ApplePayLineItem]
newLineItems)]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completeShippingContactSelection Mozilla ApplePaySession.completeShippingContactSelection documentation> 
completeShippingContactSelection ::
                                 (MonadDOM m) =>
                                   ApplePaySession ->
                                     Word ->
                                       [ApplePayShippingMethod] ->
                                         ApplePayLineItem -> [ApplePayLineItem] -> m ()
completeShippingContactSelection :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession
-> Word
-> [ApplePayShippingMethod]
-> ApplePayLineItem
-> [ApplePayLineItem]
-> m ()
completeShippingContactSelection ApplePaySession
self Word
status [ApplePayShippingMethod]
newShippingMethods
  ApplePayLineItem
newTotal [ApplePayLineItem]
newLineItems
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completeShippingContactSelection"
            [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
status, JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([ApplePayShippingMethod] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [ApplePayShippingMethod]
newShippingMethods),
             ApplePayLineItem -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayLineItem
newTotal, JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([ApplePayLineItem] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [ApplePayLineItem]
newLineItems)]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completePaymentMethodSelection Mozilla ApplePaySession.completePaymentMethodSelection documentation> 
completePaymentMethodSelection ::
                               (MonadDOM m) =>
                                 ApplePaySession -> ApplePayLineItem -> [ApplePayLineItem] -> m ()
completePaymentMethodSelection :: forall (m :: * -> *).
MonadDOM m =>
ApplePaySession -> ApplePayLineItem -> [ApplePayLineItem] -> m ()
completePaymentMethodSelection ApplePaySession
self ApplePayLineItem
newTotal [ApplePayLineItem]
newLineItems
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completePaymentMethodSelection"
            [ApplePayLineItem -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ApplePayLineItem
newTotal, JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([ApplePayLineItem] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [ApplePayLineItem]
newLineItems)]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.completePayment Mozilla ApplePaySession.completePayment documentation> 
completePayment :: (MonadDOM m) => ApplePaySession -> Word -> m ()
completePayment :: forall (m :: * -> *). MonadDOM m => ApplePaySession -> Word -> m ()
completePayment ApplePaySession
self Word
status
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ApplePaySession
self ApplePaySession
-> Getting (JSM JSVal) ApplePaySession (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"completePayment" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
status]))
pattern $mSTATUS_SUCCESS :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_SUCCESS :: forall {a}. (Eq a, Num a) => a
STATUS_SUCCESS = 0
pattern $mSTATUS_FAILURE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_FAILURE :: forall {a}. (Eq a, Num a) => a
STATUS_FAILURE = 1
pattern $mSTATUS_INVALID_BILLING_POSTAL_ADDRESS :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_INVALID_BILLING_POSTAL_ADDRESS :: forall {a}. (Eq a, Num a) => a
STATUS_INVALID_BILLING_POSTAL_ADDRESS = 2
pattern $mSTATUS_INVALID_SHIPPING_POSTAL_ADDRESS :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_INVALID_SHIPPING_POSTAL_ADDRESS :: forall {a}. (Eq a, Num a) => a
STATUS_INVALID_SHIPPING_POSTAL_ADDRESS = 3
pattern $mSTATUS_INVALID_SHIPPING_CONTACT :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_INVALID_SHIPPING_CONTACT :: forall {a}. (Eq a, Num a) => a
STATUS_INVALID_SHIPPING_CONTACT = 4
pattern $mSTATUS_PIN_REQUIRED :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_PIN_REQUIRED :: forall {a}. (Eq a, Num a) => a
STATUS_PIN_REQUIRED = 5
pattern $mSTATUS_PIN_INCORRECT :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_PIN_INCORRECT :: forall {a}. (Eq a, Num a) => a
STATUS_PIN_INCORRECT = 6
pattern $mSTATUS_PIN_LOCKOUT :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTATUS_PIN_LOCKOUT :: forall {a}. (Eq a, Num a) => a
STATUS_PIN_LOCKOUT = 7

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.onvalidatemerchant Mozilla ApplePaySession.onvalidatemerchant documentation> 
validatemerchant :: EventName ApplePaySession onvalidatemerchant
validatemerchant :: forall onvalidatemerchant.
EventName ApplePaySession onvalidatemerchant
validatemerchant = DOMString -> EventName ApplePaySession onvalidatemerchant
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"validatemerchant")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.onpaymentmethodselected Mozilla ApplePaySession.onpaymentmethodselected documentation> 
paymentmethodselected ::
                        EventName ApplePaySession onpaymentmethodselected
paymentmethodselected :: forall onvalidatemerchant.
EventName ApplePaySession onvalidatemerchant
paymentmethodselected
  = DOMString -> EventName ApplePaySession onpaymentmethodselected
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"paymentmethodselected")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.onpaymentauthorized Mozilla ApplePaySession.onpaymentauthorized documentation> 
paymentauthorized :: EventName ApplePaySession onpaymentauthorized
paymentauthorized :: forall onvalidatemerchant.
EventName ApplePaySession onvalidatemerchant
paymentauthorized
  = DOMString -> EventName ApplePaySession onpaymentauthorized
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"paymentauthorized")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.onshippingmethodselected Mozilla ApplePaySession.onshippingmethodselected documentation> 
shippingmethodselected ::
                         EventName ApplePaySession onshippingmethodselected
shippingmethodselected :: forall onvalidatemerchant.
EventName ApplePaySession onvalidatemerchant
shippingmethodselected
  = DOMString -> EventName ApplePaySession onshippingmethodselected
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"shippingmethodselected")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.onshippingcontactselected Mozilla ApplePaySession.onshippingcontactselected documentation> 
shippingcontactselected ::
                          EventName ApplePaySession onshippingcontactselected
shippingcontactselected :: forall onvalidatemerchant.
EventName ApplePaySession onvalidatemerchant
shippingcontactselected
  = DOMString -> EventName ApplePaySession onshippingcontactselected
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"shippingcontactselected")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/ApplePaySession.oncancel Mozilla ApplePaySession.oncancel documentation> 
cancel :: EventName ApplePaySession oncancel
cancel :: forall onvalidatemerchant.
EventName ApplePaySession onvalidatemerchant
cancel = DOMString -> EventName ApplePaySession oncancel
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"cancel")