{-# LANGUAGE OverloadedStrings #-}

-- | Provides a rather raw interface to the websocket events
--   through a real-time Chan
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)

-- | Starts a thread for the cache
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)

-- | Create a Chan for websockets. This creates a thread that
--   writes all the received EventsInternalParse to the Chan
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)