{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.RTCPeerConnection
       (createOffer, createOffer_, createAnswer, createAnswer_,
        setLocalDescription, setRemoteDescription, addIceCandidate,
        getConfiguration, getConfiguration_, setConfiguration, close,
        getSenders, getSenders_, getReceivers, getReceivers_,
        getTransceivers, getTransceivers_, addTrack, addTrack_,
        removeTrack, addTransceiverTrack, addTransceiverTrack_,
        createDataChannel, createDataChannel_, getStats, getStats_,
        getLocalStreams, getLocalStreams_, getRemoteStreams,
        getRemoteStreams_, getStreamById, getStreamById_, addStream,
        removeStream, getLocalDescription, getLocalDescriptionUnsafe,
        getLocalDescriptionUnchecked, getCurrentLocalDescription,
        getCurrentLocalDescriptionUnsafe,
        getCurrentLocalDescriptionUnchecked, getPendingLocalDescription,
        getPendingLocalDescriptionUnsafe,
        getPendingLocalDescriptionUnchecked, getRemoteDescription,
        getRemoteDescriptionUnsafe, getRemoteDescriptionUnchecked,
        getCurrentRemoteDescription, getCurrentRemoteDescriptionUnsafe,
        getCurrentRemoteDescriptionUnchecked, getPendingRemoteDescription,
        getPendingRemoteDescriptionUnsafe,
        getPendingRemoteDescriptionUnchecked, getSignalingState,
        getIceGatheringState, getIceConnectionState, getConnectionState,
        negotiationNeeded, iceCandidate, signalingStateChange,
        iceConnectionStateChange, icegatheringstatechange,
        connectionstatechange, track, dataChannel, addStreamEvent,
        RTCPeerConnection(..), gTypeRTCPeerConnection)
       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/webkitRTCPeerConnection.createOffer Mozilla webkitRTCPeerConnection.createOffer documentation> 
createOffer ::
            (MonadDOM m) =>
              RTCPeerConnection ->
                Maybe RTCOfferOptions -> m RTCSessionDescriptionInit
createOffer :: RTCPeerConnection
-> Maybe RTCOfferOptions -> m RTCSessionDescriptionInit
createOffer RTCPeerConnection
self Maybe RTCOfferOptions
offerOptions
  = DOM RTCSessionDescriptionInit -> m RTCSessionDescriptionInit
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createOffer" [Maybe RTCOfferOptions -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RTCOfferOptions
offerOptions]) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          JSVal -> JSM JSVal
readPromise)
         JSM JSVal
-> (JSVal -> DOM RTCSessionDescriptionInit)
-> DOM RTCSessionDescriptionInit
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescriptionInit
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.createAnswer Mozilla webkitRTCPeerConnection.createAnswer documentation> 
createAnswer ::
             (MonadDOM m) =>
               RTCPeerConnection ->
                 Maybe RTCAnswerOptions -> m RTCSessionDescriptionInit
createAnswer :: RTCPeerConnection
-> Maybe RTCAnswerOptions -> m RTCSessionDescriptionInit
createAnswer RTCPeerConnection
self Maybe RTCAnswerOptions
answerOptions
  = DOM RTCSessionDescriptionInit -> m RTCSessionDescriptionInit
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createAnswer" [Maybe RTCAnswerOptions -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RTCAnswerOptions
answerOptions]) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          JSVal -> JSM JSVal
readPromise)
         JSM JSVal
-> (JSVal -> DOM RTCSessionDescriptionInit)
-> DOM RTCSessionDescriptionInit
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescriptionInit
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.setLocalDescription Mozilla webkitRTCPeerConnection.setLocalDescription documentation> 
setLocalDescription ::
                    (MonadDOM m) =>
                      RTCPeerConnection -> RTCSessionDescriptionInit -> m ()
