{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Subscriptions.WebSockets
  ( webSocketsWrapper,
  )
where

import Control.Monad.IO.Unlift
  ( MonadUnliftIO,
    withRunInIO,
  )
import Data.Morpheus.Subscriptions.Internal
  ( ApiContext (..),
    SUB,
    Store (..),
    acceptApolloRequest,
  )
import Network.WebSockets
  ( Connection,
    ServerApp,
    receiveData,
    sendTextData,
  )
import qualified Network.WebSockets as WS
import Relude

-- support old version of WebSockets
pingThread :: Connection -> IO () -> IO ()

#if MIN_VERSION_websockets(0,12,6)
pingThread :: Connection -> IO () -> IO ()
pingThread Connection
connection = Connection -> Int -> IO () -> IO () -> IO ()
forall a. Connection -> Int -> IO () -> IO a -> IO a
WS.withPingThread Connection
connection Int
30 (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
#else
pingThread connection = (WS.forkPingThread connection 30 >>)
#endif

defaultWSScope :: MonadIO m => Store e m -> Connection -> ApiContext SUB e m
defaultWSScope :: Store e m -> Connection -> ApiContext SUB e m
defaultWSScope Store {(ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
writeStore :: forall e (m :: * -> *).
Store e m
-> (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
writeStore :: (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
writeStore} Connection
connection =
  SubContext :: forall (m :: * -> *) event.
m ByteString
-> (ByteString -> m ())
-> ((ClientConnectionStore event m
     -> ClientConnectionStore event m)
    -> m ())
-> ApiContext SUB event m
SubContext
    { listener :: m ByteString
listener = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
receiveData Connection
connection),
      callback :: ByteString -> m ()
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
connection,
      updateStore :: (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore = (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
writeStore
    }

webSocketsWrapper ::
  (MonadUnliftIO m, MonadIO m) =>
  Store e m ->
  (ApiContext SUB e m -> m ()) ->
  m ServerApp
webSocketsWrapper :: Store e m -> (ApiContext SUB e m -> m ()) -> m ServerApp
webSocketsWrapper Store e m
store ApiContext SUB e m -> m ()
handler =
  ((forall a. m a -> IO a) -> IO ServerApp) -> m ServerApp
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ServerApp) -> m ServerApp)
-> ((forall a. m a -> IO a) -> IO ServerApp) -> m ServerApp
forall a b. (a -> b) -> a -> b
$
    \forall a. m a -> IO a
runIO ->
      ServerApp -> IO ServerApp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerApp -> IO ServerApp) -> ServerApp -> IO ServerApp
forall a b. (a -> b) -> a -> b
$
        \PendingConnection
pending -> do
          Connection
conn <- PendingConnection -> IO Connection
forall (m :: * -> *).
MonadIO m =>
PendingConnection -> m Connection
acceptApolloRequest PendingConnection
pending
          Connection -> IO () -> IO ()
pingThread
            Connection
conn
            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ m () -> IO ()
forall a. m a -> IO a
runIO (ApiContext SUB e m -> m ()
handler (Store e m -> Connection -> ApiContext SUB e m
forall (m :: * -> *) e.
MonadIO m =>
Store e m -> Connection -> ApiContext SUB e m
defaultWSScope Store e m
store Connection
conn))