{-# LANGUAGE OverloadedStrings #-}
module Discord.Internal.Gateway
( GatewayHandle(..)
, CacheHandle(..)
, GatewayException(..)
, Cache(..)
, initializeCache
, startCacheThread
, startGatewayThread
, module Discord.Internal.Types
) where
import Prelude hiding (log)
import Control.Concurrent.Chan (newChan, dupChan, Chan)
import Control.Concurrent (forkIO, ThreadId, newEmptyMVar, MVar)
import Data.IORef (newIORef)
import qualified Data.Text as T
import Data.Time (getCurrentTime)
import Discord.Internal.Types (Auth, EventInternalParse, GatewayIntent)
import Discord.Internal.Gateway.EventLoop (connectionLoop, GatewayHandle(..), GatewayException(..))
import Discord.Internal.Gateway.Cache (cacheLoop, Cache(..), CacheHandle(..), initializeCache)
startCacheThread :: Bool -> Chan T.Text -> IO (CacheHandle, ThreadId)
startCacheThread :: Bool -> Chan Text -> IO (CacheHandle, ThreadId)
startCacheThread Bool
isEnabled Chan Text
log = do
Chan (Either GatewayException EventInternalParse)
events <- IO (Chan (Either GatewayException EventInternalParse))
forall a. IO (Chan a)
newChan :: IO (Chan (Either GatewayException EventInternalParse))
MVar Cache
cache <- IO (MVar Cache)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar Cache)
let cacheHandle :: CacheHandle
cacheHandle = Chan (Either GatewayException EventInternalParse)
-> MVar Cache -> CacheHandle
CacheHandle Chan (Either GatewayException EventInternalParse)
events MVar Cache
cache
ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Bool -> CacheHandle -> Chan Text -> IO ()
cacheLoop Bool
isEnabled CacheHandle
cacheHandle Chan Text
log
(CacheHandle, ThreadId) -> IO (CacheHandle, ThreadId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CacheHandle
cacheHandle, ThreadId
tid)
startGatewayThread :: Auth -> GatewayIntent -> CacheHandle -> Chan T.Text -> IO (GatewayHandle, ThreadId)
startGatewayThread :: Auth
-> GatewayIntent
-> CacheHandle
-> Chan Text
-> IO (GatewayHandle, ThreadId)
startGatewayThread Auth
auth GatewayIntent
intent CacheHandle
cacheHandle Chan Text
log = do
Chan (Either GatewayException EventInternalParse)
events <- Chan (Either GatewayException EventInternalParse)
-> IO (Chan (Either GatewayException EventInternalParse))
forall a. Chan a -> IO (Chan a)
dupChan (CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents CacheHandle
cacheHandle)
Chan GatewaySendable
sends <- IO (Chan GatewaySendable)
forall a. IO (Chan a)
newChan
IORef (Maybe UpdateStatusOpts)
status <- Maybe UpdateStatusOpts -> IO (IORef (Maybe UpdateStatusOpts))
forall a. a -> IO (IORef a)
newIORef Maybe UpdateStatusOpts
forall a. Maybe a
Nothing
IORef Integer
seqid <- Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0
IORef Text
seshid <- Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
""
IORef HostName
host <- HostName -> IO (IORef HostName)
forall a. a -> IO (IORef a)
newIORef HostName
"gateway.discord.gg"
UTCTime
currTime <- IO UTCTime
getCurrentTime
IORef UTCTime
hbAcks <- UTCTime -> IO (IORef UTCTime)
forall a. a -> IO (IORef a)
newIORef UTCTime
currTime
IORef (UTCTime, UTCTime)
hbSends <- (UTCTime, UTCTime) -> IO (IORef (UTCTime, UTCTime))
forall a. a -> IO (IORef a)
newIORef (UTCTime
currTime, UTCTime
currTime)
let gatewayHandle :: GatewayHandle
gatewayHandle = Chan (Either GatewayException EventInternalParse)
-> Chan GatewaySendable
-> IORef (Maybe UpdateStatusOpts)
-> IORef Integer
-> IORef Text
-> IORef HostName
-> IORef UTCTime
-> IORef (UTCTime, UTCTime)
-> GatewayHandle
GatewayHandle Chan (Either GatewayException EventInternalParse)
events Chan GatewaySendable
sends IORef (Maybe UpdateStatusOpts)
status IORef Integer
seqid IORef Text
seshid IORef HostName
host IORef UTCTime
hbAcks IORef (UTCTime, UTCTime)
hbSends
ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Auth -> GatewayIntent -> GatewayHandle -> Chan Text -> IO ()
connectionLoop Auth
auth GatewayIntent
intent GatewayHandle
gatewayHandle Chan Text
log
(GatewayHandle, ThreadId) -> IO (GatewayHandle, ThreadId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GatewayHandle
gatewayHandle, ThreadId
tid)