setLocalDescription :: RTCPeerConnection -> RTCSessionDescriptionInit -> m ()
setLocalDescription RTCPeerConnection
self RTCSessionDescriptionInit
description
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"setLocalDescription" [RTCSessionDescriptionInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal RTCSessionDescriptionInit
description]) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            JSVal -> JSM JSVal
readPromise))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.setRemoteDescription Mozilla webkitRTCPeerConnection.setRemoteDescription documentation> 
setRemoteDescription ::
                     (MonadDOM m) =>
                       RTCPeerConnection -> RTCSessionDescriptionInit -> m ()
setRemoteDescription :: RTCPeerConnection -> RTCSessionDescriptionInit -> m ()
setRemoteDescription RTCPeerConnection
self RTCSessionDescriptionInit
description
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"setRemoteDescription" [RTCSessionDescriptionInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal RTCSessionDescriptionInit
description]) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            JSVal -> JSM JSVal
readPromise))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.addIceCandidate Mozilla webkitRTCPeerConnection.addIceCandidate documentation> 
addIceCandidate ::
                (MonadDOM m, IsRTCIceCandidateOrInit candidate) =>
                  RTCPeerConnection -> candidate -> m ()
addIceCandidate :: RTCPeerConnection -> candidate -> m ()
addIceCandidate RTCPeerConnection
self candidate
candidate
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addIceCandidate" [candidate -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal candidate
candidate]) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            JSVal -> JSM JSVal
readPromise))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getConfiguration Mozilla webkitRTCPeerConnection.getConfiguration documentation> 
getConfiguration ::
                 (MonadDOM m) => RTCPeerConnection -> m RTCConfiguration
getConfiguration :: RTCPeerConnection -> m RTCConfiguration
getConfiguration RTCPeerConnection
self
  = DOM RTCConfiguration -> m RTCConfiguration
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getConfiguration" ()) JSM JSVal
-> (JSVal -> DOM RTCConfiguration) -> DOM RTCConfiguration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCConfiguration
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getConfiguration Mozilla webkitRTCPeerConnection.getConfiguration documentation> 
getConfiguration_ :: (MonadDOM m) => RTCPeerConnection -> m ()
getConfiguration_ :: RTCPeerConnection -> m ()
getConfiguration_ RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getConfiguration" ()))

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.close Mozilla webkitRTCPeerConnection.close documentation> 
close :: (MonadDOM m) => RTCPeerConnection -> m ()
close :: RTCPeerConnection -> m ()
close RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"close" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getSenders Mozilla webkitRTCPeerConnection.getSenders documentation> 
getSenders :: (MonadDOM m) => RTCPeerConnection -> m [RTCRtpSender]
getSenders :: RTCPeerConnection -> m [RTCRtpSender]
getSenders RTCPeerConnection
self
  = DOM [RTCRtpSender] -> m [RTCRtpSender]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getSenders" ()) JSM JSVal -> (JSVal -> DOM [RTCRtpSender]) -> DOM [RTCRtpSender]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [RTCRtpSender]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getSenders Mozilla webkitRTCPeerConnection.getSenders documentation> 
getSenders_ :: (MonadDOM m) => RTCPeerConnection -> m ()
getSenders_ :: RTCPeerConnection -> m ()
getSenders_ RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getSenders" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getReceivers Mozilla webkitRTCPeerConnection.getReceivers documentation> 
getReceivers ::
             (MonadDOM m) => RTCPeerConnection -> m [RTCRtpReceiver]
getReceivers :: RTCPeerConnection -> m [RTCRtpReceiver]
getReceivers RTCPeerConnection
self
  = DOM [RTCRtpReceiver] -> m [RTCRtpReceiver]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getReceivers" ()) JSM JSVal
-> (JSVal -> DOM [RTCRtpReceiver]) -> DOM [RTCRtpReceiver]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [RTCRtpReceiver]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getReceivers Mozilla webkitRTCPeerConnection.getReceivers documentation> 
getReceivers_ :: (MonadDOM m) => RTCPeerConnection -> m ()
getReceivers_ :: RTCPeerConnection -> m ()
getReceivers_ RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getReceivers" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getTransceivers Mozilla webkitRTCPeerConnection.getTransceivers documentation> 
getTransceivers ::
                (MonadDOM m) => RTCPeerConnection -> m [RTCRtpTransceiver]
