{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Subscriptions.Stream
  ( toOutStream,
    runStreamWS,
    runStreamHTTP,
    ApiContext (..),
    Input (..),
    Output,
    API (..),
    PUB,
    SUB,
  )
where

import Control.Monad.Except (throwError)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Morpheus.App.Internal.Resolving
  ( Channel,
    ResponseEvent (..),
    ResponseStream,
    Result (..),
    ResultT (..),
    runResultT,
  )
import Data.Morpheus.Subscriptions.Apollo
  ( ApolloAction (..),
    ApolloMessageType (..),
    apolloFormat,
    toApolloResponse,
  )
import Data.Morpheus.Subscriptions.ClientConnectionStore
  ( ClientConnectionStore,
    SessionID (..),
    Updates (..),
    endSession,
    insertConnection,
    startSession,
  )
import Data.Morpheus.Subscriptions.Event (Event (..))
import Data.Morpheus.Types.IO
  ( GQLRequest (..),
    GQLResponse (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    VALID,
    Value (..),
  )
import Data.UUID (UUID)
import Relude hiding (ByteString)

data API = PUB | SUB

type SUB = 'SUB

type PUB = 'PUB

data
  Input
    (api :: API)
  where
  InitConnection :: UUID -> Input SUB
  Request :: GQLRequest -> Input PUB

run :: ApiContext SUB e m -> Updates e m -> m ()
run :: forall e (m :: * -> *). ApiContext SUB e m -> Updates e m -> m ()
run SubContext {(ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore :: (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore :: forall (m :: * -> *) event.
ApiContext SUB event m
-> (ClientConnectionStore event m -> ClientConnectionStore event m)
-> m ()
updateStore} (Updates ClientConnectionStore e m -> ClientConnectionStore e m
changes) = (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore ClientConnectionStore e m -> ClientConnectionStore e m
changes

data ApiContext (api :: API) event (m :: Type -> Type) where
  PubContext ::
    { forall event (m :: * -> *). ApiContext PUB event m -> event -> m ()
eventPublisher :: event -> m ()
    } ->
    ApiContext PUB event m
  SubContext ::
    { forall (m :: * -> *) event. ApiContext SUB event m -> m ByteString
listener :: m ByteString,
      forall (m :: * -> *) event.
ApiContext SUB event m -> ByteString -> m ()
callback :: ByteString -> m (),
      forall (m :: * -> *) event.
ApiContext SUB event m
-> (ClientConnectionStore event m -> ClientConnectionStore event m)
-> m ()
updateStore :: (ClientConnectionStore event m -> ClientConnectionStore event m) -> m ()
    } ->
    ApiContext SUB event m

data WSOutputEvent e m
  = WSUpdate (Updates e m)
  | WSMessage ByteString

data
  Output
    (api :: API)
    (e :: Type)
    (m :: Type -> Type)
  where
  SubOutput ::
    { forall e (m :: * -> *).
Output SUB e m
-> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
streamWS :: ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
    } ->
    Output SUB e m
  PubOutput ::
    { forall e (m :: * -> *).
Output PUB e m -> ApiContext PUB e m -> m GQLResponse
streamHTTP :: ApiContext PUB e m -> m GQLResponse
    } ->
    Output PUB e m

handleResponseStream ::
  ( Monad m,
    Eq (Channel e),
    Hashable (Channel e)
  ) =>
  SessionID ->
  ResponseStream e m (Value VALID) ->
  Output SUB e m
handleResponseStream :: forall (m :: * -> *) e.
(Monad m, Eq (Channel e), Hashable (Channel e)) =>
SessionID -> ResponseStream e m (Value VALID) -> Output SUB e m
handleResponseStream SessionID
session (ResultT m (Result GQLError ([ResponseEvent e m], Value VALID))
res) =
  (ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> Output SUB e m
forall e (m :: * -> *).
(ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> Output SUB e m
SubOutput ((ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
 -> Output SUB e m)
-> (ApiContext SUB e m
    -> m (Either ByteString [WSOutputEvent e m]))
-> Output SUB e m
forall a b. (a -> b) -> a -> b
$ m (Either ByteString [WSOutputEvent e m])
-> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
forall a b. a -> b -> a
const (m (Either ByteString [WSOutputEvent e m])
 -> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> m (Either ByteString [WSOutputEvent e m])
-> ApiContext SUB e m
-> m (Either ByteString [WSOutputEvent e m])
forall a b. (a -> b) -> a -> b
$ Result GQLError ([ResponseEvent e m], Value VALID)
-> Either ByteString [WSOutputEvent e m]
unfoldR (Result GQLError ([ResponseEvent e m], Value VALID)
 -> Either ByteString [WSOutputEvent e m])
-> m (Result GQLError ([ResponseEvent e m], Value VALID))
-> m (Either ByteString [WSOutputEvent e m])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result GQLError ([ResponseEvent e m], Value VALID))
res
  where
    execute :: ResponseEvent e m -> Either ByteString (WSOutputEvent e m)
execute Publish {} =
      [GQLError] -> Either ByteString (WSOutputEvent e m)
forall a. [GQLError] -> Either ByteString a
apolloError
        [GQLError
"websocket can only handle subscriptions, not mutations"]
    execute (Subscribe Channel e
ch e -> m GQLResponse
subRes) =
      WSOutputEvent e m -> Either ByteString (WSOutputEvent e m)
forall a b. b -> Either a b
Right (WSOutputEvent e m -> Either ByteString (WSOutputEvent e m))
-> (Updates e m -> WSOutputEvent e m)
-> Updates e m
-> Either ByteString (WSOutputEvent e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Updates e m -> WSOutputEvent e m
forall e (m :: * -> *). Updates e m -> WSOutputEvent e m
WSUpdate (Updates e m -> Either ByteString (WSOutputEvent e m))
-> Updates e m -> Either ByteString (WSOutputEvent e m)
forall a b. (a -> b) -> a -> b
$ Channel e -> (e -> m GQLResponse) -> SessionID -> Updates e m
forall (m :: * -> *) e.
(Monad m, Eq (Channel e), Hashable (Channel e)) =>
Channel e -> (e -> m GQLResponse) -> SessionID -> Updates e m
startSession Channel e
ch e -> m GQLResponse
subRes SessionID
session
    --------------------------
    unfoldR :: Result GQLError ([ResponseEvent e m], Value VALID)
-> Either ByteString [WSOutputEvent e m]
unfoldR Success {result :: forall err a. Result err a -> a
result = ([ResponseEvent e m]
events, Value VALID
_)} =
      (ResponseEvent e m -> Either ByteString (WSOutputEvent e m))
-> [ResponseEvent e m] -> Either ByteString [WSOutputEvent e m]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ResponseEvent e m -> Either ByteString (WSOutputEvent e m)
execute [ResponseEvent e m]
events
    unfoldR Failure {NonEmpty GQLError
errors :: NonEmpty GQLError
errors :: forall err a. Result err a -> NonEmpty err
errors} =
      [GQLError] -> Either ByteString [WSOutputEvent e m]
forall a. [GQLError] -> Either ByteString a
apolloError (NonEmpty GQLError -> [GQLError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GQLError
errors)
    --------------------------
    apolloError :: [GQLError] -> Either ByteString a
    apolloError :: forall a. [GQLError] -> Either ByteString a
apolloError = ByteString -> Either ByteString a
forall a b. a -> Either a b
Left (ByteString -> Either ByteString a)
-> ([GQLError] -> ByteString) -> [GQLError] -> Either ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApolloMessageType -> Maybe ID -> Maybe GQLResponse -> ByteString
toApolloResponse ApolloMessageType
GqlError (ID -> Maybe ID
forall a. a -> Maybe a
Just (ID -> Maybe ID) -> ID -> Maybe ID
forall a b. (a -> b) -> a -> b
$ SessionID -> ID
sid SessionID
session) (Maybe GQLResponse -> ByteString)
-> ([GQLError] -> Maybe GQLResponse) -> [GQLError] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLResponse -> Maybe GQLResponse
forall a. a -> Maybe a
Just (GQLResponse -> Maybe GQLResponse)
-> ([GQLError] -> GQLResponse) -> [GQLError] -> Maybe GQLResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GQLError] -> GQLResponse
Errors

handleWSRequest ::
  ( Monad m,
    Functor m,
    Eq ch,
    Hashable ch
  ) =>
  ( GQLRequest ->
    ResponseStream (Event ch con) m (Value VALID)
  ) ->
  UUID ->
  ByteString ->
  Output SUB (Event ch con) m
handleWSRequest :: forall (m :: * -> *) ch con.
(Monad m, Functor m, Eq ch, Hashable ch) =>
(GQLRequest -> ResponseStream (Event ch con) m (Value VALID))
-> UUID -> ByteString -> Output SUB (Event ch con) m
handleWSRequest GQLRequest -> ResponseStream (Event ch con) m (Value VALID)
gqlApp UUID
clientId = Either ByteString ApolloAction -> Output SUB (Event ch con) m
handle (Either ByteString ApolloAction -> Output SUB (Event ch con) m)
-> (ByteString -> Either ByteString ApolloAction)
-> ByteString
-> Output SUB (Event ch con) m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString ApolloAction
apolloFormat
  where
    -- handle :: Applicative m => Validation ApolloAction -> Stream SUB e m
    handle :: Either ByteString ApolloAction -> Output SUB (Event ch con) m
handle = (ByteString -> Output SUB (Event ch con) m)
-> (ApolloAction -> Output SUB (Event ch con) m)
-> Either ByteString ApolloAction
-> Output SUB (Event ch con) m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall (m :: * -> *) e.
Applicative m =>
Either ByteString [WSOutputEvent e m] -> Output SUB e m
liftWS (Either ByteString [WSOutputEvent (Event ch con) m]
 -> Output SUB (Event ch con) m)
-> (ByteString
    -> Either ByteString [WSOutputEvent (Event ch con) m])
-> ByteString
-> Output SUB (Event ch con) m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString [WSOutputEvent (Event ch con) m]
forall a b. a -> Either a b
Left) ApolloAction -> Output SUB (Event ch con) m
handleAction
    --------------------------------------------------
    -- handleAction :: ApolloAction -> Stream SUB e m
    handleAction :: ApolloAction -> Output SUB (Event ch con) m
handleAction ApolloAction
ConnectionInit = do
      Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall (m :: * -> *) e.
Applicative m =>
Either ByteString [WSOutputEvent e m] -> Output SUB e m
liftWS (Either ByteString [WSOutputEvent (Event ch con) m]
 -> Output SUB (Event ch con) m)
-> Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall a b. (a -> b) -> a -> b
$ [WSOutputEvent (Event ch con) m]
-> Either ByteString [WSOutputEvent (Event ch con) m]
forall a b. b -> Either a b
Right [ByteString -> WSOutputEvent (Event ch con) m
forall e (m :: * -> *). ByteString -> WSOutputEvent e m
WSMessage (ByteString -> WSOutputEvent (Event ch con) m)
-> ByteString -> WSOutputEvent (Event ch con) m
forall a b. (a -> b) -> a -> b
$ ApolloMessageType -> Maybe ID -> Maybe GQLResponse -> ByteString
toApolloResponse ApolloMessageType
GqlConnectionAck Maybe ID
forall a. Maybe a
Nothing Maybe GQLResponse
forall a. Maybe a
Nothing]
    handleAction ApolloAction
Ping = do
      Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall (m :: * -> *) e.
Applicative m =>
Either ByteString [WSOutputEvent e m] -> Output SUB e m
liftWS (Either ByteString [WSOutputEvent (Event ch con) m]
 -> Output SUB (Event ch con) m)
-> Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall a b. (a -> b) -> a -> b
$ [WSOutputEvent (Event ch con) m]
-> Either ByteString [WSOutputEvent (Event ch con) m]
forall a b. b -> Either a b
Right [ByteString -> WSOutputEvent (Event ch con) m
forall e (m :: * -> *). ByteString -> WSOutputEvent e m
WSMessage (ByteString -> WSOutputEvent (Event ch con) m)
-> ByteString -> WSOutputEvent (Event ch con) m
forall a b. (a -> b) -> a -> b
$ ApolloMessageType -> Maybe ID -> Maybe GQLResponse -> ByteString
toApolloResponse ApolloMessageType
GqlPong Maybe ID
forall a. Maybe a
Nothing Maybe GQLResponse
forall a. Maybe a
Nothing]
    handleAction (SessionStart ID
sessionId GQLRequest
request) =
      SessionID
-> ResponseStream (Event ch con) m (Value VALID)
-> Output SUB (Event ch con) m
forall (m :: * -> *) e.
(Monad m, Eq (Channel e), Hashable (Channel e)) =>
SessionID -> ResponseStream e m (Value VALID) -> Output SUB e m
handleResponseStream (UUID -> ID -> SessionID
SessionID UUID
clientId ID
sessionId) (GQLRequest -> ResponseStream (Event ch con) m (Value VALID)
gqlApp GQLRequest
request)
    handleAction (SessionStop ID
sessionId) =
      Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall (m :: * -> *) e.
Applicative m =>
Either ByteString [WSOutputEvent e m] -> Output SUB e m
liftWS (Either ByteString [WSOutputEvent (Event ch con) m]
 -> Output SUB (Event ch con) m)
-> Either ByteString [WSOutputEvent (Event ch con) m]
-> Output SUB (Event ch con) m
forall a b. (a -> b) -> a -> b
$
        [WSOutputEvent (Event ch con) m]
-> Either ByteString [WSOutputEvent (Event ch con) m]
forall a b. b -> Either a b
Right [Updates (Event ch con) m -> WSOutputEvent (Event ch con) m
forall e (m :: * -> *). Updates e m -> WSOutputEvent e m
WSUpdate (Updates (Event ch con) m -> WSOutputEvent (Event ch con) m)
-> Updates (Event ch con) m -> WSOutputEvent (Event ch con) m
forall a b. (a -> b) -> a -> b
$ SessionID -> Updates (Event ch con) m
forall ch con (m :: * -> *).
(Eq ch, Hashable ch) =>
SessionID -> Updates (Event ch con) m
endSession (UUID -> ID -> SessionID
SessionID UUID
clientId ID
sessionId)]

liftWS ::
  Applicative m =>
  Either ByteString [WSOutputEvent e m] ->
  Output SUB e m
liftWS :: forall (m :: * -> *) e.
Applicative m =>
Either ByteString [WSOutputEvent e m] -> Output SUB e m
liftWS = (ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> Output SUB e m
forall e (m :: * -> *).
(ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> Output SUB e m
SubOutput ((ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
 -> Output SUB e m)
-> (Either ByteString [WSOutputEvent e m]
    -> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> Either ByteString [WSOutputEvent e m]
-> Output SUB e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either ByteString [WSOutputEvent e m])
-> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
forall a b. a -> b -> a
const (m (Either ByteString [WSOutputEvent e m])
 -> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> (Either ByteString [WSOutputEvent e m]
    -> m (Either ByteString [WSOutputEvent e m]))
-> Either ByteString [WSOutputEvent e m]
-> ApiContext SUB e m
-> m (Either ByteString [WSOutputEvent e m])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ByteString [WSOutputEvent e m]
-> m (Either ByteString [WSOutputEvent e m])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

runStreamWS ::
  (Monad m) =>
  ApiContext SUB e m ->
  Output SUB e m ->
  m ()
runStreamWS :: forall (m :: * -> *) e.
Monad m =>
ApiContext SUB e m -> Output SUB e m -> m ()
runStreamWS scope :: ApiContext SUB e m
scope@SubContext {ByteString -> m ()
callback :: forall (m :: * -> *) event.
ApiContext SUB event m -> ByteString -> m ()
callback :: ByteString -> m ()
callback} SubOutput {ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
streamWS :: forall e (m :: * -> *).
Output SUB e m
-> ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
streamWS :: ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
streamWS} =
  ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m])
streamWS ApiContext SUB e m
scope
    m (Either ByteString [WSOutputEvent e m])
-> (Either ByteString [WSOutputEvent e m] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> m ())
-> ([WSOutputEvent e m] -> m ())
-> Either ByteString [WSOutputEvent e m]
-> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ByteString -> m ()
callback ((WSOutputEvent e m -> m ()) -> [WSOutputEvent e m] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ WSOutputEvent e m -> m ()
eventRunner)
  where
    -- eventRunner :: Monad m => WSOutputEvent e m -> m ()
    eventRunner :: WSOutputEvent e m -> m ()
eventRunner (WSUpdate Updates e m
updates) = ApiContext SUB e m -> Updates e m -> m ()
forall e (m :: * -> *). ApiContext SUB e m -> Updates e m -> m ()
run ApiContext SUB e m
scope Updates e m
updates
    eventRunner (WSMessage ByteString
msg) = ByteString -> m ()
callback ByteString
msg

runStreamHTTP ::
  (Monad m) =>
  ApiContext PUB e m ->
  Output PUB e m ->
  m GQLResponse
runStreamHTTP :: forall (m :: * -> *) e.
Monad m =>
ApiContext PUB e m -> Output PUB e m -> m GQLResponse
runStreamHTTP ApiContext PUB e m
scope PubOutput {ApiContext PUB e m -> m GQLResponse
streamHTTP :: forall e (m :: * -> *).
Output PUB e m -> ApiContext PUB e m -> m GQLResponse
streamHTTP :: ApiContext PUB e m -> m GQLResponse
streamHTTP} =
  ApiContext PUB e m -> m GQLResponse
streamHTTP ApiContext PUB e m
scope

toOutStream ::
  ( Monad m,
    Eq ch,
    Hashable ch
  ) =>
  ( GQLRequest ->
    ResponseStream (Event ch con) m (Value VALID)
  ) ->
  Input api ->
  Output api (Event ch con) m
toOutStream :: forall (m :: * -> *) ch con (api :: API).
(Monad m, Eq ch, Hashable ch) =>
(GQLRequest -> ResponseStream (Event ch con) m (Value VALID))
-> Input api -> Output api (Event ch con) m
toOutStream GQLRequest -> ResponseStream (Event ch con) m (Value VALID)
app (InitConnection UUID
clientId) =
  (ApiContext SUB (Event ch con) m
 -> m (Either ByteString [WSOutputEvent (Event ch con) m]))
-> Output SUB (Event ch con) m
forall e (m :: * -> *).
(ApiContext SUB e m -> m (Either ByteString [WSOutputEvent e m]))
-> Output SUB e m
SubOutput ApiContext SUB (Event ch con) m
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
handle
  where
    handle :: ApiContext SUB (Event ch con) m
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
handle ws :: ApiContext SUB (Event ch con) m
ws@SubContext {m ByteString
listener :: forall (m :: * -> *) event. ApiContext SUB event m -> m ByteString
listener :: m ByteString
listener, ByteString -> m ()
callback :: forall (m :: * -> *) event.
ApiContext SUB event m -> ByteString -> m ()
callback :: ByteString -> m ()
callback} = do
      let runS :: Output SUB (Event ch con) m
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
runS (SubOutput ApiContext SUB (Event ch con) m
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
x) = ApiContext SUB (Event ch con) m
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
x ApiContext SUB (Event ch con) m
ws
      Either ByteString [WSOutputEvent (Event ch con) m]
bla <- m ByteString
listener m ByteString
-> (ByteString
    -> m (Either ByteString [WSOutputEvent (Event ch con) m]))
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Output SUB (Event ch con) m
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
runS (Output SUB (Event ch con) m
 -> m (Either ByteString [WSOutputEvent (Event ch con) m]))
-> (ByteString -> Output SUB (Event ch con) m)
-> ByteString
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GQLRequest -> ResponseStream (Event ch con) m (Value VALID))
-> UUID -> ByteString -> Output SUB (Event ch con) m
forall (m :: * -> *) ch con.
(Monad m, Functor m, Eq ch, Hashable ch) =>
(GQLRequest -> ResponseStream (Event ch con) m (Value VALID))
-> UUID -> ByteString -> Output SUB (Event ch con) m
handleWSRequest GQLRequest -> ResponseStream (Event ch con) m (Value VALID)
app UUID
clientId
      Either ByteString [WSOutputEvent (Event ch con) m]
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString [WSOutputEvent (Event ch con) m]
 -> m (Either ByteString [WSOutputEvent (Event ch con) m]))
-> Either ByteString [WSOutputEvent (Event ch con) m]
-> m (Either ByteString [WSOutputEvent (Event ch con) m])
forall a b. (a -> b) -> a -> b
$ ((Updates (Event ch con) m -> WSOutputEvent (Event ch con) m
forall e (m :: * -> *). Updates e m -> WSOutputEvent e m
WSUpdate (Updates (Event ch con) m -> WSOutputEvent (Event ch con) m)
-> Updates (Event ch con) m -> WSOutputEvent (Event ch con) m
forall a b. (a -> b) -> a -> b
$ (ClientConnectionStore (Event ch con) m
 -> ClientConnectionStore (Event ch con) m)
-> Updates (Event ch con) m
forall e (m :: * -> *).
(ClientConnectionStore e m -> ClientConnectionStore e m)
-> Updates e m
Updates (UUID
-> (ByteString -> m ())
-> ClientConnectionStore (Event ch con) m
-> ClientConnectionStore (Event ch con) m
forall (m :: * -> *) e.
UUID -> (ByteString -> m ()) -> StoreMap e m
insertConnection UUID
clientId ByteString -> m ()
callback)) WSOutputEvent (Event ch con) m
-> [WSOutputEvent (Event ch con) m]
-> [WSOutputEvent (Event ch con) m]
forall a. a -> [a] -> [a]
:) ([WSOutputEvent (Event ch con) m]
 -> [WSOutputEvent (Event ch con) m])
-> Either ByteString [WSOutputEvent (Event ch con) m]
-> Either ByteString [WSOutputEvent (Event ch con) m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ByteString [WSOutputEvent (Event ch con) m]
bla
toOutStream GQLRequest -> ResponseStream (Event ch con) m (Value VALID)
app (Request GQLRequest
req) =
  (ApiContext PUB (Event ch con) m -> m GQLResponse)
-> Output PUB (Event ch con) m
forall e (m :: * -> *).
(ApiContext PUB e m -> m GQLResponse) -> Output PUB e m
PubOutput ((ApiContext PUB (Event ch con) m -> m GQLResponse)
 -> Output PUB (Event ch con) m)
-> (ApiContext PUB (Event ch con) m -> m GQLResponse)
-> Output PUB (Event ch con) m
forall a b. (a -> b) -> a -> b
$ ResponseStream (Event ch con) m (Value VALID)
-> ApiContext PUB (Event ch con) m -> m GQLResponse
forall (m :: * -> *) e.
Monad m =>
ResponseStream e m (Value VALID)
-> ApiContext PUB e m -> m GQLResponse
handleResponseHTTP (GQLRequest -> ResponseStream (Event ch con) m (Value VALID)
app GQLRequest
req)

handleResponseHTTP ::
  ( Monad m
  ) =>
  ResponseStream e m (Value VALID) ->
  ApiContext PUB e m ->
  m GQLResponse
handleResponseHTTP :: forall (m :: * -> *) e.
Monad m =>
ResponseStream e m (Value VALID)
-> ApiContext PUB e m -> m GQLResponse
handleResponseHTTP
  ResponseStream e m (Value VALID)
res
  PubContext {e -> m ()
eventPublisher :: forall event (m :: * -> *). ApiContext PUB event m -> event -> m ()
eventPublisher :: e -> m ()
eventPublisher} = ResultT e m (Value VALID) -> m (Result GQLError ([e], Value VALID))
forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT (ResponseStream e m (Value VALID)
-> (ResponseEvent e m -> ResultT e m e)
-> ResultT e m (Value VALID)
forall (m :: * -> *) e a e'.
Monad m =>
ResponseStream e m a
-> (ResponseEvent e m -> ResultT e' m e') -> ResultT e' m a
handleRes ResponseStream e m (Value VALID)
res ResponseEvent e m -> ResultT e m e
forall {f :: * -> *} {e} {a} {m :: * -> *}.
(MonadError e f, IsString e) =>
ResponseEvent a m -> f a
execute) m (Result GQLError ([e], Value VALID))
-> (Result GQLError ([e], Value VALID) -> m GQLResponse)
-> m GQLResponse
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result GQLError ([e], Value VALID) -> m GQLResponse
runResult
    where
      runResult :: Result GQLError ([e], Value VALID) -> m GQLResponse
runResult Success {result :: forall err a. Result err a -> a
result = ([e]
events, Value VALID
result)} = (e -> m ()) -> [e] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ e -> m ()
eventPublisher [e]
events m () -> GQLResponse -> m GQLResponse
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value VALID -> GQLResponse
Data Value VALID
result
      runResult Failure {NonEmpty GQLError
errors :: forall err a. Result err a -> NonEmpty err
errors :: NonEmpty GQLError
errors} = GQLResponse -> m GQLResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLResponse -> m GQLResponse) -> GQLResponse -> m GQLResponse
forall a b. (a -> b) -> a -> b
$ [GQLError] -> GQLResponse
Errors ([GQLError] -> GQLResponse) -> [GQLError] -> GQLResponse
forall a b. (a -> b) -> a -> b
$ NonEmpty GQLError -> [GQLError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GQLError
errors
      execute :: ResponseEvent a m -> f a
execute (Publish a
event) = a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
event
      execute Subscribe {} = e -> f a
forall a. e -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
"http server can't handle subscription"

handleRes ::
  (Monad m) =>
  ResponseStream e m a ->
  (ResponseEvent e m -> ResultT e' m e') ->
  ResultT e' m a
handleRes :: forall (m :: * -> *) e a e'.
Monad m =>
ResponseStream e m a
-> (ResponseEvent e m -> ResultT e' m e') -> ResultT e' m a
handleRes ResponseStream e m a
res ResponseEvent e m -> ResultT e' m e'
execute = m (Result GQLError ([e'], a)) -> ResultT e' m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([e'], a)) -> ResultT e' m a)
-> m (Result GQLError ([e'], a)) -> ResultT e' m a
forall a b. (a -> b) -> a -> b
$ ResponseStream e m a
-> m (Result GQLError ([ResponseEvent e m], a))
forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT ResponseStream e m a
res m (Result GQLError ([ResponseEvent e m], a))
-> (Result GQLError ([ResponseEvent e m], a)
    -> m (Result GQLError ([e'], a)))
-> m (Result GQLError ([e'], a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResultT e' m a -> m (Result GQLError ([e'], a))
forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT (ResultT e' m a -> m (Result GQLError ([e'], a)))
-> (Result GQLError ([ResponseEvent e m], a) -> ResultT e' m a)
-> Result GQLError ([ResponseEvent e m], a)
-> m (Result GQLError ([e'], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResponseEvent e m -> ResultT e' m e')
-> Result GQLError ([ResponseEvent e m], a) -> ResultT e' m a
forall (m :: * -> *) e e' a.
Monad m =>
(e -> ResultT e' m e')
-> Result GQLError ([e], a) -> ResultT e' m a
unfoldRes ResponseEvent e m -> ResultT e' m e'
execute

unfoldRes ::
  (Monad m) =>
  (e -> ResultT e' m e') ->
  Result GQLError ([e], a) ->
  ResultT e' m a
unfoldRes :: forall (m :: * -> *) e e' a.
Monad m =>
(e -> ResultT e' m e')
-> Result GQLError ([e], a) -> ResultT e' m a
unfoldRes e -> ResultT e' m e'
execute Success {result :: forall err a. Result err a -> a
result = ([e]
events, a
result), [GQLError]
warnings :: [GQLError]
warnings :: forall err a. Result err a -> [err]
..} = (e -> ResultT e' m e') -> [e] -> ResultT e' m [e']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse e -> ResultT e' m e'
execute [e]
events ResultT e' m [e'] -> ([e'] -> ResultT e' m a) -> ResultT e' m a
forall a b.
ResultT e' m a -> (a -> ResultT e' m b) -> ResultT e' m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [e'] -> ResultT e' m a
packResultT
  where
    packResultT :: [e'] -> ResultT e' m a
packResultT [e']
events' = m (Result GQLError ([e'], a)) -> ResultT e' m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([e'], a)) -> ResultT e' m a)
-> m (Result GQLError ([e'], a)) -> ResultT e' m a
forall a b. (a -> b) -> a -> b
$ Result GQLError ([e'], a) -> m (Result GQLError ([e'], a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([e'], a) -> m (Result GQLError ([e'], a)))
-> Result GQLError ([e'], a) -> m (Result GQLError ([e'], a))
forall a b. (a -> b) -> a -> b
$ Success {result :: ([e'], a)
result = ([e']
events', a
result), [GQLError]
warnings :: [GQLError]
warnings :: [GQLError]
..}
unfoldRes e -> ResultT e' m e'
_ Failure {NonEmpty GQLError
errors :: forall err a. Result err a -> NonEmpty err
errors :: NonEmpty GQLError
errors} = m (Result GQLError ([e'], a)) -> ResultT e' m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([e'], a)) -> ResultT e' m a)
-> m (Result GQLError ([e'], a)) -> ResultT e' m a
forall a b. (a -> b) -> a -> b
$ Result GQLError ([e'], a) -> m (Result GQLError ([e'], a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([e'], a) -> m (Result GQLError ([e'], a)))
-> Result GQLError ([e'], a) -> m (Result GQLError ([e'], a))
forall a b. (a -> b) -> a -> b
$ Failure {NonEmpty GQLError
errors :: NonEmpty GQLError
errors :: NonEmpty GQLError
errors}