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

-- |  GraphQL Wai Server Applications
module Data.Morpheus.Subscriptions
  ( webSocketsApp,
    httpPubApp,
    PubApp (..),
    SubApp (..),
    Event (..),
    ServerApp,
    Hashable,
  )
where

import Control.Monad.IO.Unlift
  ( MonadUnliftIO,
  )
import Data.Morpheus.App
  ( App,
    MapAPI (..),
    runApp,
  )
import Data.Morpheus.Subscriptions.Event
  ( Event (..),
    runEvents,
  )
import Data.Morpheus.Subscriptions.Internal
  ( ApiContext (..),
    Input (..),
    connectionThread,
    initDefaultStore,
    publishEventWith,
    runStreamHTTP,
    streamApp,
  )
import Data.Morpheus.Subscriptions.WebSockets
  ( webSocketsWrapper,
  )
import Network.WebSockets
  ( ServerApp,
  )
import Relude

httpPubApp ::
  ( PubApp e,
    MapAPI a b,
    MonadIO m
  ) =>
  [e -> m ()] ->
  App e m ->
  a ->
  m b
httpPubApp :: [e -> m ()] -> App e m -> a -> m b
httpPubApp = [e -> m ()] -> App e m -> a -> m b
forall e (m :: * -> *) a b.
(PubApp e, MonadIO m, MapAPI a b) =>
[e -> m ()] -> App e m -> a -> m b
runPubApp

-- | Wai WebSocket Server App for GraphQL subscriptions
webSocketsApp ::
  ( MonadUnliftIO m,
    MonadIO m,
    SubApp ServerApp e
  ) =>
  App e m ->
  m (ServerApp, e -> m ())
webSocketsApp :: App e m -> m (ServerApp, e -> m ())
webSocketsApp = App e m -> m (ServerApp, e -> m ())
forall app e (m :: * -> *).
(SubApp app e, MonadIO m, MonadUnliftIO m) =>
App e m -> m (app, e -> m ())
runSubApp

class SubApp app e where
  runSubApp :: (MonadIO m, MonadUnliftIO m) => App e m -> m (app, e -> m ())

class PubApp e where
  runPubApp :: (MonadIO m, MapAPI a b) => [e -> m ()] -> App e m -> a -> m b

instance (Show ch, Eq ch, Hashable ch) => SubApp ServerApp (Event ch con) where
  runSubApp :: App (Event ch con) m -> m (ServerApp, Event ch con -> m ())
runSubApp App (Event ch con) m
app = do
    Store (Event ch con) m
store <- m (Store (Event ch con) m)
forall (m :: * -> *) (m2 :: * -> *) ch con.
(MonadIO m, MonadIO m2) =>
m2 (Store (Event ch con) m)
initDefaultStore
    ServerApp
wsApp <- Store (Event ch con) m
-> (ApiContext SUB (Event ch con) m -> m ()) -> m ServerApp
forall (m :: * -> *) e.
(MonadUnliftIO m, MonadIO m) =>
Store e m -> (ApiContext SUB e m -> m ()) -> m ServerApp
webSocketsWrapper Store (Event ch con) m
store (App (Event ch con) m -> ApiContext SUB (Event ch con) m -> m ()
forall (m :: * -> *) ch con.
(MonadUnliftIO m, Eq ch, Hashable ch) =>
App (Event ch con) m -> ApiContext SUB (Event ch con) m -> m ()
connectionThread App (Event ch con) m
app)
    (ServerApp, Event ch con -> m ())
-> m (ServerApp, Event ch con -> m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( ServerApp
wsApp,
        Store (Event ch con) m -> Event ch con -> m ()
forall (m :: * -> *) channel cont.
(MonadIO m, Eq channel, Hashable channel, Show channel) =>
Store (Event channel cont) m -> Event channel cont -> m ()
publishEventWith Store (Event ch con) m
store
      )

instance (Show ch, Eq ch, Hashable ch) => PubApp (Event ch con) where
  runPubApp :: [Event ch con -> m ()] -> App (Event ch con) m -> a -> m b
runPubApp [] App (Event ch con) m
app = App (Event ch con) m -> a -> m b
forall a b (m :: * -> *) e.
(MapAPI a b, Monad m) =>
App e m -> a -> m b
runApp App (Event ch con) m
app
  runPubApp [Event ch con -> m ()]
callbacks App (Event ch con) m
app =
    (GQLRequest -> m GQLResponse) -> a -> m b
forall a b (m :: * -> *).
(MapAPI a b, Applicative m) =>
(GQLRequest -> m GQLResponse) -> a -> m b
mapAPI ((GQLRequest -> m GQLResponse) -> a -> m b)
-> (GQLRequest -> m GQLResponse) -> a -> m b
forall a b. (a -> b) -> a -> b
$
      ApiContext PUB (Event ch con) m
-> Output PUB (Event ch con) m -> m GQLResponse
forall (m :: * -> *) e.
Monad m =>
ApiContext PUB e m -> Output PUB e m -> m GQLResponse
runStreamHTTP PubContext :: forall event (m :: * -> *).
(event -> m ()) -> ApiContext PUB event m
PubContext {eventPublisher :: Event ch con -> m ()
eventPublisher = [Event ch con -> m ()] -> Event ch con -> m ()
forall (t :: * -> *) (f :: * -> *) event b.
(Foldable t, Applicative f) =>
t (event -> f b) -> event -> f ()
runEvents [Event ch con -> m ()]
callbacks}
        (Output PUB (Event ch con) m -> m GQLResponse)
-> (GQLRequest -> Output PUB (Event ch con) m)
-> GQLRequest
-> m GQLResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App (Event ch con) m -> Input PUB -> Output PUB (Event ch con) m
forall ch (m :: * -> *) con (api :: API).
(Eq ch, Monad m, Hashable ch) =>
App (Event ch con) m -> Input api -> Output api (Event ch con) m
streamApp App (Event ch con) m
app
        (Input PUB -> Output PUB (Event ch con) m)
-> (GQLRequest -> Input PUB)
-> GQLRequest
-> Output PUB (Event ch con) m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLRequest -> Input PUB
Request

instance SubApp ServerApp () where
  runSubApp :: App () m -> m (ServerApp, () -> m ())
runSubApp App () m
_ =
    (ServerApp, () -> m ()) -> m (ServerApp, () -> m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( IO () -> ServerApp
forall a b. a -> b -> a
const (IO () -> ServerApp) -> IO () -> ServerApp
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
        m () -> () -> m ()
forall a b. a -> b -> a
const (m () -> () -> m ()) -> m () -> () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      )

instance PubApp () where
  runPubApp :: [() -> m ()] -> App () m -> a -> m b
runPubApp [() -> m ()]
_ = App () m -> a -> m b
forall a b (m :: * -> *) e.
(MapAPI a b, Monad m) =>
App e m -> a -> m b
runApp