{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | Provides logic code for interacting with the Discord websocket
--   gateway. Realistically, this is probably lower level than most
--   people will need
module Discord.Internal.Gateway.EventLoop where

import Prelude hiding (log)

import Control.Monad (forever, void)
import Control.Monad.Random (getRandomR)
import Control.Concurrent.Async (race)
import Control.Concurrent.Chan
import Control.Concurrent (threadDelay, killThread, forkIO)
import Control.Exception.Safe (try, finally, SomeException)
import Data.IORef
import Data.Aeson (eitherDecode, encode)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import Data.Time (getCurrentTime)

import Wuss (runSecureClient)
import Network.Socket (HostName)
import Network.WebSockets (ConnectionException(..), Connection,
                           receiveData, sendTextData, sendClose)

import Discord.Internal.Types
import Discord.Internal.Rest.Prelude (apiVersion)


-- | Info the event processing loop needs to
data GatewayHandle = GatewayHandle
  { -- | Realtime events from discord
    GatewayHandle -> Chan (Either GatewayException EventInternalParse)
gatewayHandleEvents         :: Chan (Either GatewayException EventInternalParse),
    -- | Events the user sends to discord
    GatewayHandle -> Chan GatewaySendable
gatewayHandleUserSendables  :: Chan GatewaySendable,
    -- | Recent set status (resent to discord on reconnect)
    GatewayHandle -> IORef (Maybe UpdateStatusOpts)
gatewayHandleLastStatus     :: IORef (Maybe UpdateStatusOpts),
    -- | Recent sent event sequence (used to reconnect)
    GatewayHandle -> IORef Integer
gatewayHandleLastSequenceId :: IORef Integer,
    -- | Which discord server session (used to reconnect)
    GatewayHandle -> IORef Text
gatewayHandleSessionId      :: IORef T.Text,
    -- | Which discord gateway to connect to. This should contain a default value
    -- ("gateway.discord.gg") on first connect, but on subsequent Resumes this
    -- may contain a different value. This should never contain trailing slashes,
    -- or any "wss://" prefixes, since HostNames of this kind are not supported
    -- by the websockets library.
    GatewayHandle -> IORef String
gatewayHandleHostname       :: IORef HostName,
    -- | The last time a heartbeatack was received
    GatewayHandle -> IORef UTCTime
gatewayHandleHeartbeatAckTimes    :: IORef UTCTime,
    -- | The last two times a heartbeat was sent
    GatewayHandle -> IORef (UTCTime, UTCTime)
gatewayHandleHeartbeatTimes       :: IORef (UTCTime, UTCTime)
  }

-- | Ways the gateway connection can fail with no possibility of recovery.
newtype GatewayException = GatewayExceptionIntent T.Text
  deriving (Int -> GatewayException -> ShowS
[GatewayException] -> ShowS
GatewayException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewayException] -> ShowS
$cshowList :: [GatewayException] -> ShowS
show :: GatewayException -> String
$cshow :: GatewayException -> String
showsPrec :: Int -> GatewayException -> ShowS
$cshowsPrec :: Int -> GatewayException -> ShowS
Show)


-- | State of the eventloop
data LoopState = LoopStart
               | LoopClosed
               | LoopReconnect
  deriving Int -> LoopState -> ShowS
[LoopState] -> ShowS
LoopState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoopState] -> ShowS
$cshowList :: [LoopState] -> ShowS
show :: LoopState -> String
$cshow :: LoopState -> String
showsPrec :: Int -> LoopState -> ShowS
$cshowsPrec :: Int -> LoopState -> ShowS
Show

-- | Info the sendableLoop reads when it writes to the websocket
data SendablesData = SendablesData
  { SendablesData -> Connection
sendableConnection :: Connection
  , SendablesData -> Chan GatewaySendableInternal
librarySendables :: Chan GatewaySendableInternal
  , SendablesData -> IORef Bool
startsendingUsers :: IORef Bool
  , SendablesData -> Integer
heartbeatInterval :: Integer
  }


