{-# 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
      { RestChanHandle
-> Chan
     (String, JsonRequest,
      MVar (Either RestCallInternalException ByteString))
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 -> Chan Text -> IO (RestChanHandle, ThreadId)
startRestThread Auth
auth Chan Text
log = do
  Chan
  (String, JsonRequest,
   MVar (Either RestCallInternalException ByteString))
c <- forall a. IO (Chan a)
newChan
  ThreadId
tid <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Auth
-> Chan
     (String, JsonRequest,
      MVar (Either RestCallInternalException ByteString))
-> Chan Text
-> IO ()
restLoop Auth
auth Chan
  (String, JsonRequest,
   MVar (Either RestCallInternalException ByteString))
c Chan Text
log
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chan
  (String, JsonRequest,
   MVar (Either RestCallInternalException ByteString))
-> RestChanHandle
RestChanHandle Chan
  (String, JsonRequest,
   MVar (Either RestCallInternalException ByteString))
c, ThreadId
tid)

-- | Execute a request blocking until a response is received
writeRestCall :: (Request (r a), FromJSON a) => RestChanHandle -> r a -> IO (Either RestCallInternalException a)
writeRestCall :: forall (r :: * -> *) a.
(Request (r a), FromJSON a) =>
RestChanHandle -> r a -> IO (Either RestCallInternalException a)
writeRestCall RestChanHandle
c r a
req = do
  MVar (Either RestCallInternalException ByteString)
m <- forall a. IO (MVar a)
newEmptyMVar
  forall a. Chan a -> a -> IO ()
writeChan (RestChanHandle
-> Chan
     (String, JsonRequest,
      MVar (Either RestCallInternalException ByteString))
restHandleChan RestChanHandle
c) (forall a. Request a => a -> String
majorRoute r a
req, forall a. Request a => a -> JsonRequest
jsonRequest r a
req, MVar (Either RestCallInternalException ByteString)
m)
  Either RestCallInternalException ByteString
r <- forall a. MVar a -> IO a
readMVar MVar (Either RestCallInternalException ByteString)
m
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RestCallInternalException ByteString
r of
    Right (Right a
o) -> forall a b. b -> Either a b
Right a
o
    (Right (Left String
er)) -> forall a b. a -> Either a b
Left (String -> ByteString -> RestCallInternalException
RestCallInternalNoParse String
er (case Either RestCallInternalException ByteString
r of
      Right ByteString
x -> ByteString
x
      Left RestCallInternalException
_ -> ByteString
""))
    Left RestCallInternalException
e -> forall a b. a -> Either a b
Left RestCallInternalException
e