getTransceivers :: RTCPeerConnection -> m [RTCRtpTransceiver]
getTransceivers RTCPeerConnection
self
  = DOM [RTCRtpTransceiver] -> m [RTCRtpTransceiver]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getTransceivers" ()) JSM JSVal
-> (JSVal -> DOM [RTCRtpTransceiver]) -> DOM [RTCRtpTransceiver]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [RTCRtpTransceiver]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getTransceivers Mozilla webkitRTCPeerConnection.getTransceivers documentation> 
getTransceivers_ :: (MonadDOM m) => RTCPeerConnection -> m ()
getTransceivers_ :: RTCPeerConnection -> m ()
getTransceivers_ RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getTransceivers" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.addTrack Mozilla webkitRTCPeerConnection.addTrack documentation> 
addTrack ::
         (MonadDOM m, IsMediaStreamTrack track) =>
           RTCPeerConnection -> track -> [MediaStream] -> m RTCRtpSender
addTrack :: RTCPeerConnection -> track -> [MediaStream] -> m RTCRtpSender
addTrack RTCPeerConnection
self track
track [MediaStream]
streams
  = DOM RTCRtpSender -> m RTCRtpSender
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addTrack" [track -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal track
track, JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([MediaStream] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [MediaStream]
streams)])
         JSM JSVal -> (JSVal -> DOM RTCRtpSender) -> DOM RTCRtpSender
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCRtpSender
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.addTrack Mozilla webkitRTCPeerConnection.addTrack documentation> 
addTrack_ ::
          (MonadDOM m, IsMediaStreamTrack track) =>
            RTCPeerConnection -> track -> [MediaStream] -> m ()
addTrack_ :: RTCPeerConnection -> track -> [MediaStream] -> m ()
addTrack_ RTCPeerConnection
self track
track [MediaStream]
streams
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addTrack" [track -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal track
track, JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([MediaStream] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [MediaStream]
streams)]))

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.addTransceiver Mozilla webkitRTCPeerConnection.addTransceiver documentation> 
addTransceiverTrack ::
                    (MonadDOM m, IsMediaStreamTrackOrKind track) =>
                      RTCPeerConnection ->
                        track -> Maybe RTCRtpTransceiverInit -> m RTCRtpTransceiver
addTransceiverTrack :: RTCPeerConnection
-> track -> Maybe RTCRtpTransceiverInit -> m RTCRtpTransceiver
addTransceiverTrack RTCPeerConnection
self track
track Maybe RTCRtpTransceiverInit
init
  = DOM RTCRtpTransceiver -> m RTCRtpTransceiver
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addTransceiver" [track -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal track
track, Maybe RTCRtpTransceiverInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RTCRtpTransceiverInit
init]) JSM JSVal
-> (JSVal -> DOM RTCRtpTransceiver) -> DOM RTCRtpTransceiver
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM RTCRtpTransceiver
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.addTransceiver Mozilla webkitRTCPeerConnection.addTransceiver documentation> 
addTransceiverTrack_ ::
                     (MonadDOM m, IsMediaStreamTrackOrKind track) =>
                       RTCPeerConnection -> track -> Maybe RTCRtpTransceiverInit -> m ()
addTransceiverTrack_ :: RTCPeerConnection -> track -> Maybe RTCRtpTransceiverInit -> m ()
addTransceiverTrack_ RTCPeerConnection
self track
track Maybe RTCRtpTransceiverInit
init
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addTransceiver" [track -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal track
track, Maybe RTCRtpTransceiverInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RTCRtpTransceiverInit
init]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.createDataChannel Mozilla webkitRTCPeerConnection.createDataChannel documentation> 
createDataChannel ::
                  (MonadDOM m, ToJSString label) =>
                    RTCPeerConnection ->
                      label -> Maybe RTCDataChannelInit -> m RTCDataChannel