-- | Gateway connection infinite loop. Get events from websocket and send them to the library user
--
-- @
--  Auth                                                         needed to connect
--  GatewayIntent                                                needed to connect
--  GatewayHandle (eventsGives,status,usersends,seq,sesh)        needed all over
--  log :: Chan (T.Text)                                         needed all over
--
--  sendableConnection                                 set by setup,  need sendableLoop
--  librarySendables :: Chan (GatewaySendableInternal) set by setup,  need heartbeat
--  heartbeatInterval :: Int                           set by Hello,  need heartbeat
--
--  sequenceId :: Int id of last event received        set by Resume, need heartbeat and reconnect
--  sessionId :: Text                                  set by Ready,  need reconnect
-- @
connectionLoop :: Auth -> GatewayIntent -> GatewayHandle -> Chan T.Text -> IO ()
connectionLoop :: Auth -> GatewayIntent -> GatewayHandle -> Chan Text -> IO ()
connectionLoop Auth
auth GatewayIntent
intent GatewayHandle
gatewayHandle Chan Text
log = LoopState -> IO ()
outerloop LoopState
LoopStart
    where

    -- | Main connection loop. Catch exceptions and reconnect.
    outerloop :: LoopState -> IO ()
    outerloop :: LoopState -> IO ()
outerloop LoopState
state = do
        String
gatewayHost <- forall a. IORef a -> IO a
readIORef (GatewayHandle -> IORef String
gatewayHandleHostname GatewayHandle
gatewayHandle)
        Maybe GatewaySendableInternal
mfirst <- LoopState -> IO (Maybe GatewaySendableInternal)
firstmessage LoopState
state -- construct first message
        case Maybe GatewaySendableInternal
mfirst of
          Maybe GatewaySendableInternal
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- close

          Just GatewaySendableInternal
message -> do
              Either SomeException LoopState
nextstate <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> GatewaySendableInternal -> IO LoopState
startOneConnection String
gatewayHost GatewaySendableInternal
message)  -- connection
              case Either SomeException LoopState
nextstate :: Either SomeException LoopState of
                Left SomeException
_ -> do Int
t <- forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
3,Int
20)
                             Int -> IO ()
threadDelay (Int
t forall a. Num a => a -> a -> a
* (Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)))
                             forall a. Chan a -> a -> IO ()
writeChan Chan Text
log Text
"gateway - trying to reconnect after failure(s)"
                             LoopState -> IO ()
outerloop LoopState
LoopReconnect
                Right LoopState
n -> LoopState -> IO ()
outerloop LoopState
n

    -- | Construct the initial websocket message to send based on which state of the loop.
    --   Fresh start is Identify and a reconnect is Resume
    firstmessage :: LoopState -> IO (Maybe GatewaySendableInternal)
    firstmessage :: LoopState -> IO (Maybe GatewaySendableInternal)
firstmessage LoopState
state =
      case LoopState
state of
        LoopState
LoopStart -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Auth -> GatewayIntent -> (Int, Int) -> GatewaySendableInternal
Identify Auth
auth GatewayIntent
intent (Int
0, Int
1)
        LoopState
LoopReconnect -> do Integer
seqId  <- forall a. IORef a -> IO a
readIORef (GatewayHandle -> IORef Integer
gatewayHandleLastSequenceId GatewayHandle
gatewayHandle)
                            Text
seshId <- forall a. IORef a -> IO a
readIORef (GatewayHandle -> IORef Text
gatewayHandleSessionId GatewayHandle
gatewayHandle)
                            if Text
seshId forall a. Eq a => a -> a -> Bool
== Text
""
                            then do forall a. Chan a -> a -> IO ()
writeChan Chan Text
log Text
"gateway - WARNING seshID was not set by READY?"
                                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Auth -> GatewayIntent -> (Int, Int) -> GatewaySendableInternal
Identify Auth
auth GatewayIntent
intent (Int
0, Int
1)
                            else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Auth -> Text -> Integer -> GatewaySendableInternal
