{-# LANGUAGE FlexibleContexts #-}

{-|
Module      :  Network.Livy.Response
Copyright   :  (C) 2019 Earnest Research
License     :  MIT
Maintainer  :  Daniel Donohue <ddonohue@earnestresearch.com>
Stability   :  experimental
Portability :  non-portable
-}

module Network.Livy.Response
  ( -- * Receiving a response
    send
  ) where

import           Control.Lens
import           Control.Monad.Catch
import           Control.Monad.Reader
import           Data.Aeson
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as LBS
import           Network.HTTP.Client
import           Network.HTTP.Types

import           Network.Livy.Env
import           Network.Livy.Monad
import           Network.Livy.Request
import           Network.Livy.Types


-- | Send a request, returning the associated response if successful.
send :: LivyConstraint r m a => a -> m (Either LivyError (LivyResponse a))
send req = do
  env <- reader $ view environment
  catch (handleRequest req env) handleHttpException


-- | Send the request to Livy.
handleRequest
  :: (MonadIO m, LivyRequest b, FromJSON a)
  => b -- ^ The 'LivyRequest'.
  -> Env -- ^ An 'Env' to perform the request with.
  -> m (Either LivyError a)
handleRequest req env = liftIO $ httpLbs req' man >>= handleResponse
  where
    man = env ^. envManager
    req' = request req & setHost (env ^. envHost) & setPort (env ^. envPort)


-- | Interpret the response.
handleResponse
  :: (Applicative m, FromJSON a)
  => Response LBS.ByteString -- ^ Livy response.
  -> m (Either LivyError a)
handleResponse resp =
  if livyHttpError (responseStatus resp) then pure . Left $
    makeLivyHttpError (sCode resp) (sMessage resp) (responseBody resp)
  else pure $ parseResponse resp
  where
    sCode = statusCode . responseStatus
    sMessage = statusMessage . responseStatus


-- | Parse the Livy response into a 'LivyResponse', if possible.
parseResponse :: FromJSON a => Response LBS.ByteString -> Either LivyError a
parseResponse resp = case eitherDecode' (responseBody resp) of
  Left e  -> Left $ LivyError ParseFailure (C.pack e) Nothing Nothing
  Right v -> Right v


-- | Handle some of the exceptions thrown by the underlying http-client library.
handleHttpException
  :: Applicative m
  => HttpException -- ^ Exception generated by http-client.
  -> m (Either LivyError a)
handleHttpException e = pure . Left $ LivyError
  (LibraryException e) "Exception generated by http-client" Nothing Nothing


-- | Whether there was an error resulting from the request.
livyHttpError :: Status -> Bool
livyHttpError s = statusCode s >= 400


-- | Create a 'LivyError' value for an HTTP error returned from Livy.
makeLivyHttpError
  :: Int -- ^ The HTTP status code.
  -> S.ByteString -- ^ Status message.
  -> LBS.ByteString -- ^ Response body.
  -> LivyError
makeLivyHttpError c m b = LivyError InvalidRequest m (Just b) $
  case c of
    400 -> Just BadRequest
    401 -> Just Unauthorized
    402 -> Just RequestFailed
    403 -> Just Forbidden
    404 -> Just NotFound
    405 -> Just BadMethod
    500 -> Just ServerError
    501 -> Just ServerError
    502 -> Just ServerError
    503 -> Just ServerError
    504 -> Just ServerError
    _   -> Just UnknownHTTPErrorCode