{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE JavaScriptFFI #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} module GHCJS.DOM.JSFFI.Generated.RTCPeerConnection (js_createOffer, createOffer, createOffer_, js_createAnswer, createAnswer, createAnswer_, js_setLocalDescription, setLocalDescription, js_setRemoteDescription, setRemoteDescription, js_addIceCandidate, addIceCandidate, js_getConfiguration, getConfiguration, getConfiguration_, js_setConfiguration, setConfiguration, js_close, close, js_getSenders, getSenders, getSenders_, js_getReceivers, getReceivers, getReceivers_, js_getTransceivers, getTransceivers, getTransceivers_, js_addTrack, addTrack, addTrack_, js_removeTrack, removeTrack, js_addTransceiverTrack, addTransceiverTrack, addTransceiverTrack_, js_createDataChannel, createDataChannel, createDataChannel_, js_getStats, getStats, getStats_, js_getLocalStreams, getLocalStreams, getLocalStreams_, js_getRemoteStreams, getRemoteStreams, getRemoteStreams_, js_getStreamById, getStreamById, getStreamById_, js_addStream, addStream, js_removeStream, removeStream, js_getLocalDescription, getLocalDescription, getLocalDescriptionUnsafe, getLocalDescriptionUnchecked, js_getCurrentLocalDescription, getCurrentLocalDescription, getCurrentLocalDescriptionUnsafe, getCurrentLocalDescriptionUnchecked, js_getPendingLocalDescription, getPendingLocalDescription, getPendingLocalDescriptionUnsafe, getPendingLocalDescriptionUnchecked, js_getRemoteDescription, getRemoteDescription, getRemoteDescriptionUnsafe, getRemoteDescriptionUnchecked, js_getCurrentRemoteDescription, getCurrentRemoteDescription, getCurrentRemoteDescriptionUnsafe, getCurrentRemoteDescriptionUnchecked, js_getPendingRemoteDescription, getPendingRemoteDescription, getPendingRemoteDescriptionUnsafe, getPendingRemoteDescriptionUnchecked, js_getSignalingState, getSignalingState, js_getIceGatheringState, getIceGatheringState, js_getIceConnectionState, getIceConnectionState, js_getConnectionState, 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, fmap, Show, Read, Eq, Ord) import qualified Prelude (error) import Data.Typeable (Typeable) import GHCJS.Types (JSVal(..), JSString) import GHCJS.Foreign (jsNull, jsUndefined) import GHCJS.Foreign.Callback (syncCallback, asyncCallback, syncCallback1, asyncCallback1, syncCallback2, asyncCallback2, OnBlocked(..)) import GHCJS.Marshal (ToJSVal(..), FromJSVal(..)) import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..)) import Data.Int (Int64) import Data.Word (Word, Word64) import Data.Maybe (fromJust) import Data.Traversable (mapM) import GHCJS.DOM.Types import Control.Applicative ((<$>)) import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName, unsafeEventNameAsync) import GHCJS.DOM.JSFFI.Generated.Enums foreign import javascript interruptible "$1[\"createOffer\"]($2).then(function(s) { $c(null, s);}, function(e) { $c(e, null);});" js_createOffer :: RTCPeerConnection -> Optional RTCOfferOptions -> IO (JSVal, RTCSessionDescriptionInit) -- | createOffer :: (MonadIO m) => RTCPeerConnection -> Maybe RTCOfferOptions -> m RTCSessionDescriptionInit createOffer self offerOptions = liftIO ((js_createOffer self (maybeToOptional offerOptions)) >>= checkPromiseResult) -- | createOffer_ :: (MonadIO m) => RTCPeerConnection -> Maybe RTCOfferOptions -> m () createOffer_ self offerOptions = liftIO (void (js_createOffer self (maybeToOptional offerOptions))) foreign import javascript interruptible "$1[\"createAnswer\"]($2).then(function(s) { $c(null, s);}, function(e) { $c(e, null);});" js_createAnswer :: RTCPeerConnection -> Optional RTCAnswerOptions -> IO (JSVal, RTCSessionDescriptionInit) -- | createAnswer :: (MonadIO m) => RTCPeerConnection -> Maybe RTCAnswerOptions -> m RTCSessionDescriptionInit createAnswer self answerOptions = liftIO ((js_createAnswer self (maybeToOptional answerOptions)) >>= checkPromiseResult) -- | createAnswer_ :: (MonadIO m) => RTCPeerConnection -> Maybe RTCAnswerOptions -> m () createAnswer_ self answerOptions = liftIO (void (js_createAnswer self (maybeToOptional answerOptions))) foreign import javascript interruptible "$1[\"setLocalDescription\"]($2).then(function(s) { $c(null, s);}, function(e) { $c(e, null);});" js_setLocalDescription :: RTCPeerConnection -> RTCSessionDescriptionInit -> IO JSVal -- | setLocalDescription :: (MonadIO m) => RTCPeerConnection -> RTCSessionDescriptionInit -> m () setLocalDescription self description = liftIO ((js_setLocalDescription self description) >>= maybeThrowPromiseRejected) foreign import javascript interruptible "$1[\"setRemoteDescription\"]($2).then(function(s) { $c(null, s);}, function(e) { $c(e, null);});" js_setRemoteDescription :: RTCPeerConnection -> RTCSessionDescriptionInit -> IO JSVal -- | setRemoteDescription :: (MonadIO m) => RTCPeerConnection -> RTCSessionDescriptionInit -> m () setRemoteDescription self description = liftIO ((js_setRemoteDescription self description) >>= maybeThrowPromiseRejected) foreign import javascript interruptible "$1[\"addIceCandidate\"]($2).then(function(s) { $c(null, s);}, function(e) { $c(e, null);});" js_addIceCandidate :: RTCPeerConnection -> RTCIceCandidateOrInit -> IO JSVal -- | addIceCandidate :: (MonadIO m, IsRTCIceCandidateOrInit candidate) => RTCPeerConnection -> candidate -> m () addIceCandidate self candidate = liftIO ((toJSVal candidate >>= \ candidate' -> js_addIceCandidate self (RTCIceCandidateOrInit candidate')) >>= maybeThrowPromiseRejected) foreign import javascript unsafe "$1[\"getConfiguration\"]()" js_getConfiguration :: RTCPeerConnection -> IO RTCConfiguration -- | getConfiguration :: (MonadIO m) => RTCPeerConnection -> m RTCConfiguration getConfiguration self = liftIO (js_getConfiguration self) -- | getConfiguration_ :: (MonadIO m) => RTCPeerConnection -> m () getConfiguration_ self = liftIO (void (js_getConfiguration self)) foreign import javascript safe "$1[\"setConfiguration\"]($2)" js_setConfiguration :: RTCPeerConnection -> RTCConfiguration -> IO () -- | setConfiguration :: (MonadIO m) => RTCPeerConnection -> RTCConfiguration -> m () setConfiguration self configuration = liftIO (js_setConfiguration self configuration) foreign import javascript unsafe "$1[\"close\"]()" js_close :: RTCPeerConnection -> IO () -- | close :: (MonadIO m) => RTCPeerConnection -> m () close self = liftIO (js_close self) foreign import javascript unsafe "$1[\"getSenders\"]()" js_getSenders :: RTCPeerConnection -> IO JSVal -- | getSenders :: (MonadIO m) => RTCPeerConnection -> m [RTCRtpSender] getSenders self = liftIO ((js_getSenders self) >>= fromJSValUnchecked) -- | getSenders_ :: (MonadIO m) => RTCPeerConnection -> m () getSenders_ self = liftIO (void (js_getSenders self)) foreign import javascript unsafe "$1[\"getReceivers\"]()" js_getReceivers :: RTCPeerConnection -> IO JSVal -- | getReceivers :: (MonadIO m) => RTCPeerConnection -> m [RTCRtpReceiver] getReceivers self = liftIO ((js_getReceivers self) >>= fromJSValUnchecked) -- | getReceivers_ :: (MonadIO m) => RTCPeerConnection -> m () getReceivers_ self = liftIO (void (js_getReceivers self)) foreign import javascript unsafe "$1[\"getTransceivers\"]()" js_getTransceivers :: RTCPeerConnection -> IO JSVal -- | getTransceivers :: (MonadIO m) => RTCPeerConnection -> m [RTCRtpTransceiver] getTransceivers self = liftIO ((js_getTransceivers self) >>= fromJSValUnchecked) -- | getTransceivers_ :: (MonadIO m) => RTCPeerConnection -> m () getTransceivers_ self = liftIO (void (js_getTransceivers self)) foreign import javascript safe "$1[\"addTrack\"]($2, $3)" js_addTrack :: RTCPeerConnection -> MediaStreamTrack -> JSVal -> IO RTCRtpSender -- | addTrack :: (MonadIO m, IsMediaStreamTrack track) => RTCPeerConnection -> track -> [MediaStream] -> m RTCRtpSender addTrack self track streams = liftIO (toJSVal streams >>= \ streams' -> js_addTrack self (toMediaStreamTrack track) streams') -- | addTrack_ :: (MonadIO m, IsMediaStreamTrack track) => RTCPeerConnection -> track -> [MediaStream] -> m () addTrack_ self track streams = liftIO (void (toJSVal streams >>= \ streams' -> js_addTrack self (toMediaStreamTrack track) streams')) foreign import javascript safe "$1[\"removeTrack\"]($2)" js_removeTrack :: RTCPeerConnection -> RTCRtpSender -> IO () -- | removeTrack :: (MonadIO m) => RTCPeerConnection -> RTCRtpSender -> m () removeTrack self sender = liftIO (js_removeTrack self sender) foreign import javascript safe "$1[\"addTransceiver\"]($2, $3)" js_addTransceiverTrack :: RTCPeerConnection -> MediaStreamTrackOrKind -> Optional RTCRtpTransceiverInit -> IO RTCRtpTransceiver -- | addTransceiverTrack :: (MonadIO m, IsMediaStreamTrackOrKind track) => RTCPeerConnection -> track -> Maybe RTCRtpTransceiverInit -> m RTCRtpTransceiver addTransceiverTrack self track init = liftIO (toJSVal track >>= \ track' -> js_addTransceiverTrack self (MediaStreamTrackOrKind track') (maybeToOptional init)) -- | addTransceiverTrack_ :: (MonadIO m, IsMediaStreamTrackOrKind track) => RTCPeerConnection -> track -> Maybe RTCRtpTransceiverInit -> m () addTransceiverTrack_ self track init = liftIO (void (toJSVal track >>= \ track' -> js_addTransceiverTrack self (MediaStreamTrackOrKind track') (maybeToOptional init))) foreign import javascript safe "$1[\"createDataChannel\"]($2, $3)" js_createDataChannel :: RTCPeerConnection -> JSString -> Optional RTCDataChannelInit -> IO RTCDataChannel -- | createDataChannel :: (MonadIO m, ToJSString label) => RTCPeerConnection -> label -> Maybe RTCDataChannelInit -> m RTCDataChannel createDataChannel self label options = liftIO (js_createDataChannel self (toJSString label) (maybeToOptional options)) -- | createDataChannel_ :: (MonadIO m, ToJSString label) => RTCPeerConnection -> label -> Maybe RTCDataChannelInit -> m () createDataChannel_ self label options = liftIO (void (js_createDataChannel self (toJSString label) (maybeToOptional options))) foreign import javascript interruptible "$1[\"getStats\"]($2).then(function(s) { $c(null, s);}, function(e) { $c(e, null);});" js_getStats :: RTCPeerConnection -> Optional MediaStreamTrack -> IO (JSVal, RTCStatsReport) -- | getStats :: (MonadIO m, IsMediaStreamTrack selector) => RTCPeerConnection -> Maybe selector -> m RTCStatsReport getStats self selector = liftIO ((js_getStats self (maybeToOptional (fmap toMediaStreamTrack selector))) >>= checkPromiseResult) -- | getStats_ :: (MonadIO m, IsMediaStreamTrack selector) => RTCPeerConnection -> Maybe selector -> m () getStats_ self selector = liftIO (void (js_getStats self (maybeToOptional (fmap toMediaStreamTrack selector)))) foreign import javascript unsafe "$1[\"getLocalStreams\"]()" js_getLocalStreams :: RTCPeerConnection -> IO JSVal -- | getLocalStreams :: (MonadIO m) => RTCPeerConnection -> m [MediaStream] getLocalStreams self = liftIO ((js_getLocalStreams self) >>= fromJSValUnchecked) -- | getLocalStreams_ :: (MonadIO m) => RTCPeerConnection -> m () getLocalStreams_ self = liftIO (void (js_getLocalStreams self)) foreign import javascript unsafe "$1[\"getRemoteStreams\"]()" js_getRemoteStreams :: RTCPeerConnection -> IO JSVal -- | getRemoteStreams :: (MonadIO m) => RTCPeerConnection -> m [MediaStream] getRemoteStreams self = liftIO ((js_getRemoteStreams self) >>= fromJSValUnchecked) -- | getRemoteStreams_ :: (MonadIO m) => RTCPeerConnection -> m () getRemoteStreams_ self = liftIO (void (js_getRemoteStreams self)) foreign import javascript unsafe "$1[\"getStreamById\"]($2)" js_getStreamById :: RTCPeerConnection -> JSString -> IO MediaStream -- | getStreamById :: (MonadIO m, ToJSString streamId) => RTCPeerConnection -> streamId -> m MediaStream getStreamById self streamId = liftIO (js_getStreamById self (toJSString streamId)) -- | getStreamById_ :: (MonadIO m, ToJSString streamId) => RTCPeerConnection -> streamId -> m () getStreamById_ self streamId = liftIO (void (js_getStreamById self (toJSString streamId))) foreign import javascript unsafe "$1[\"addStream\"]($2)" js_addStream :: RTCPeerConnection -> MediaStream -> IO () -- | addStream :: (MonadIO m) => RTCPeerConnection -> MediaStream -> m () addStream self stream = liftIO (js_addStream self stream) foreign import javascript unsafe "$1[\"removeStream\"]($2)" js_removeStream :: RTCPeerConnection -> MediaStream -> IO () -- | removeStream :: (MonadIO m) => RTCPeerConnection -> MediaStream -> m () removeStream self stream = liftIO (js_removeStream self stream) foreign import javascript unsafe "$1[\"localDescription\"]" js_getLocalDescription :: RTCPeerConnection -> IO (Nullable RTCSessionDescription) -- | getLocalDescription :: (MonadIO m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getLocalDescription self = liftIO (nullableToMaybe <$> (js_getLocalDescription self)) -- | getLocalDescriptionUnsafe :: (MonadIO m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getLocalDescriptionUnsafe self = liftIO ((nullableToMaybe <$> (js_getLocalDescription self)) >>= maybe (Prelude.error "Nothing to return") return) -- | getLocalDescriptionUnchecked :: (MonadIO m) => RTCPeerConnection -> m RTCSessionDescription getLocalDescriptionUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getLocalDescription self)) foreign import javascript unsafe "$1[\"currentLocalDescription\"]" js_getCurrentLocalDescription :: RTCPeerConnection -> IO (Nullable RTCSessionDescription) -- | getCurrentLocalDescription :: (MonadIO m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getCurrentLocalDescription self = liftIO (nullableToMaybe <$> (js_getCurrentLocalDescription self)) -- | getCurrentLocalDescriptionUnsafe :: (MonadIO m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getCurrentLocalDescriptionUnsafe self = liftIO ((nullableToMaybe <$> (js_getCurrentLocalDescription self)) >>= maybe (Prelude.error "Nothing to return") return) -- | getCurrentLocalDescriptionUnchecked :: (MonadIO m) => RTCPeerConnection -> m RTCSessionDescription getCurrentLocalDescriptionUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getCurrentLocalDescription self)) foreign import javascript unsafe "$1[\"pendingLocalDescription\"]" js_getPendingLocalDescription :: RTCPeerConnection -> IO (Nullable RTCSessionDescription) -- | getPendingLocalDescription :: (MonadIO m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getPendingLocalDescription self = liftIO (nullableToMaybe <$> (js_getPendingLocalDescription self)) -- | getPendingLocalDescriptionUnsafe :: (MonadIO m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getPendingLocalDescriptionUnsafe self = liftIO ((nullableToMaybe <$> (js_getPendingLocalDescription self)) >>= maybe (Prelude.error "Nothing to return") return) -- | getPendingLocalDescriptionUnchecked :: (MonadIO m) => RTCPeerConnection -> m RTCSessionDescription getPendingLocalDescriptionUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getPendingLocalDescription self)) foreign import javascript unsafe "$1[\"remoteDescription\"]" js_getRemoteDescription :: RTCPeerConnection -> IO (Nullable RTCSessionDescription) -- | getRemoteDescription :: (MonadIO m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getRemoteDescription self = liftIO (nullableToMaybe <$> (js_getRemoteDescription self)) -- | getRemoteDescriptionUnsafe :: (MonadIO m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getRemoteDescriptionUnsafe self = liftIO ((nullableToMaybe <$> (js_getRemoteDescription self)) >>= maybe (Prelude.error "Nothing to return") return) -- | getRemoteDescriptionUnchecked :: (MonadIO m) => RTCPeerConnection -> m RTCSessionDescription getRemoteDescriptionUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getRemoteDescription self)) foreign import javascript unsafe "$1[\"currentRemoteDescription\"]" js_getCurrentRemoteDescription :: RTCPeerConnection -> IO (Nullable RTCSessionDescription) -- | getCurrentRemoteDescription :: (MonadIO m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getCurrentRemoteDescription self = liftIO (nullableToMaybe <$> (js_getCurrentRemoteDescription self)) -- | getCurrentRemoteDescriptionUnsafe :: (MonadIO m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getCurrentRemoteDescriptionUnsafe self = liftIO ((nullableToMaybe <$> (js_getCurrentRemoteDescription self)) >>= maybe (Prelude.error "Nothing to return") return) -- | getCurrentRemoteDescriptionUnchecked :: (MonadIO m) => RTCPeerConnection -> m RTCSessionDescription getCurrentRemoteDescriptionUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getCurrentRemoteDescription self)) foreign import javascript unsafe "$1[\"pendingRemoteDescription\"]" js_getPendingRemoteDescription :: RTCPeerConnection -> IO (Nullable RTCSessionDescription) -- | getPendingRemoteDescription :: (MonadIO m) => RTCPeerConnection -> m (Maybe RTCSessionDescription) getPendingRemoteDescription self = liftIO (nullableToMaybe <$> (js_getPendingRemoteDescription self)) -- | getPendingRemoteDescriptionUnsafe :: (MonadIO m, HasCallStack) => RTCPeerConnection -> m RTCSessionDescription getPendingRemoteDescriptionUnsafe self = liftIO ((nullableToMaybe <$> (js_getPendingRemoteDescription self)) >>= maybe (Prelude.error "Nothing to return") return) -- | getPendingRemoteDescriptionUnchecked :: (MonadIO m) => RTCPeerConnection -> m RTCSessionDescription getPendingRemoteDescriptionUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getPendingRemoteDescription self)) foreign import javascript unsafe "$1[\"signalingState\"]" js_getSignalingState :: RTCPeerConnection -> IO JSVal -- | getSignalingState :: (MonadIO m) => RTCPeerConnection -> m RTCSignalingState getSignalingState self = liftIO ((js_getSignalingState self) >>= fromJSValUnchecked) foreign import javascript unsafe "$1[\"iceGatheringState\"]" js_getIceGatheringState :: RTCPeerConnection -> IO JSVal -- | getIceGatheringState :: (MonadIO m) => RTCPeerConnection -> m RTCIceGatheringState getIceGatheringState self = liftIO ((js_getIceGatheringState self) >>= fromJSValUnchecked) foreign import javascript unsafe "$1[\"iceConnectionState\"]" js_getIceConnectionState :: RTCPeerConnection -> IO JSVal -- | getIceConnectionState :: (MonadIO m) => RTCPeerConnection -> m RTCIceConnectionState getIceConnectionState self = liftIO ((js_getIceConnectionState self) >>= fromJSValUnchecked) foreign import javascript unsafe "$1[\"connectionState\"]" js_getConnectionState :: RTCPeerConnection -> IO JSVal -- | getConnectionState :: (MonadIO m) => RTCPeerConnection -> m RTCPeerConnectionState getConnectionState self = liftIO ((js_getConnectionState self) >>= 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")