Resume Auth
auth Text
seshId Integer
seqId
        LoopState
LoopClosed -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

    startOneConnection
      :: HostName
      -- ^ The gateway address to connect to. Should be "gateway.discord.gg" on first try, but
      -- all Resumes should go to the resume_gateway_url specified in the Ready event
      -- https://discord.com/developers/docs/change-log#sessionspecific-gateway-resume-urls
      -> GatewaySendableInternal
      -- ^ The first message to send. Either an Identify or Resume.
      -> IO LoopState
    startOneConnection :: String -> GatewaySendableInternal -> IO LoopState
startOneConnection String
gatewayAddr GatewaySendableInternal
message = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> PortNumber -> String -> ClientApp a -> m a
runSecureClient String
gatewayAddr PortNumber
443 (String
"/?v=" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
apiVersion forall a. Semigroup a => a -> a -> a
<>String
"&encoding=json") forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                        Either ConnectionException GatewayReceivable
msg <- Connection
-> Chan Text -> IO (Either ConnectionException GatewayReceivable)
getPayload Connection
conn Chan Text
log
                        case Either ConnectionException GatewayReceivable
msg of
                            Right (Hello Integer
interval) -> do
                                -- setup sendables data
                                Chan GatewaySendableInternal
internal <- forall a. IO (Chan a)
newChan :: IO (Chan GatewaySendableInternal)
                                IORef Bool
sendingUser <- forall a. a -> IO (IORef a)
newIORef Bool
False
                                let sending :: SendablesData
sending = SendablesData { sendableConnection :: Connection
sendableConnection = Connection
conn
                                                            , librarySendables :: Chan GatewaySendableInternal
librarySendables = Chan GatewaySendableInternal
internal
                                                            , startsendingUsers :: IORef Bool
startsendingUsers = IORef Bool
sendingUser
                                                            , heartbeatInterval :: Integer
heartbeatInterval = Integer
interval
                                                            }
                                -- start websocket sending loop
                                ThreadId
sendsId <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Connection -> GatewayHandle -> SendablesData -> Chan Text -> IO ()
sendableLoop Connection
conn GatewayHandle
gatewayHandle SendablesData
sending Chan Text
log
                                ThreadId
heart <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ SendablesData -> IORef (UTCTime, UTCTime) -> IORef Integer -> IO ()
heartbeat SendablesData
sending (GatewayHandle -> IORef (UTCTime, UTCTime)
gatewayHandleHeartbeatTimes GatewayHandle
gatewayHandle) (GatewayHandle -> IORef Integer
gatewayHandleLastSequenceId GatewayHandle
gatewayHandle)
                                forall a. Chan a -> a -> IO ()
writeChan Chan GatewaySendableInternal
internal GatewaySendableInternal
message

                                -- run connection eventloop
                                forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally (GatewayHandle -> SendablesData -> Chan Text -> IO LoopState
runEventLoop GatewayHandle
gatewayHandle SendablesData
sending Chan Text
log)
                                        (ThreadId -> IO ()
killThread ThreadId
heart forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ThreadId -> IO ()
killThread ThreadId
sendsId)

                            Either ConnectionException GatewayReceivable
_ -> do
                                forall a. Chan a -> a -> IO ()
writeChan Chan Text
log Text
"gateway - WARNING could not connect. Expected hello"
                                forall a. WebSocketsData a => Connection -> a -> IO ()
sendClose Connection
conn (ByteString
"expected hello" :: BL.ByteString)
                                forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a. WebSocketsData a => Connection -> IO a
receiveData Connection
conn :: IO BL.ByteString)
                                -- > after sendClose you should call receiveDataMessage until
                                -- > it throws an exception
                                -- haskell websockets documentation
                                Int -> IO ()
threadDelay (Int
3 forall a. Num a => a -> a -> a
* (Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)))
                                forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopStart


