{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Main module of the library
-- Contains all the entrypoints
module Discord
  ( runDiscord
  , restCall
  , sendCommand
  , readCache
  , stopDiscord
  , getGatewayLatency
  , measureLatency

  , DiscordHandler

  , DiscordHandle
  , Cache(..)
  , RestCallErrorCode(..)
  , RunDiscordOpts(..)
  , FromJSON
  , Request
  , def
  ) where

import Prelude hiding (log)
import Control.Exception (Exception)
import Control.Monad.Reader (ReaderT, runReaderT, void, ask, liftIO, forever, asks)
import Data.Aeson (FromJSON)
import Data.Default (Default, def)
import Data.IORef (writeIORef)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)

import UnliftIO (race, try, finally, SomeException, IOException, readIORef)
import UnliftIO.Concurrent

import Discord.Handle
import Discord.Internal.Rest
import Discord.Internal.Rest.User (UserRequest(GetCurrentUser))
import Discord.Internal.Gateway

-- | A `ReaderT` wrapper around `DiscordHandle` and `IO`. Most functions act in
-- this monad
type DiscordHandler = ReaderT DiscordHandle IO

-- | Options for the connection. 
data RunDiscordOpts = RunDiscordOpts
  { -- | Token for the discord API
    RunDiscordOpts -> Text
discordToken :: T.Text
  , -- | Actions executed right after a connexion to discord's API is
    -- established
    RunDiscordOpts -> DiscordHandler ()
discordOnStart :: DiscordHandler ()
  , -- | Actions executed at termination.
    --
    -- Note that this runs in plain `IO` and not in `DiscordHandler` as the
    -- connexion has been closed before this runs.
    --
    -- Useful for cleaning up.
    RunDiscordOpts -> IO ()
discordOnEnd :: IO ()
  , -- | Actions run upon the reception of an `Event`. This is here most of the
    -- code of the bot may get dispatched from.
    RunDiscordOpts -> Event -> DiscordHandler ()
discordOnEvent :: Event -> DiscordHandler ()
  , -- | Dispatching on internal logs
    RunDiscordOpts -> Text -> IO ()
discordOnLog :: T.Text -> IO ()
  , -- | Fork a thread for every `Event` recived
    RunDiscordOpts -> Bool
discordForkThreadForEvents :: Bool
  , -- | The gateway intents the bot is asking for
    RunDiscordOpts -> GatewayIntent
discordGatewayIntent :: GatewayIntent
  , -- | Whether to use the cache (may use a lot of memory, only enable if it will be used!)
    RunDiscordOpts -> Bool
discordEnableCache :: Bool
  }

-- | Default values for `RunDiscordOpts`
instance Default RunDiscordOpts where
  def :: RunDiscordOpts
def = RunDiscordOpts { discordToken :: Text
discordToken = Text
""
                       , discordOnStart :: DiscordHandler ()
discordOnStart = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordOnEnd :: IO ()
discordOnEnd = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordOnEvent :: Event -> DiscordHandler ()
discordOnEvent = \Event
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordOnLog :: Text -> IO ()
discordOnLog = \Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                       , discordForkThreadForEvents :: Bool
discordForkThreadForEvents = Bool
True
                       , discordGatewayIntent :: GatewayIntent
discordGatewayIntent = forall a. Default a => a
def
                       , discordEnableCache :: Bool
discordEnableCache = Bool
False
                       }

-- | Entrypoint to the library 
runDiscord :: RunDiscordOpts -> IO T.Text
runDiscord :: RunDiscordOpts -> IO Text
runDiscord RunDiscordOpts
opts = do
  Chan Text
log <- forall (m :: * -> *) a. MonadIO m => m (Chan a)
newChan
  ThreadId
logId <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (Text -> IO ()) -> Chan Text -> IO ThreadId
startLogger (RunDiscordOpts -> Text -> IO ()
discordOnLog RunDiscordOpts
opts) Chan Text
log
  (CacheHandle
cache, ThreadId
cacheId) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> Chan Text -> IO (CacheHandle, ThreadId)
startCacheThread (RunDiscordOpts -> Bool
discordEnableCache RunDiscordOpts
opts) Chan Text
log
  (RestChanHandle
rest, ThreadId
restId) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Auth -> Chan Text -> IO (RestChanHandle, ThreadId)
startRestThread (Text -> Auth
Auth (RunDiscordOpts -> Text
discordToken RunDiscordOpts
opts)) Chan Text
log
  (GatewayHandle
gate, ThreadId
gateId) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Auth
-> GatewayIntent
-> CacheHandle
-> Chan Text
-> IO (GatewayHandle, ThreadId)
startGatewayThread (Text -> Auth
Auth (RunDiscordOpts -> Text
discordToken RunDiscordOpts
opts)) (RunDiscordOpts -> GatewayIntent
discordGatewayIntent RunDiscordOpts
opts) CacheHandle
cache Chan Text
log

  MVar Text
