-- | Helpers for dealing with HTTP requests. module Strive.Internal.HTTP ( delete, get, post, put, buildRequest, performRequest, handleResponse, decodeValue, ) where import Data.Aeson (FromJSON, eitherDecode) import Data.ByteString.Char8 (unpack) import Data.ByteString.Lazy (ByteString) import Network.HTTP.Client ( Request, Response, method, parseRequest, responseBody, ) import Network.HTTP.Types ( Method, Query, QueryLike, methodDelete, methodGet, methodPost, methodPut, renderQuery, toQuery, ) import Strive.Aliases (Result) import Strive.Client (Client (client_accessToken, client_requester)) -- | Perform an HTTP DELETE request. delete :: (QueryLike q, FromJSON j) => Client -> String -> q -> IO (Result j) delete = http methodDelete -- | Perform an HTTP GET request. get :: (QueryLike q, FromJSON j) => Client -> String -> q -> IO (Result j) get = http methodGet -- | Perform an HTTP POST request. post :: (QueryLike q, FromJSON j) => Client -> String -> q -> IO (Result j) post = http methodPost -- | Perform an HTTP PUT request. put :: (QueryLike q, FromJSON j) => Client -> String -> q -> IO (Result j) put = http methodPut -- | Perform an HTTP request. http :: (QueryLike q, FromJSON j) => Method -> Client -> String -> q -> IO (Result j) http httpMethod client resource query = do request <- buildRequest httpMethod client resource query response <- performRequest client request pure (handleResponse response) -- | Build a request. buildRequest :: (QueryLike q) => Method -> Client -> String -> q -> IO Request buildRequest httpMethod client resource query = do request <- parseRequest (buildUrl client resource query) pure request {method = httpMethod} -- | Build a URL. buildUrl :: (QueryLike q) => Client -> String -> q -> String buildUrl client resource query = concat [ "https://www.strava.com/", resource, unpack (renderQuery True (buildQuery client <> toQuery query)) ] -- | Build a query. buildQuery :: Client -> Query buildQuery client = toQuery [("access_token", client_accessToken client)] -- | Actually perform an HTTP request. performRequest :: Client -> Request -> IO (Response ByteString) performRequest = client_requester -- | Handle decoding a potentially failed response. handleResponse :: (FromJSON j) => Response ByteString -> Result j handleResponse response = case decodeValue response of Left message -> Left (response, message) Right value -> Right value -- | Decode a response body as JSON. decodeValue :: (FromJSON j) => Response ByteString -> Either String j decodeValue response = eitherDecode (responseBody response)