-- | Process events from discord and write them to the onDiscordEvent Channel
runEventLoop :: GatewayHandle -> SendablesData -> Chan T.Text -> IO LoopState
runEventLoop :: GatewayHandle -> SendablesData -> Chan Text -> IO LoopState
runEventLoop GatewayHandle
thehandle SendablesData
sendablesData Chan Text
log = do IO LoopState
loop
  where
  eventChan :: Chan (Either GatewayException EventInternalParse)
  eventChan :: Chan (Either GatewayException EventInternalParse)
eventChan = GatewayHandle -> Chan (Either GatewayException EventInternalParse)
gatewayHandleEvents GatewayHandle
thehandle

  -- | Keep receiving Dispatch events until a reconnect or a restart
  loop :: IO LoopState
loop = do
    Either ConnectionException GatewayReceivable
eitherPayload <- SendablesData
-> Chan Text -> IO (Either ConnectionException GatewayReceivable)
getPayloadTimeout SendablesData
sendablesData Chan Text
log
    case Either ConnectionException GatewayReceivable
eitherPayload :: Either ConnectionException GatewayReceivable of

      Right (Dispatch EventInternalParse
event Integer
sq) -> do -- GOT AN EVENT:
                                      forall a. IORef a -> a -> IO ()
writeIORef (GatewayHandle -> IORef Integer
gatewayHandleLastSequenceId GatewayHandle
thehandle) Integer
sq
                                      forall a. Chan a -> a -> IO ()
writeChan Chan (Either GatewayException EventInternalParse)
eventChan (forall a b. b -> Either a b
Right EventInternalParse
event) -- send the event to user
                                      case EventInternalParse
event of
                                        (InternalReady Int
_ User
_ [GuildUnavailable]
_ Text
seshID String
resumeHost Maybe (Int, Int)
_ PartialApplication
_) -> do
                                            forall a. IORef a -> a -> IO ()
writeIORef (GatewayHandle -> IORef Text
gatewayHandleSessionId GatewayHandle
thehandle) Text
seshID
                                            forall a. IORef a -> a -> IO ()
writeIORef (GatewayHandle -> IORef String
gatewayHandleHostname GatewayHandle
thehandle) String
resumeHost
                                        EventInternalParse
_ -> forall a. IORef a -> a -> IO ()
writeIORef (SendablesData -> IORef Bool
startsendingUsers SendablesData
sendablesData) Bool
True
                                      IO LoopState
loop
      Right (Hello Integer
_interval) -> do forall a. Chan a -> a -> IO ()
writeChan Chan Text
log Text
"eventloop - unexpected hello"
                                    IO LoopState
loop
      Right (HeartbeatRequest Integer
sq) -> do forall a. IORef a -> a -> IO ()
writeIORef (GatewayHandle -> IORef Integer
gatewayHandleLastSequenceId GatewayHandle
thehandle) Integer
sq
                                        SendablesData -> IORef (UTCTime, UTCTime) -> Integer -> IO ()
sendHeartbeat SendablesData
sendablesData (GatewayHandle -> IORef (UTCTime, UTCTime)
gatewayHandleHeartbeatTimes GatewayHandle
thehandle) Integer
sq
                                        IO LoopState
loop
      Right (InvalidSession Bool
retry) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
retry then LoopState
LoopReconnect else LoopState
LoopStart
      Right GatewayReceivable
Reconnect        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopReconnect
      Right GatewayReceivable
HeartbeatAck     -> do
        UTCTime
currTime <- IO UTCTime
getCurrentTime
        UTCTime
_ <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (GatewayHandle -> IORef UTCTime
gatewayHandleHeartbeatAckTimes GatewayHandle
thehandle) (forall a. a -> (a, a)
dupe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const UTCTime
currTime)
        IO LoopState
loop
      Right (ParseError Text
_)   -> IO LoopState
loop  -- getPayload logs the parse error. nothing to do here

      Left (CloseRequest Word16
code ByteString
str) -> case Word16
code of
          -- see Discord and MDN documentation on gateway close event codes
          -- https://discord.com/developers/docs/topics/opcodes-and-status-codes#gateway-gateway-close-event-codes
          -- https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent#properties
          Word16
