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

module Data.Morpheus.Subscriptions.Internal
  ( connect,
    disconnect,
    connectionThread,
    runStreamWS,
    runStreamHTTP,
    ApiContext (..),
    Input (..),
    PUB,
    SUB,
    Store (..),
    ClientConnectionStore,
    acceptApolloRequest,
    SessionID,
    publish,
    initDefaultStore,
    publishEventWith,
    empty,
    toList,
    connectionSessionIds,
    storedSessions,
    storedChannels,
    streamApp,
    ApolloSubscription (..),
    ApolloAction (..),
  )
where

import Control.Concurrent
  ( modifyMVar_,
  )
import Control.Exception (finally)
import Control.Monad.IO.Unlift
  ( MonadUnliftIO,
    withRunInIO,
  )
-- MORPHEUS

import Data.Morpheus.App
  ( App,
    runAppStream,
  )
import Data.Morpheus.Internal.Utils
  ( empty,
  )
import Data.Morpheus.Subscriptions.Apollo
  ( ApolloAction (..),
    ApolloSubscription (..),
    acceptApolloRequest,
  )
import Data.Morpheus.Subscriptions.ClientConnectionStore
  ( ClientConnectionStore,
    SessionID,
    connectionSessionIds,
    delete,
    publish,
    storedChannels,
    storedSessions,
    toList,
  )
import Data.Morpheus.Subscriptions.Event
  ( Event,
  )
import Data.Morpheus.Subscriptions.Stream
  ( ApiContext (..),
    Input (..),
    Output,
    PUB,
    SUB,
    runStreamHTTP,
    runStreamWS,
    toOutStream,
  )
import Data.UUID.V4 (nextRandom)
import Relude hiding (empty, toList)

connect :: MonadIO m => m (Input SUB)
connect :: forall (m :: * -> *). MonadIO m => m (Input SUB)
connect = UUID -> Input SUB
InitConnection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom

disconnect :: ApiContext SUB e m -> Input SUB -> m ()
disconnect :: forall e (m :: * -> *). ApiContext SUB e m -> Input SUB -> m ()
disconnect SubContext {(ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore :: forall (m :: * -> *) event.
ApiContext SUB event m
-> (ClientConnectionStore event m -> ClientConnectionStore event m)
-> m ()
updateStore :: (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore} (InitConnection UUID
clientID) =
  (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
updateStore (forall e (m :: * -> *). UUID -> StoreMap e m
delete UUID
clientID)

-- | PubSubStore interface
-- shared GraphQL state between __websocket__ and __http__ server,
-- you can define your own store if you provide write and read methods
-- to work properly Morpheus needs all entries of ClientConnectionStore (+ client Callbacks)
-- that why it is recommended that you use many local ClientStores on every server node
-- rather then single centralized Store.
data Store e m = Store
  { forall e (m :: * -> *). Store e m -> m (ClientConnectionStore e m)
readStore :: m (ClientConnectionStore e m),
    forall e (m :: * -> *).
Store e m
-> (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
writeStore :: (ClientConnectionStore e m -> ClientConnectionStore e m) -> m ()
  }

publishEventWith ::
  ( MonadIO m,
    Eq channel,
    Hashable channel,
    Show channel
  ) =>
  Store (Event channel cont) m ->
  Event channel cont ->
  m ()
publishEventWith :: forall (m :: * -> *) channel cont.
(MonadIO m, Eq channel, Hashable channel, Show channel) =>
Store (Event channel cont) m -> Event channel cont -> m ()
publishEventWith Store (Event channel cont) m
store Event channel cont
event = forall e (m :: * -> *). Store e m -> m (ClientConnectionStore e m)
readStore Store (Event channel cont) m
store forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) channel content.
(Monad m, Eq channel, Hashable channel, Show channel) =>
Event channel content
-> ClientConnectionStore (Event channel content) m -> m ()
publish Event channel cont
event

-- | initializes empty GraphQL state
initDefaultStore ::
  ( MonadIO m,
    MonadIO m2
  ) =>
  m2 (Store (Event ch con) m)
initDefaultStore :: forall (m :: * -> *) (m2 :: * -> *) ch con.
(MonadIO m, MonadIO m2) =>
m2 (Store (Event ch con) m)
initDefaultStore = do
  MVar (ClientConnectionStore (Event ch con) m)
store <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar forall coll. Empty coll => coll
empty
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Store
      { readStore :: m (ClientConnectionStore (Event ch con) m)
readStore = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar (ClientConnectionStore (Event ch con) m)
store,
        writeStore :: (ClientConnectionStore (Event ch con) m
 -> ClientConnectionStore (Event ch con) m)
-> m ()
writeStore = \ClientConnectionStore (Event ch con) m
-> ClientConnectionStore (Event ch con) m
changes -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (ClientConnectionStore (Event ch con) m)
store (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientConnectionStore (Event ch con) m
-> ClientConnectionStore (Event ch con) m
changes)
      }

finallyM :: MonadUnliftIO m => m () -> m () -> m ()
finallyM :: forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
finallyM m ()
loop m ()
end = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runIO -> forall a b. IO a -> IO b -> IO a
finally (forall a. m a -> IO a
runIO m ()
loop) (forall a. m a -> IO a
runIO m ()
end)

connectionThread ::
  ( MonadUnliftIO m,
    Eq ch,
    Hashable ch
  ) =>
  App (Event ch con) m ->
  ApiContext SUB (Event ch con) m ->
  m ()
connectionThread :: 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
api ApiContext SUB (Event ch con) m
scope = do
  Input SUB
input <- forall (m :: * -> *). MonadIO m => m (Input SUB)
connect
  forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
finallyM
    (forall (m :: * -> *) ch con.
(Monad m, Eq ch, Hashable ch) =>
App (Event ch con) m
-> ApiContext SUB (Event ch con) m -> Input SUB -> m ()
connectionLoop App (Event ch con) m
api ApiContext SUB (Event ch con) m
scope Input SUB
input)
    (forall e (m :: * -> *). ApiContext SUB e m -> Input SUB -> m ()
disconnect ApiContext SUB (Event ch con) m
scope Input SUB
input)

connectionLoop ::
  (Monad m, Eq ch, Hashable ch) =>
  App (Event ch con) m ->
  ApiContext SUB (Event ch con) m ->
  Input SUB ->
  m ()
connectionLoop :: forall (m :: * -> *) ch con.
(Monad m, Eq ch, Hashable ch) =>
App (Event ch con) m
-> ApiContext SUB (Event ch con) m -> Input SUB -> m ()
connectionLoop App (Event ch con) m
app ApiContext SUB (Event ch con) m
scope =
  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e.
Monad m =>
ApiContext SUB e m -> Output SUB e m -> m ()
runStreamWS ApiContext SUB (Event ch con) m
scope
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

streamApp ::
  (Eq ch, Monad m, Hashable ch) =>
  App (Event ch con) m ->
  Input api ->
  Output api (Event ch con) m
streamApp :: 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 = 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 (forall (m :: * -> *) event.
Monad m =>
App event m -> GQLRequest -> ResponseStream event m (Value VALID)
runAppStream App (Event ch con) m
app)