{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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 (void, forever)
import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO, 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
type DiscordHandler = ReaderT DiscordHandle IO
data RunDiscordOpts = RunDiscordOpts
{
RunDiscordOpts -> Text
discordToken :: T.Text
,
RunDiscordOpts -> DiscordHandler ()
discordOnStart :: DiscordHandler ()
,
RunDiscordOpts -> IO ()
discordOnEnd :: IO ()
,
RunDiscordOpts -> Event -> DiscordHandler ()
discordOnEvent :: Event -> DiscordHandler ()
,
RunDiscordOpts -> Text -> IO ()
discordOnLog :: T.Text -> IO ()
,
RunDiscordOpts -> Bool
discordForkThreadForEvents :: Bool
,
RunDiscordOpts -> GatewayIntent
discordGatewayIntent :: GatewayIntent
,
RunDiscordOpts -> Bool
discordEnableCache :: Bool
}
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
}
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)
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
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
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))
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 ()
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
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
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) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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
then UTCTime
send1
else UTCTime
send2
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