module JSDOM.Custom.RTCPeerConnection (
module Generated
, createOffer'
, createOffer
, createAnswer'
, createAnswer
, setLocalDescription'
, setLocalDescription
, setRemoteDescription'
, setRemoteDescription
) where
import Data.Maybe (fromJust)
import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar)
import Control.Monad.IO.Class (MonadIO(..))
import JSDOM.Types
(RTCStatsResponse(..), IsMediaStreamTrack, RTCIceCandidate(..),
withCallback, Callback(..), RTCSessionDescription(..), DOMError(..),
Dictionary(..), RTCPeerConnection(..), MonadDOM,
RTCSessionDescriptionCallback(..),
RTCPeerConnectionErrorCallback(..),
RTCStatsCallback(..), VoidCallback(..))
import JSDOM.Custom.DOMError (throwDOMErrorException)
import JSDOM.Generated.RTCSessionDescriptionCallback
(newRTCSessionDescriptionCallback)
import JSDOM.Generated.RTCPeerConnectionErrorCallback
(newRTCPeerConnectionErrorCallback)
import JSDOM.Generated.VoidCallback
(newVoidCallback)
import JSDOM.Generated.RTCStatsCallback
(newRTCStatsCallback)
import JSDOM.Generated.Geolocation as Generated hiding (getCurrentPosition)
import qualified
JSDOM.Generated.RTCPeerConnection
as Generated
(getStats, addIceCandidate, setRemoteDescription,
setLocalDescription, createAnswer, createOffer)
createOffer' :: MonadDOM m => RTCPeerConnection -> Maybe Dictionary -> m (Either DOMError RTCSessionDescription)
createOffer' self offerOptions = do
result <- liftIO newEmptyMVar
withCallback (newRTCSessionDescriptionCallback (liftIO . putMVar result . Right . fromJust)) $ \success ->
withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result . Left . fromJust)) $ \error -> do
Generated.createOffer self (Just success) (Just error) offerOptions
liftIO $ takeMVar result
createOffer :: MonadDOM m => RTCPeerConnection -> Maybe Dictionary -> m RTCSessionDescription
createOffer self offerOptions = createOffer' self offerOptions >>= either throwDOMErrorException return
createAnswer' :: MonadDOM m => RTCPeerConnection -> Maybe Dictionary -> m (Either DOMError RTCSessionDescription)
createAnswer' self answerOptions = do
result <- liftIO newEmptyMVar
withCallback (newRTCSessionDescriptionCallback (liftIO . putMVar result . Right . fromJust)) $ \success ->
withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result . Left . fromJust)) $ \error -> do
Generated.createAnswer self (Just success) (Just error) answerOptions
liftIO $ takeMVar result
createAnswer :: MonadDOM m => RTCPeerConnection -> Maybe Dictionary -> m RTCSessionDescription
createAnswer self answerOptions = createAnswer' self answerOptions >>= either throwDOMErrorException return
setLocalDescription' :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m (Maybe DOMError)
setLocalDescription' self description = do
result <- liftIO newEmptyMVar
withCallback (newVoidCallback (liftIO $ putMVar result Nothing)) $ \success ->
withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result)) $ \error -> do
Generated.setLocalDescription self (Just description) (Just success) (Just error)
liftIO $ takeMVar result
setLocalDescription :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m ()
setLocalDescription self description = setLocalDescription' self description >>= maybe (return ()) throwDOMErrorException
setRemoteDescription' :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m (Maybe DOMError)
setRemoteDescription' self description = do
result <- liftIO newEmptyMVar
withCallback (newVoidCallback (liftIO $ putMVar result Nothing)) $ \success ->
withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result)) $ \error -> do
Generated.setRemoteDescription self (Just description) (Just success) (Just error)
liftIO $ takeMVar result
setRemoteDescription :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m ()
setRemoteDescription self description = setRemoteDescription' self description >>= maybe (return ()) throwDOMErrorException
addIceCandidate' :: MonadDOM m => RTCPeerConnection -> RTCIceCandidate -> m (Maybe DOMError)
addIceCandidate' self candidate = do
result <- liftIO newEmptyMVar
withCallback (newVoidCallback (liftIO $ putMVar result Nothing)) $ \success ->
withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result)) $ \error -> do
Generated.addIceCandidate self (Just candidate) (Just success) (Just error)
liftIO $ takeMVar result
addIceCandidate :: MonadDOM m => RTCPeerConnection -> RTCIceCandidate -> m ()
addIceCandidate self candidate = addIceCandidate' self candidate >>= maybe (return ()) throwDOMErrorException
getStats' :: (MonadDOM m, IsMediaStreamTrack selector) => RTCPeerConnection -> Maybe selector -> m (Either DOMError RTCStatsResponse)
getStats' self selector = do
result <- liftIO newEmptyMVar
withCallback (newRTCStatsCallback (liftIO . putMVar result . Right . fromJust)) $ \success ->
withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result . Left . fromJust)) $ \error -> do
Generated.getStats self (Just success) (Just error) selector
liftIO $ takeMVar result
getStats :: (MonadDOM m, IsMediaStreamTrack selector) => RTCPeerConnection -> Maybe selector -> m RTCStatsResponse
getStats self selector = getStats' self selector >>= either throwDOMErrorException return