libE <- forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar

  let handle :: DiscordHandle
handle = DiscordHandle { discordHandleRestChan :: RestChanHandle
discordHandleRestChan = RestChanHandle
rest
                             , discordHandleGateway :: GatewayHandle
discordHandleGateway = GatewayHandle
gate
                             , discordHandleCache :: CacheHandle
discordHandleCache = CacheHandle
cache
                             , discordHandleLog :: Chan Text
discordHandleLog = Chan Text
log
                             , discordHandleLibraryError :: MVar Text
discordHandleLibraryError = MVar Text
libE
                             , discordHandleThreads :: [HandleThreadId]
discordHandleThreads =
                                 [ ThreadId -> HandleThreadId
HandleThreadIdLogger ThreadId
logId
                                 , ThreadId -> HandleThreadId
HandleThreadIdRest ThreadId
restId
                                 , ThreadId -> HandleThreadId
HandleThreadIdCache ThreadId
cacheId
                                 , ThreadId -> HandleThreadId
HandleThreadIdGateway ThreadId
gateId
                                 ]
                             }

  forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally (DiscordHandle -> RunDiscordOpts -> IO Text
runDiscordLoop DiscordHandle
handle RunDiscordOpts
opts)
          (RunDiscordOpts -> IO ()
discordOnEnd RunDiscordOpts
opts forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DiscordHandler ()
stopDiscord DiscordHandle
handle)

-- | Runs the main loop 
runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO T.Text
runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO Text
runDiscordLoop DiscordHandle
handle RunDiscordOpts
opts = do
  Either RestCallInternalException User
resp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
RestChanHandle -> r a -> IO (Either RestCallInternalException a)
writeRestCall (DiscordHandle -> RestChanHandle
discordHandleRestChan DiscordHandle
handle) UserRequest User
GetCurrentUser
  case Either RestCallInternalException User
resp of
    Left (RestCallInternalErrorCode Int
c ByteString
e1 ByteString
e2) -> Text -> IO Text
libError forall a b. (a -> b) -> a -> b
$
             Text
"HTTP Error Code " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
c) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 ByteString
e1
                                                   forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 ByteString
e2
    Left (RestCallInternalHttpException HttpException
e) -> Text -> IO Text
libError (Text
"HTTP Exception -  " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show HttpException
e))
    Left (RestCallInternalNoParse String
_ ByteString
_) -> Text -> IO Text
libError Text
"Couldn't parse GetCurrentUser"
    Either RestCallInternalException User
_ -> do Either SomeException ()
me <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ RunDiscordOpts -> DiscordHandler ()
discordOnStart RunDiscordOpts
opts) forall a b. (a -> b) -> a -> b
$ DiscordHandle
handle
            case Either SomeException ()
me of
              Left (SomeException
e :: SomeException) -> Text -> IO Text
libError (Text
"discordOnStart handler stopped on an exception:\n\n" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show SomeException
e))
              Right ()
_ -> IO Text
loop
 where
   libError :: T.Text -> IO T.Text
   libError :: Text -> IO Text
libError Text
msg = forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
handle) Text
msg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
msg

   loop :: IO T.Text
   loop :: IO Text
loop = do Either Text (Either GatewayException EventInternalParse)
next <- forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race (forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
handle))
                          (forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan (GatewayHandle -> Chan (Either GatewayException EventInternalParse)
gatewayHandleEvents (DiscordHandle -> GatewayHandle
discordHandleGateway DiscordHandle
handle)))
             case Either Text (Either GatewayException EventInternalParse)
next of
               Left Text
err -> Text -> IO Text
libError Text
err
               Right (Left GatewayException
err) -> Text -> IO Text
libError (String -> Text
T.pack (forall a. Show a => a -> String
show GatewayException
err))
               Right (Right EventInternalParse
event) -> do
                 let userEvent :: Event
userEvent = EventInternalParse -> Event
userFacingEvent EventInternalParse
event
                 let action :: IO () -> IO ()
action = if RunDiscordOpts -> Bool
discordForkThreadForEvents RunDiscordOpts
opts then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO
                                                                 else forall a. a -> a
id
                 IO () -> IO ()
action forall a b. (a -> b) -> a -> b
$ do Either SomeException ()
me <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ RunDiscordOpts -> Event -> DiscordHandler ()
discordOnEvent RunDiscordOpts
opts Event
userEvent) forall a b. (a -> b) -> a -> b
$ DiscordHandle
handle
                             case Either SomeException ()
