{-# 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 -- | createOffer :: (MonadDOM m) => RTCPeerConnection -> Maybe RTCOfferOptions -> m RTCSessionDescriptionInit createOffer self offerOptions = liftDOM (((self ^. jsf "createOffer" [toJSVal offerOptions]) >>= readPromise) >>= fromJSValUnchecked) -- | createOffer_ :: (MonadDOM m) => RTCPeerConnection -> Maybe RTCOfferOptions -> m () createOffer_ self offerOptions = liftDOM (void (self ^. jsf "createOffer" [toJSVal offerOptions])) -- | createAnswer :: (MonadDOM m) => RTCPeerConnection -> Maybe RTCAnswerOptions -> m RTCSessionDescriptionInit createAnswer self answerOptions = liftDOM (((self ^. jsf "createAnswer" [toJSVal answerOptions]) >>= readPromise) >>= fromJSValUnchecked) -- | createAnswer_ :: (MonadDOM m) => RTCPeerConnection -> Maybe RTCAnswerOptions -> m () createAnswer_ self answerOptions = liftDOM (void (self ^. jsf "createAnswer" [toJSVal answerOptions])) -- | setLocalDescription :: (MonadDOM m) => RTCPeerConnection -> RTCSessionDescriptionInit -> m () setLocalDescription self description = liftDOM (void ((self ^. jsf "setLocalDescription" [toJSVal description]) >>= readPromise)) -- | setRemoteDescription :: (MonadDOM m) => RTCPeerConnection -> RTCSessionDescriptionInit -> m () setRemoteDescription self description = liftDOM (void ((self ^. jsf "setRemoteDescription" [toJSVal description]) >>= readPromise)) -- | addIceCandidate :: (MonadDOM m, IsRTCIceCandidateOrInit candidate) => RTCPeerConnection -> candidate -> m () addIceCandidate self candidate = liftDOM (void ((self ^. jsf "addIceCandidate" [toJSVal candidate]) >>= readPromise)) -- | getConfiguration :: (MonadDOM m) => RTCPeerConnection -> m RTCConfiguration getConfiguration self = liftDOM ((self ^. jsf "getConfiguration" ()) >>= fromJSValUnchecked) -- | getConfiguration_ :: (MonadDOM m) => RTCPeerConnection -> m () getConfiguration_ self = liftDOM (void (self ^. jsf "getConfiguration" ())) -- | setConfiguration :: (MonadDOM m) => RTCPeerConnection -> RTCConfiguration -> m () setConfiguration self configuration = liftDOM (void (self ^. jsf "setConfiguration" [toJSVal configuration])) -- | close :: (MonadDOM m) => RTCPeerConnection -> m () close self = liftDOM (void (self ^. jsf "close" ())) -- | getSenders :: (MonadDOM m) => RTCPeerConnection -> m [RTCRtpSender] getSenders self = liftDOM ((self ^. jsf "getSenders" ()) >>= fromJSArrayUnchecked) -- | getSenders_ :: (MonadDOM m) => RTCPeerConnection -> m () getSenders_ self = liftDOM (void (self ^. jsf "getSenders" ())) -- | getReceivers :: (MonadDOM m) => RTCPeerConnection -> m [RTCRtpReceiver] getReceivers self = liftDOM ((self ^. jsf "getReceivers" ()) >>= fromJSArrayUnchecked) -- | getReceivers_ :: (MonadDOM m) => RTCPeerConnection -> m () getReceivers_ self = liftDOM (void (self ^. jsf "getReceivers" ())) -- | getTransceivers :: (MonadDOM m) => RTCPeerConnection -> m [RTCRtpTransceiver] getTransceivers self = liftDOM ((self ^. jsf "getTransceivers" ()) >>= fromJSArrayUnchecked) -- | getTransceivers_ :: (MonadDOM m) => RTCPeerConnection -> m () getTransceivers_ self = liftDOM (void (self ^. jsf "getTransceivers" ())) -- | addTrack :: (MonadDOM m, IsMediaStreamTrack track) => RTCPeerConnection -> track -> [MediaStream] -> m RTCRtpSender addTrack self track streams = liftDOM ((self ^. jsf "addTrack" [toJSVal track, toJSVal (array streams)]) >>= fromJSValUnchecked) -- | addTrack_ :: (MonadDOM m, IsMediaStreamTrack track) => RTCPeerConnection -> track -> [MediaStream] -> m () addTrack_ self track streams = liftDOM (void (self ^. jsf "addTrack" [toJSVal track, toJSVal (array streams)])) -- | removeTrack :: (MonadDOM m) => RTCPeerConnection -> RTCRtpSender -> m () removeTrack self sender = liftDOM (void (self ^. jsf "removeTrack" [toJSVal sender])) -- | addTransceiverTrack :: (MonadDOM m, IsMediaStreamTrackOrKind track) => RTCPeerConnection -> track -> Maybe RTCRtpTransceiverInit -> m RTCRtpTransceiver addTransceiverTrack self track init = liftDOM ((self ^. jsf "addTransceiver" [toJSVal track, toJSVal init]) >>= fromJSValUnchecked) -- | addTransceiverTrack_ :: (MonadDOM m, IsMediaStreamTrackOrKind track) => RTCPeerConnection -> track -> Maybe RTCRtpTransceiverInit -> m () addTransceiverTrack_ self track init = liftDOM (void (self ^. jsf "addTransceiver" [toJSVal track, toJSVal init])) -- | createDataChannel :: (MonadDOM m, ToJSString label) => RTCPeerConnection -> label -> Maybe RTCDataChannelInit -> m RTCDataChannel createDataChannel self label options = liftDOM ((self ^. jsf "createDataChannel" [toJSVal label, toJSVal options]) >>= fromJSValUnchecked) -- | createDataChannel_ :: (MonadDOM m, ToJSString label) => RTCPeerConnection -> label -> Maybe RTCDataChannelInit -> m () createDataChannel_ self label options = liftDOM (void (self ^. jsf "createDataChannel" [toJSVal label, toJSVal options])) -- | getStats :: (MonadDOM m, IsMediaStreamTrack selector) => RTCPeerConnection -> Maybe selector -> m RTCStatsReport getStats self selector = liftDOM (((self ^. jsf "getStats" [toJSVal selector]) >>= readPromise) >>= fromJSValUnchecked) -- | getStats_ :: (MonadDOM m, IsMediaStreamTrack selector) => RTCPeerConnection -> Maybe selector -> m () getStats_ self selector = liftDOM (void (self ^. jsf "getStats" [toJSVal selector])) -- | getLocalStreams :: (MonadDOM m) => RTCPeerConnection -> m [MediaStream] getLocalStreams self = liftDOM ((self ^. jsf "getLocalStreams" ()) >>= fromJSArrayUnchecked) -- | getLocalStreams_ :: (MonadDOM m) => RTCPeerConnection -> m () getLocalStreams_ self = liftDOM (void (self ^. jsf "getLocalStreams" ())) -- | getRemoteStreams :: (MonadDOM m) => RTCPeerConnection -> m [MediaStream] getRemoteStreams self = liftDOM ((self ^. jsf "getRemoteStreams" ()) >>= fromJSArrayUnchecked) -- | getRemoteStreams_ :: (MonadDOM m) => RTCPeerConnection -> m () getRemoteStreams_ self = liftDOM (void (self ^. jsf "getRemoteStreams" ())) -- | getStreamById :: (MonadDOM m, ToJSString streamId) => RTCPeerConnection -> streamId -> m MediaStream getStreamById self streamId = liftDOM ((self ^. jsf "getStreamById" [toJSVal streamId]) >>= fromJSValUnchecked) -- | getStreamById_ :: (MonadDOM m, ToJSString streamId) => RTCPeerConnection -> streamId -> m () getStreamById_ self streamId = liftDOM (void (self ^. jsf "getStreamById" [toJSVal streamId])) -- | addStream :: (MonadDOM m) => RTCPeerConnection -> MediaStream -> m () addStream self stream = liftDOM (void (self ^. jsf "addStream" [toJSVal stream])) -- | removeStream :: (MonadDOM m) => RTCPeerConnection -> MediaStream -> m () removeStream self stream = liftDOM (void (self ^. jsf "removeStream" [toJSVal stream])) -- | getLocalDescription :: (MonadDOM m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getLocalDescription self = liftDOM ((self ^. js "localDescription") >>= fromJSVal) -- | getLocalDescriptionUnsafe :: (MonadDOM m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getLocalDescriptionUnsafe self = liftDOM (((self ^. js "localDescription") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getLocalDescriptionUnchecked :: (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription getLocalDescriptionUnchecked self = liftDOM ((self ^. js "localDescription") >>= fromJSValUnchecked) -- | getCurrentLocalDescription :: (MonadDOM m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getCurrentLocalDescription self = liftDOM ((self ^. js "currentLocalDescription") >>= fromJSVal) -- | getCurrentLocalDescriptionUnsafe :: (MonadDOM m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getCurrentLocalDescriptionUnsafe self = liftDOM (((self ^. js "currentLocalDescription") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getCurrentLocalDescriptionUnchecked :: (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription getCurrentLocalDescriptionUnchecked self = liftDOM ((self ^. js "currentLocalDescription") >>= fromJSValUnchecked) -- | getPendingLocalDescription :: (MonadDOM m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getPendingLocalDescription self = liftDOM ((self ^. js "pendingLocalDescription") >>= fromJSVal) -- | getPendingLocalDescriptionUnsafe :: (MonadDOM m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getPendingLocalDescriptionUnsafe self = liftDOM (((self ^. js "pendingLocalDescription") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getPendingLocalDescriptionUnchecked :: (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription getPendingLocalDescriptionUnchecked self = liftDOM ((self ^. js "pendingLocalDescription") >>= fromJSValUnchecked) -- | getRemoteDescription :: (MonadDOM m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getRemoteDescription self = liftDOM ((self ^. js "remoteDescription") >>= fromJSVal) -- | getRemoteDescriptionUnsafe :: (MonadDOM m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getRemoteDescriptionUnsafe self = liftDOM (((self ^. js "remoteDescription") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getRemoteDescriptionUnchecked :: (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription getRemoteDescriptionUnchecked self = liftDOM ((self ^. js "remoteDescription") >>= fromJSValUnchecked) -- | getCurrentRemoteDescription :: (MonadDOM m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getCurrentRemoteDescription self = liftDOM ((self ^. js "currentRemoteDescription") >>= fromJSVal) -- | getCurrentRemoteDescriptionUnsafe :: (MonadDOM m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getCurrentRemoteDescriptionUnsafe self = liftDOM (((self ^. js "currentRemoteDescription") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getCurrentRemoteDescriptionUnchecked :: (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription getCurrentRemoteDescriptionUnchecked self = liftDOM ((self ^. js "currentRemoteDescription") >>= fromJSValUnchecked) -- | getPendingRemoteDescription :: (MonadDOM m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getPendingRemoteDescription self = liftDOM ((self ^. js "pendingRemoteDescription") >>= fromJSVal) -- | getPendingRemoteDescriptionUnsafe :: (MonadDOM m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getPendingRemoteDescriptionUnsafe self = liftDOM (((self ^. js "pendingRemoteDescription") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getPendingRemoteDescriptionUnchecked :: (MonadDOM m) => RTCPeerConnection -> m RTCSessionDescription getPendingRemoteDescriptionUnchecked self = liftDOM ((self ^. js "pendingRemoteDescription") >>= fromJSValUnchecked) -- | getSignalingState :: (MonadDOM m) => RTCPeerConnection -> m RTCSignalingState getSignalingState self = liftDOM ((self ^. js "signalingState") >>= fromJSValUnchecked) -- | getIceGatheringState :: (MonadDOM m) => RTCPeerConnection -> m RTCIceGatheringState getIceGatheringState self = liftDOM ((self ^. js "iceGatheringState") >>= fromJSValUnchecked) -- | getIceConnectionState :: (MonadDOM m) => RTCPeerConnection -> m RTCIceConnectionState getIceConnectionState self = liftDOM ((self ^. js "iceConnectionState") >>= fromJSValUnchecked) -- | getConnectionState :: (MonadDOM m) => RTCPeerConnection -> m RTCPeerConnectionState getConnectionState self = liftDOM ((self ^. js "connectionState") >>= fromJSValUnchecked) -- | negotiationNeeded :: EventName RTCPeerConnection Event negotiationNeeded = unsafeEventName (toJSString "negotiationneeded") -- | iceCandidate :: EventName RTCPeerConnection RTCIceCandidateEvent iceCandidate = unsafeEventName (toJSString "icecandidate") -- | signalingStateChange :: EventName RTCPeerConnection Event signalingStateChange = unsafeEventName (toJSString "signalingstatechange") -- | iceConnectionStateChange :: EventName RTCPeerConnection Event iceConnectionStateChange = unsafeEventName (toJSString "iceconnectionstatechange") -- | icegatheringstatechange :: EventName RTCPeerConnection onicegatheringstatechange icegatheringstatechange = unsafeEventName (toJSString "icegatheringstatechange") -- | connectionstatechange :: EventName RTCPeerConnection onconnectionstatechange connectionstatechange = unsafeEventName (toJSString "connectionstatechange") -- | track :: EventName RTCPeerConnection ontrack track = unsafeEventName (toJSString "track") -- | dataChannel :: EventName RTCPeerConnection Event dataChannel = unsafeEventName (toJSString "datachannel") -- | addStreamEvent :: EventName RTCPeerConnection Event addStreamEvent = unsafeEventName (toJSString "addstream")