diff options
Diffstat (limited to 'deps/discord-haskell/src/Discord/Internal/Rest.hs')
| -rw-r--r-- | deps/discord-haskell/src/Discord/Internal/Rest.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/deps/discord-haskell/src/Discord/Internal/Rest.hs b/deps/discord-haskell/src/Discord/Internal/Rest.hs new file mode 100644 index 0000000..0ddaff0 --- /dev/null +++ b/deps/discord-haskell/src/Discord/Internal/Rest.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Provides a higher level interface to the rest functions. +-- Preperly writes to the rate-limit loop. Creates separate +-- MVars for each call +module Discord.Internal.Rest + ( module Discord.Internal.Types + , RestChanHandle(..) + , Request(..) + , writeRestCall + , startRestThread + , RestCallInternalException(..) + ) where + +import Prelude hiding (log) +import Data.Aeson (FromJSON, eitherDecode) +import Control.Concurrent.Chan +import Control.Concurrent.MVar +import Control.Concurrent (forkIO, ThreadId) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T + + +import Discord.Internal.Types +import Discord.Internal.Rest.HTTP + +-- | Handle to the Rest 'Chan' +data RestChanHandle = RestChanHandle + { restHandleChan :: Chan (String, JsonRequest, MVar (Either RestCallInternalException BL.ByteString)) + } + +-- | Starts the http request thread. Please only call this once +startRestThread :: Auth -> Chan T.Text -> IO (RestChanHandle, ThreadId) +startRestThread auth log = do + c <- newChan + tid <- forkIO $ restLoop auth c log + pure (RestChanHandle c, tid) + +-- | Execute a request blocking until a response is received +writeRestCall :: (Request (r a), FromJSON a) => RestChanHandle -> r a -> IO (Either RestCallInternalException a) +writeRestCall c req = do + m <- newEmptyMVar + writeChan (restHandleChan c) (majorRoute req, jsonRequest req, m) + r <- readMVar m + pure $ case eitherDecode <$> r of + Right (Right o) -> Right o + (Right (Left er)) -> Left (RestCallInternalNoParse er (case r of + Right x -> x + Left _ -> "")) + Left e -> Left e + + |