me of
                               Left (SomeException
e :: SomeException) -> forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan (DiscordHandle -> Chan Text
discordHandleLog DiscordHandle
handle)
                                         (Text
"eventhandler - crashed on [" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Event
userEvent) forall a. Semigroup a => a -> a -> a
<> Text
"] "
                                          forall a. Semigroup a => a -> a -> a
<> Text
"          with error: "  forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show SomeException
e))
                               Right ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                 IO Text
loop

-- | A Error code following a rest call
data RestCallErrorCode = RestCallErrorCode Int T.Text T.Text
  deriving (Int -> RestCallErrorCode -> ShowS
[RestCallErrorCode] -> ShowS
RestCallErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestCallErrorCode] -> ShowS
$cshowList :: [RestCallErrorCode] -> ShowS
show :: RestCallErrorCode -> String
$cshow :: RestCallErrorCode -> String
showsPrec :: Int -> RestCallErrorCode -> ShowS
$cshowsPrec :: Int -> RestCallErrorCode -> ShowS
Show, ReadPrec [RestCallErrorCode]
ReadPrec RestCallErrorCode
Int -> ReadS RestCallErrorCode
ReadS [RestCallErrorCode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestCallErrorCode]
$creadListPrec :: ReadPrec [RestCallErrorCode]
readPrec :: ReadPrec RestCallErrorCode
$creadPrec :: ReadPrec RestCallErrorCode
readList :: ReadS [RestCallErrorCode]
$creadList :: ReadS [RestCallErrorCode]
readsPrec :: Int -> ReadS RestCallErrorCode
$creadsPrec :: Int -> ReadS RestCallErrorCode
Read, RestCallErrorCode -> RestCallErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c/= :: RestCallErrorCode -> RestCallErrorCode -> Bool
== :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c== :: RestCallErrorCode -> RestCallErrorCode -> Bool
Eq, Eq RestCallErrorCode
RestCallErrorCode -> RestCallErrorCode -> Bool
RestCallErrorCode -> RestCallErrorCode -> Ordering
RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
$cmin :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
max :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
$cmax :: RestCallErrorCode -> RestCallErrorCode -> RestCallErrorCode
>= :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c>= :: RestCallErrorCode -> RestCallErrorCode -> Bool
> :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c> :: RestCallErrorCode -> RestCallErrorCode -> Bool
<= :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c<= :: RestCallErrorCode -> RestCallErrorCode -> Bool
< :: RestCallErrorCode -> RestCallErrorCode -> Bool
$c< :: RestCallErrorCode -> RestCallErrorCode -> Bool
compare :: RestCallErrorCode -> RestCallErrorCode -> Ordering
$ccompare :: RestCallErrorCode -> RestCallErrorCode -> Ordering
Ord)

instance Exception RestCallErrorCode

-- | Execute one http request and get a response
restCall :: (Request (r a), FromJSON a) => r a -> DiscordHandler (Either RestCallErrorCode a)
restCall :: forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall r a
r = do DiscordHandle
h <- forall r (m :: * -> *). MonadReader r m => m r
ask
                Bool
empty <- forall (m :: * -> *) a. MonadIO m => MVar a -> m Bool
isEmptyMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
h)
                if Bool -> Bool
not Bool
empty
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (Int -> Text -> Text -> RestCallErrorCode
RestCallErrorCode Int
400 Text
"Library Stopped Working" Text
""))
                else do
                    Either RestCallInternalException a
resp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
RestChanHandle -> r a -> IO (Either RestCallInternalException a)
writeRestCall (DiscordHandle -> RestChanHandle
discordHandleRestChan DiscordHandle
h) r a
r
                    case Either RestCallInternalException a
resp of
                      Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right a
x)
                      Left (RestCallInternalErrorCode Int
c ByteString
e1 ByteString
e2) -> do
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (Int -> Text -> Text -> RestCallErrorCode
RestCallErrorCode Int
c (ByteString -> Text
TE.decodeUtf8 ByteString
e1) (ByteString -> Text
TE.decodeUtf8 ByteString
e2)))
                      Left (RestCallInternalHttpException HttpException
_) ->
                        forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
10 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
>> forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall r a
r
                      Left (RestCallInternalNoParse String
err ByteString
dat) -> do
                        let formaterr :: Text
formaterr = String -> Text
T.pack (String
"restcall - parse exception [" forall a. Semigroup a => a -> a -> a
<> String
err forall a. Semigroup a => a -> a -> a
<> String
"]"
                                              forall a. Semigroup a => a -> a -> a
<> String
" while handling" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
dat)
                        forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan (DiscordHandle -> Chan Text
discordHandleLog DiscordHandle
h) Text
formaterr
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (Int -> Text -> Text -> RestCallErrorCode
RestCallErrorCode Int
400 Text
"Library Parse Exception" Text
formaterr))

