module Network.Pusher.Internal.HTTP (MonadHTTP(..), get, post) where
import Control.Arrow (second)
import Control.Monad.Except (MonadError, throwError)
import Data.Text.Encoding (decodeUtf8')
import Network.HTTP.Client
( Manager
, RequestBody(RequestBodyLBS)
, Response
, method
, parseUrl
, requestBody
, requestHeaders
, responseBody
, responseStatus
, setQueryString
)
import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.Method (methodPost)
import Network.HTTP.Types.Status (statusCode, statusMessage)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Control.Monad.Pusher.HTTP (MonadHTTP(httpLbs))
import Debug.Trace
get
:: (A.FromJSON a, Functor m, MonadError T.Text m, MonadHTTP m)
=> Manager
-> B.ByteString
-> [(B.ByteString, B.ByteString)]
-> m a
get connManager ep qs = do
resp <- makeRequest connManager ep qs Nothing
when200 resp $
either
(throwError . T.pack)
return
(A.eitherDecode $ responseBody resp)
post
:: (A.ToJSON a, Functor m, MonadError T.Text m, MonadHTTP m)
=> Manager
-> B.ByteString
-> [(B.ByteString, B.ByteString)]
-> a
-> m ()
post connManager ep qs body = do
resp <- makeRequest connManager ep qs (Just $ A.encode body)
errorOn200 resp
makeRequest
:: (Functor m, MonadError T.Text m, MonadHTTP m)
=> Manager
-> B.ByteString
-> [(B.ByteString, B.ByteString)]
-> Maybe BL.ByteString
-> m (Response BL.ByteString)
makeRequest connManager ep qs body = do
req <- either (throwError . T.pack . show) return (parseUrl $ BC.unpack ep)
let
req' = setQueryString (map (second Just) qs) req
req'' = case body of
Just b -> req'
{ method = methodPost
, requestHeaders = [(hContentType, "application/json")]
, requestBody = RequestBodyLBS b
}
Nothing -> req'
httpLbs req'' connManager
when200 :: (MonadError T.Text m) => Response BL.ByteString -> m a -> m a
when200 response run =
let status = responseStatus response in
if statusCode status == 200 then
run
else
throwError $ either (T.pack . show) id $ decodeUtf8' $ statusMessage status
errorOn200 :: (MonadError T.Text m) => Response BL.ByteString -> m ()
errorOn200 response = when200 response (return ())