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