-- | Send a user GatewaySendable
sendCommand :: GatewaySendable -> DiscordHandler ()
sendCommand :: GatewaySendable -> DiscordHandler ()
sendCommand GatewaySendable
e = do
  DiscordHandle
h <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan (GatewayHandle -> Chan GatewaySendable
gatewayHandleUserSendables (DiscordHandle -> GatewayHandle
discordHandleGateway DiscordHandle
h)) GatewaySendable
e
  case GatewaySendable
e of
    UpdateStatus UpdateStatusOpts
opts -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (GatewayHandle -> IORef (Maybe UpdateStatusOpts)
gatewayHandleLastStatus (DiscordHandle -> GatewayHandle
discordHandleGateway DiscordHandle
h)) (forall a. a -> Maybe a
Just UpdateStatusOpts
opts)
    GatewaySendable
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Access the current state of the gateway cache
readCache :: DiscordHandler Cache
readCache :: DiscordHandler Cache
readCache = do
  DiscordHandle
h <- forall r (m :: * -> *). MonadReader r m => m r
ask
  Either (Cache, GatewayException) Cache
merr <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar (CacheHandle -> MVar (Either (Cache, GatewayException) Cache)
cacheHandleCache (DiscordHandle -> CacheHandle
discordHandleCache DiscordHandle
h))
  case Either (Cache, GatewayException) Cache
merr of
    Left (Cache
c, GatewayException
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache
c
    Right Cache
c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache
c


-- | Stop all the background threads
stopDiscord :: DiscordHandler ()
stopDiscord :: DiscordHandler ()
stopDiscord = do DiscordHandle
h <- forall r (m :: * -> *). MonadReader r m => m r
ask
                 Bool
_ <- forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar (DiscordHandle -> MVar Text
discordHandleLibraryError DiscordHandle
h) Text
"Library has closed"
                 forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int) forall a. Integral a => a -> a -> a
`div` Int
10)
                 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). MonadIO m => ThreadId -> m ()
killThread forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleThreadId -> ThreadId
toId) (DiscordHandle -> [HandleThreadId]
discordHandleThreads DiscordHandle
h)
  where toId :: HandleThreadId -> ThreadId
toId HandleThreadId
t = case HandleThreadId
t of
                   HandleThreadIdRest ThreadId
a -> ThreadId
a
                   HandleThreadIdGateway ThreadId
a -> ThreadId
a
                   HandleThreadIdCache ThreadId
a -> ThreadId
a
                   HandleThreadIdLogger ThreadId
a -> ThreadId
a

-- | Starts the internal logger
startLogger :: (T.Text -> IO ()) -> Chan T.Text -> IO ThreadId
startLogger :: (Text -> IO ()) -> Chan Text -> IO ThreadId
startLogger Text -> IO ()
handle Chan Text
logC = forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO 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
$
  do Either IOException ()
me <- forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan Chan Text
logC forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO ()
handle
     case Either IOException ()
me of
       Right ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       Left (IOException
_ :: IOException) ->
         -- writeChan logC "Log handler failed"
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Read the gateway latency from the last time we sent and received a 
-- Heartbeat. From Europe tends to give ~110ms
getGatewayLatency :: DiscordHandler NominalDiffTime
getGatewayLatency :: DiscordHandler NominalDiffTime
getGatewayLatency = do
  GatewayHandle
gw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DiscordHandle -> GatewayHandle
discordHandleGateway
  (UTCTime
send1, UTCTime
send2) <- forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (GatewayHandle -> IORef (UTCTime, UTCTime)
gatewayHandleHeartbeatTimes GatewayHandle
gw)

  UTCTime
ack <- forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (GatewayHandle -> IORef UTCTime
gatewayHandleHeartbeatAckTimes GatewayHandle
gw)

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
ack forall a b. (a -> b) -> a -> b
$ 
    if UTCTime
ack forall a. Ord a => a -> a -> Bool
> UTCTime
send1 -- if the ack is before the send just gone, use the previous send
      then UTCTime
send1
      else UTCTime
send2

-- | Measure the current latency by making a request and measuring the time 
-- taken. From Europe tends to give 200ms-800ms.
--
-- The request is getting the bot's user, which requires the `identify` scope.
measureLatency :: DiscordHandler NominalDiffTime
measureLatency :: DiscordHandler NominalDiffTime
measureLatency = do
  UTCTime
startTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Either RestCallErrorCode User
_ <- forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall UserRequest User
GetCurrentUser
  UTCTime
endTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime UTCTime
startTime

-- internal note: it seems bad that it's taking 2x-8x as much time to perform 
-- this specific request, considering that the latency we expect is much less.
-- might be worth looking into efficiencies or a better event to use.