createDataChannel :: RTCPeerConnection
-> label -> Maybe RTCDataChannelInit -> m RTCDataChannel
createDataChannel RTCPeerConnection
self label
label Maybe RTCDataChannelInit
options
  = DOM RTCDataChannel -> m RTCDataChannel
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createDataChannel" [label -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal label
label, Maybe RTCDataChannelInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RTCDataChannelInit
options])
         JSM JSVal -> (JSVal -> DOM RTCDataChannel) -> DOM RTCDataChannel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCDataChannel
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.createDataChannel Mozilla webkitRTCPeerConnection.createDataChannel documentation> 
createDataChannel_ ::
                   (MonadDOM m, ToJSString label) =>
                     RTCPeerConnection -> label -> Maybe RTCDataChannelInit -> m ()
createDataChannel_ :: RTCPeerConnection -> label -> Maybe RTCDataChannelInit -> m ()
createDataChannel_ RTCPeerConnection
self label
label Maybe RTCDataChannelInit
options
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createDataChannel" [label -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal label
label, Maybe RTCDataChannelInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RTCDataChannelInit
options]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getStats Mozilla webkitRTCPeerConnection.getStats documentation> 
getStats ::
         (MonadDOM m, IsMediaStreamTrack selector) =>
           RTCPeerConnection -> Maybe selector -> m RTCStatsReport
getStats :: RTCPeerConnection -> Maybe selector -> m RTCStatsReport
getStats RTCPeerConnection
self Maybe selector
selector
  = DOM RTCStatsReport -> m RTCStatsReport
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getStats" [Maybe selector -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe selector
selector]) JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSVal
readPromise) JSM JSVal -> (JSVal -> DOM RTCStatsReport) -> DOM RTCStatsReport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM RTCStatsReport
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getLocalStreams Mozilla webkitRTCPeerConnection.getLocalStreams documentation> 
getLocalStreams ::
                (MonadDOM m) => RTCPeerConnection -> m [MediaStream]
getLocalStreams :: RTCPeerConnection -> m [MediaStream]
getLocalStreams RTCPeerConnection
self
  = DOM [MediaStream] -> m [MediaStream]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getLocalStreams" ()) JSM JSVal -> (JSVal -> DOM [MediaStream]) -> DOM [MediaStream]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [MediaStream]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getLocalStreams Mozilla webkitRTCPeerConnection.getLocalStreams documentation> 
getLocalStreams_ :: (MonadDOM m) => RTCPeerConnection -> m ()
getLocalStreams_ :: RTCPeerConnection -> m ()
getLocalStreams_ RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getLocalStreams" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getRemoteStreams Mozilla webkitRTCPeerConnection.getRemoteStreams documentation> 
getRemoteStreams ::
                 (MonadDOM m) => RTCPeerConnection -> m [MediaStream]
getRemoteStreams :: RTCPeerConnection -> m [MediaStream]
getRemoteStreams RTCPeerConnection
self
  = DOM [MediaStream] -> m [MediaStream]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getRemoteStreams" ()) JSM JSVal -> (JSVal -> DOM [MediaStream]) -> DOM [MediaStream]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM [MediaStream]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getRemoteStreams Mozilla webkitRTCPeerConnection.getRemoteStreams documentation> 
getRemoteStreams_ :: (MonadDOM m) => RTCPeerConnection -> m ()
getRemoteStreams_ :: RTCPeerConnection -> m ()
getRemoteStreams_ RTCPeerConnection
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 (RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getRemoteStreams" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.getStreamById Mozilla webkitRTCPeerConnection.getStreamById documentation> 
getStreamById ::
              (MonadDOM m, ToJSString streamId) =>
                RTCPeerConnection -> streamId -> m MediaStream
getStreamById :: RTCPeerConnection -> streamId -> m MediaStream
getStreamById RTCPeerConnection
self streamId
streamId
  = DOM MediaStream -> m MediaStream
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"getStreamById" [streamId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal streamId
streamId]) JSM JSVal -> (JSVal -> DOM MediaStream) -> DOM MediaStream
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM MediaStream
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

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

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.localDescription Mozilla webkitRTCPeerConnection.localDescription documentation> 
getLocalDescription ::
                    (MonadDOM m) =>
                      RTCPeerConnection -> m (Maybe RTCSessionDescription)