1000 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopReconnect
          Word16
1001 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopReconnect
          Word16
4000 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopReconnect
          Word16
4006 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopStart
          Word16
4007 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopStart
          Word16
4014 -> do forall a. Chan a -> a -> IO ()
writeChan Chan (Either GatewayException EventInternalParse)
eventChan (forall a b. a -> Either a b
Left (Text -> GatewayException
GatewayExceptionIntent forall a b. (a -> b) -> a -> b
$
                           Text
"Tried to declare an unauthorized GatewayIntent. " forall a. Semigroup a => a -> a -> a
<>
                           Text
"Use the discord app manager to authorize by following: " forall a. Semigroup a => a -> a -> a
<>
                           Text
"https://github.com/discord-haskell/discord-haskell/blob/master/docs/intents.md"))
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopClosed
          Word16
_ -> do forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"gateway - unknown websocket close code " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Word16
code)
                                  forall a. Semigroup a => a -> a -> a
<> Text
" [" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
BL.toStrict ByteString
str) forall a. Semigroup a => a -> a -> a
<> Text
"]. Consider opening an issue "
                                  forall a. Semigroup a => a -> a -> a
<> Text
"https://github.com/discord-haskell/discord-haskell/issues")
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopStart
      Left ConnectionException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopState
LoopReconnect


-- | Blocking wait for next payload from the websocket (returns "Reconnect" after 1.5*heartbeatInterval seconds)
getPayloadTimeout :: SendablesData -> Chan T.Text -> IO (Either ConnectionException GatewayReceivable)
getPayloadTimeout :: SendablesData
-> Chan Text -> IO (Either ConnectionException GatewayReceivable)
getPayloadTimeout SendablesData
sendablesData Chan Text
log = do
  let interval :: Integer
interval = SendablesData -> Integer
heartbeatInterval SendablesData
sendablesData
  Either () (Either ConnectionException GatewayReceivable)
res <- forall a b. IO a -> IO b -> IO (Either a b)
race (Int -> IO ()
threadDelay (forall a. Num a => Integer -> a
fromInteger ((Integer
interval forall a. Num a => a -> a -> a
* Integer
1000 forall a. Num a => a -> a -> a
* Integer
3) forall a. Integral a => a -> a -> a
`div` Integer
2)))
              (Connection
-> Chan Text -> IO (Either ConnectionException GatewayReceivable)
getPayload (SendablesData -> Connection
sendableConnection SendablesData
sendablesData) Chan Text
log)
  case Either () (Either ConnectionException GatewayReceivable)
res of
    Left () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right GatewayReceivable
Reconnect)
    Right Either ConnectionException GatewayReceivable
other -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ConnectionException GatewayReceivable
other

-- | Blocking wait for next payload from the websocket
getPayload :: Connection -> Chan T.Text -> IO (Either ConnectionException GatewayReceivable)
getPayload :: Connection
-> Chan Text -> IO (Either ConnectionException GatewayReceivable)
getPayload Connection
conn Chan Text
log = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
  ByteString
msg' <- forall a. WebSocketsData a => Connection -> IO a
receiveData Connection
conn
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
msg' of
    Right GatewayReceivable
msg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GatewayReceivable
msg
    Left  String
err -> do forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"gateway - received exception [" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err forall a. Semigroup a => a -> a -> a
<> Text
"]"
                                      forall a. Semigroup a => a -> a -> a
<> Text
" while decoding " forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
BL.toStrict ByteString
msg'))
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> GatewayReceivable
ParseError (String -> Text
T.pack String
err))

-- | Infinite loop to send heartbeats to the chan
heartbeat :: SendablesData -> IORef (UTCTime, UTCTime) -> IORef Integer -> IO ()
heartbeat :: SendablesData -> IORef (UTCTime, UTCTime) -> IORef Integer -> IO ()
heartbeat SendablesData
sendablesData IORef (UTCTime, UTCTime)
sendTimes IORef Integer
seqKey = do
  Int -> IO ()
threadDelay (Int
3 forall a. Num a => a -> a -> a
* Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int))
  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
    Integer
num <- forall a. IORef a -> IO a
readIORef IORef Integer
seqKey
    SendablesData -> IORef (UTCTime, UTCTime) -> Integer -> IO ()
sendHeartbeat SendablesData
sendablesData IORef (UTCTime, UTCTime)
sendTimes Integer
num
    Int -> IO ()
threadDelay (forall a. Num a => Integer -> a
fromInteger (SendablesData -> Integer
heartbeatInterval SendablesData
sendablesData forall a. Num a => a -> a -> a
* Integer
1000))

sendHeartbeat :: SendablesData -> IORef (UTCTime, UTCTime) -> Integer -> IO ()
sendHeartbeat :: SendablesData -> IORef (UTCTime, UTCTime) -> Integer -> IO ()
sendHeartbeat SendablesData
sendablesData IORef (UTCTime, UTCTime)
sendTimes Integer
seqKey = do
  UTCTime
currTime <- IO UTCTime
getCurrentTime
  (UTCTime, UTCTime)
_ <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (UTCTime, UTCTime)
sendTimes (forall a. a -> (a, a)
dupe forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime
currTime,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  forall a. Chan a -> a -> IO ()
writeChan (SendablesData -> Chan GatewaySendableInternal
librarySendables SendablesData
sendablesData) (Integer -> GatewaySendableInternal
Heartbeat Integer
seqKey)

-- | Infinite loop to send library/user events to discord with the actual websocket connection
sendableLoop :: Connection -> GatewayHandle -> SendablesData -> Chan T.Text -> IO ()
sendableLoop :: Connection -> GatewayHandle -> SendablesData -> Chan Text -> IO ()
sendableLoop Connection
conn GatewayHandle
ghandle SendablesData
sendablesData Chan Text
_log = forall {b}. IO b
sendLoop
  where
  sendLoop :: IO b
sendLoop = do
   -- send a ~120 events a min by delaying
      Int -> IO ()
threadDelay forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round ((Double
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)) forall a. Num a => a -> a -> a
* (Double
62 forall a. Fractional a => a -> a -> a
/ Double
120) :: Double)
   -- payload :: Either GatewaySendableInternal GatewaySendable
      Either GatewaySendableInternal GatewaySendable
payload <- forall a b. IO a -> IO b -> IO (Either a b)
race IO GatewaySendableInternal
nextLibrary IO GatewaySendable
nextUser
      forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
conn (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. ToJSON a => a -> ByteString
encode forall a. ToJSON a => a -> ByteString
encode Either GatewaySendableInternal GatewaySendable
payload)
      IO b
sendLoop

  -- | next event sent by library
  nextLibrary :: IO GatewaySendableInternal
  nextLibrary :: IO GatewaySendableInternal
nextLibrary = forall a. Chan a -> IO a
readChan (SendablesData -> Chan GatewaySendableInternal
librarySendables SendablesData
sendablesData)

  -- | next event sent by user (once startsendingUsers is set)
  nextUser :: IO GatewaySendable
  nextUser :: IO GatewaySendable
nextUser = do Bool
usersending <- forall a. IORef a -> IO a
readIORef (SendablesData -> IORef Bool
startsendingUsers SendablesData
sendablesData)
                if Bool
usersending
                then forall a. Chan a -> IO a
readChan (GatewayHandle -> Chan GatewaySendable
gatewayHandleUserSendables GatewayHandle
ghandle)
                else Int -> IO ()
threadDelay (Int
4 forall a. Num a => a -> a -> a
* (Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO GatewaySendable
nextUser

dupe :: a -> (a, a)
dupe :: forall a. a -> (a, a)
dupe a
a = (a
a, a
a)