getLocalDescription :: RTCPeerConnection -> m (Maybe RTCSessionDescription)
getLocalDescription RTCPeerConnection
self
  = DOM (Maybe RTCSessionDescription)
-> m (Maybe RTCSessionDescription)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"localDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.localDescription Mozilla webkitRTCPeerConnection.localDescription documentation> 
getLocalDescriptionUnsafe ::
                          (MonadDOM m, HasCallStack) =>
                            RTCPeerConnection -> m RTCSessionDescription
getLocalDescriptionUnsafe :: RTCPeerConnection -> m RTCSessionDescription
getLocalDescriptionUnsafe RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"localDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RTCSessionDescription)
-> (Maybe RTCSessionDescription -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RTCSessionDescription
-> (RTCSessionDescription -> DOM RTCSessionDescription)
-> Maybe RTCSessionDescription
-> DOM RTCSessionDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RTCSessionDescription
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RTCSessionDescription -> DOM RTCSessionDescription
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.localDescription Mozilla webkitRTCPeerConnection.localDescription documentation> 
getLocalDescriptionUnchecked ::
                             (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription
getLocalDescriptionUnchecked :: RTCPeerConnection -> m RTCSessionDescription
getLocalDescriptionUnchecked RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"localDescription") JSM JSVal
-> (JSVal -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescription
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.currentLocalDescription Mozilla webkitRTCPeerConnection.currentLocalDescription documentation> 
getCurrentLocalDescription ::
                           (MonadDOM m) =>
                             RTCPeerConnection -> m (Maybe RTCSessionDescription)
getCurrentLocalDescription :: RTCPeerConnection -> m (Maybe RTCSessionDescription)
getCurrentLocalDescription RTCPeerConnection
self
  = DOM (Maybe RTCSessionDescription)
-> m (Maybe RTCSessionDescription)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"currentLocalDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.currentLocalDescription Mozilla webkitRTCPeerConnection.currentLocalDescription documentation> 
getCurrentLocalDescriptionUnsafe ::
                                 (MonadDOM m, HasCallStack) =>
                                   RTCPeerConnection -> m RTCSessionDescription
getCurrentLocalDescriptionUnsafe :: RTCPeerConnection -> m RTCSessionDescription
getCurrentLocalDescriptionUnsafe RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"currentLocalDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RTCSessionDescription)
-> (Maybe RTCSessionDescription -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RTCSessionDescription
-> (RTCSessionDescription -> DOM RTCSessionDescription)
-> Maybe RTCSessionDescription
-> DOM RTCSessionDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RTCSessionDescription
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RTCSessionDescription -> DOM RTCSessionDescription
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.currentLocalDescription Mozilla webkitRTCPeerConnection.currentLocalDescription documentation> 
getCurrentLocalDescriptionUnchecked ::
                                    (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription
getCurrentLocalDescriptionUnchecked :: RTCPeerConnection -> m RTCSessionDescription
getCurrentLocalDescriptionUnchecked RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"currentLocalDescription") JSM JSVal
-> (JSVal -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescription
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.pendingLocalDescription Mozilla webkitRTCPeerConnection.pendingLocalDescription documentation> 
getPendingLocalDescription ::
                           (MonadDOM m) =>
                             RTCPeerConnection -> m (Maybe RTCSessionDescription)
getPendingLocalDescription :: RTCPeerConnection -> m (Maybe RTCSessionDescription)
getPendingLocalDescription RTCPeerConnection
self
  = DOM (Maybe RTCSessionDescription)
-> m (Maybe RTCSessionDescription)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"pendingLocalDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.pendingLocalDescription Mozilla webkitRTCPeerConnection.pendingLocalDescription documentation> 
getPendingLocalDescriptionUnsafe ::
                                 (MonadDOM m, HasCallStack) =>
                                   RTCPeerConnection -> m RTCSessionDescription
getPendingLocalDescriptionUnsafe :: RTCPeerConnection -> m RTCSessionDescription
getPendingLocalDescriptionUnsafe RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"pendingLocalDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RTCSessionDescription)
-> (Maybe RTCSessionDescription -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RTCSessionDescription
-> (RTCSessionDescription -> DOM RTCSessionDescription)
-> Maybe RTCSessionDescription
-> DOM RTCSessionDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RTCSessionDescription
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RTCSessionDescription -> DOM RTCSessionDescription
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.pendingLocalDescription Mozilla webkitRTCPeerConnection.pendingLocalDescription documentation> 
getPendingLocalDescriptionUnchecked ::
                                    (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription
getPendingLocalDescriptionUnchecked :: RTCPeerConnection -> m RTCSessionDescription
getPendingLocalDescriptionUnchecked RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"pendingLocalDescription") JSM JSVal
-> (JSVal -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescription
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.remoteDescription Mozilla webkitRTCPeerConnection.remoteDescription documentation> 
getRemoteDescription ::
                     (MonadDOM m) =>
                       RTCPeerConnection -> m (Maybe RTCSessionDescription)
getRemoteDescription :: RTCPeerConnection -> m (Maybe RTCSessionDescription)
getRemoteDescription RTCPeerConnection
self
  = DOM (Maybe RTCSessionDescription)
-> m (Maybe RTCSessionDescription)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"remoteDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.remoteDescription Mozilla webkitRTCPeerConnection.remoteDescription documentation> 
getRemoteDescriptionUnsafe ::
                           (MonadDOM m, HasCallStack) =>
                             RTCPeerConnection -> m RTCSessionDescription
getRemoteDescriptionUnsafe :: RTCPeerConnection -> m RTCSessionDescription
getRemoteDescriptionUnsafe RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"remoteDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RTCSessionDescription)
-> (Maybe RTCSessionDescription -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RTCSessionDescription
-> (RTCSessionDescription -> DOM RTCSessionDescription)
-> Maybe RTCSessionDescription
-> DOM RTCSessionDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RTCSessionDescription
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RTCSessionDescription -> DOM RTCSessionDescription
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.remoteDescription Mozilla webkitRTCPeerConnection.remoteDescription documentation> 
getRemoteDescriptionUnchecked ::
                              (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription
getRemoteDescriptionUnchecked :: RTCPeerConnection -> m RTCSessionDescription
getRemoteDescriptionUnchecked RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"remoteDescription") JSM JSVal
-> (JSVal -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescription
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.currentRemoteDescription Mozilla webkitRTCPeerConnection.currentRemoteDescription documentation> 
getCurrentRemoteDescription ::
                            (MonadDOM m) =>
                              RTCPeerConnection -> m (Maybe RTCSessionDescription)
getCurrentRemoteDescription :: RTCPeerConnection -> m (Maybe RTCSessionDescription)
getCurrentRemoteDescription RTCPeerConnection
self
  = DOM (Maybe RTCSessionDescription)
-> m (Maybe RTCSessionDescription)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"currentRemoteDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.currentRemoteDescription Mozilla webkitRTCPeerConnection.currentRemoteDescription documentation> 
getCurrentRemoteDescriptionUnsafe ::
                                  (MonadDOM m, HasCallStack) =>
                                    RTCPeerConnection -> m RTCSessionDescription
getCurrentRemoteDescriptionUnsafe :: RTCPeerConnection -> m RTCSessionDescription
getCurrentRemoteDescriptionUnsafe RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"currentRemoteDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RTCSessionDescription)
-> (Maybe RTCSessionDescription -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RTCSessionDescription
-> (RTCSessionDescription -> DOM RTCSessionDescription)
-> Maybe RTCSessionDescription
-> DOM RTCSessionDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RTCSessionDescription
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RTCSessionDescription -> DOM RTCSessionDescription
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.currentRemoteDescription Mozilla webkitRTCPeerConnection.currentRemoteDescription documentation> 
getCurrentRemoteDescriptionUnchecked ::
                                     (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription
getCurrentRemoteDescriptionUnchecked :: RTCPeerConnection -> m RTCSessionDescription
getCurrentRemoteDescriptionUnchecked RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"currentRemoteDescription") JSM JSVal
-> (JSVal -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescription
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.pendingRemoteDescription Mozilla webkitRTCPeerConnection.pendingRemoteDescription documentation> 
getPendingRemoteDescription ::
                            (MonadDOM m) =>
                              RTCPeerConnection -> m (Maybe RTCSessionDescription)
getPendingRemoteDescription :: RTCPeerConnection -> m (Maybe RTCSessionDescription)
getPendingRemoteDescription RTCPeerConnection
self
  = DOM (Maybe RTCSessionDescription)
-> m (Maybe RTCSessionDescription)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"pendingRemoteDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.pendingRemoteDescription Mozilla webkitRTCPeerConnection.pendingRemoteDescription documentation> 
getPendingRemoteDescriptionUnsafe ::
                                  (MonadDOM m, HasCallStack) =>
                                    RTCPeerConnection -> m RTCSessionDescription
getPendingRemoteDescriptionUnsafe :: RTCPeerConnection -> m RTCSessionDescription
getPendingRemoteDescriptionUnsafe RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"pendingRemoteDescription") JSM JSVal
-> (JSVal -> DOM (Maybe RTCSessionDescription))
-> DOM (Maybe RTCSessionDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe RTCSessionDescription)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe RTCSessionDescription)
-> (Maybe RTCSessionDescription -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM RTCSessionDescription
-> (RTCSessionDescription -> DOM RTCSessionDescription)
-> Maybe RTCSessionDescription
-> DOM RTCSessionDescription
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM RTCSessionDescription
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") RTCSessionDescription -> DOM RTCSessionDescription
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.pendingRemoteDescription Mozilla webkitRTCPeerConnection.pendingRemoteDescription documentation> 
getPendingRemoteDescriptionUnchecked ::
                                     (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription
getPendingRemoteDescriptionUnchecked :: RTCPeerConnection -> m RTCSessionDescription
getPendingRemoteDescriptionUnchecked RTCPeerConnection
self
  = DOM RTCSessionDescription -> m RTCSessionDescription
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"pendingRemoteDescription") JSM JSVal
-> (JSVal -> DOM RTCSessionDescription)
-> DOM RTCSessionDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSessionDescription
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.signalingState Mozilla webkitRTCPeerConnection.signalingState documentation> 
getSignalingState ::
                  (MonadDOM m) => RTCPeerConnection -> m RTCSignalingState
getSignalingState :: RTCPeerConnection -> m RTCSignalingState
getSignalingState RTCPeerConnection
self
  = DOM RTCSignalingState -> m RTCSignalingState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"signalingState") JSM JSVal
-> (JSVal -> DOM RTCSignalingState) -> DOM RTCSignalingState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCSignalingState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.iceGatheringState Mozilla webkitRTCPeerConnection.iceGatheringState documentation> 
getIceGatheringState ::
                     (MonadDOM m) => RTCPeerConnection -> m RTCIceGatheringState
getIceGatheringState :: RTCPeerConnection -> m RTCIceGatheringState
getIceGatheringState RTCPeerConnection
self
  = DOM RTCIceGatheringState -> m RTCIceGatheringState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"iceGatheringState") JSM JSVal
-> (JSVal -> DOM RTCIceGatheringState) -> DOM RTCIceGatheringState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCIceGatheringState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.iceConnectionState Mozilla webkitRTCPeerConnection.iceConnectionState documentation> 
getIceConnectionState ::
                      (MonadDOM m) => RTCPeerConnection -> m RTCIceConnectionState
getIceConnectionState :: RTCPeerConnection -> m RTCIceConnectionState
getIceConnectionState RTCPeerConnection
self
  = DOM RTCIceConnectionState -> m RTCIceConnectionState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"iceConnectionState") JSM JSVal
-> (JSVal -> DOM RTCIceConnectionState)
-> DOM RTCIceConnectionState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCIceConnectionState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.connectionState Mozilla webkitRTCPeerConnection.connectionState documentation> 
getConnectionState ::
                   (MonadDOM m) => RTCPeerConnection -> m RTCPeerConnectionState
getConnectionState :: RTCPeerConnection -> m RTCPeerConnectionState
getConnectionState RTCPeerConnection
self
  = DOM RTCPeerConnectionState -> m RTCPeerConnectionState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((RTCPeerConnection
self RTCPeerConnection
-> Getting (JSM JSVal) RTCPeerConnection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter RTCPeerConnection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"connectionState") JSM JSVal
-> (JSVal -> DOM RTCPeerConnectionState)
-> DOM RTCPeerConnectionState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RTCPeerConnectionState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.onnegotiationneeded Mozilla webkitRTCPeerConnection.onnegotiationneeded documentation> 
negotiationNeeded :: EventName RTCPeerConnection Event
negotiationNeeded :: EventName RTCPeerConnection Event
negotiationNeeded
  = DOMString -> EventName RTCPeerConnection Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"negotiationneeded")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.onicecandidate Mozilla webkitRTCPeerConnection.onicecandidate documentation> 
iceCandidate :: EventName RTCPeerConnection RTCIceCandidateEvent
iceCandidate :: EventName RTCPeerConnection RTCIceCandidateEvent
iceCandidate = DOMString -> EventName RTCPeerConnection RTCIceCandidateEvent
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"icecandidate")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.onsignalingstatechange Mozilla webkitRTCPeerConnection.onsignalingstatechange documentation> 
signalingStateChange :: EventName RTCPeerConnection Event
signalingStateChange :: EventName RTCPeerConnection Event
signalingStateChange
  = DOMString -> EventName RTCPeerConnection Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"signalingstatechange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.oniceconnectionstatechange Mozilla webkitRTCPeerConnection.oniceconnectionstatechange documentation> 
iceConnectionStateChange :: EventName RTCPeerConnection Event
iceConnectionStateChange :: EventName RTCPeerConnection Event
iceConnectionStateChange
  = DOMString -> EventName RTCPeerConnection Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"iceconnectionstatechange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.onicegatheringstatechange Mozilla webkitRTCPeerConnection.onicegatheringstatechange documentation> 
icegatheringstatechange ::
                          EventName RTCPeerConnection onicegatheringstatechange
icegatheringstatechange :: EventName RTCPeerConnection onicegatheringstatechange
icegatheringstatechange
  = DOMString -> EventName RTCPeerConnection onicegatheringstatechange
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"icegatheringstatechange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.onconnectionstatechange Mozilla webkitRTCPeerConnection.onconnectionstatechange documentation> 
connectionstatechange ::
                        EventName RTCPeerConnection onconnectionstatechange
connectionstatechange :: EventName RTCPeerConnection onconnectionstatechange
connectionstatechange
  = DOMString -> EventName RTCPeerConnection onconnectionstatechange
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"connectionstatechange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.ontrack Mozilla webkitRTCPeerConnection.ontrack documentation> 
track :: EventName RTCPeerConnection ontrack
track :: EventName RTCPeerConnection ontrack
track = DOMString -> EventName RTCPeerConnection ontrack
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"track")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.ondatachannel Mozilla webkitRTCPeerConnection.ondatachannel documentation> 
dataChannel :: EventName RTCPeerConnection Event
dataChannel :: EventName RTCPeerConnection Event
dataChannel = DOMString -> EventName RTCPeerConnection Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"datachannel")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/webkitRTCPeerConnection.onaddstream Mozilla webkitRTCPeerConnection.onaddstream documentation> 
addStreamEvent :: EventName RTCPeerConnection Event
addStreamEvent :: EventName RTCPeerConnection Event
addStreamEvent = DOMString -> EventName RTCPeerConnection Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"addstream")