{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
module Servant.Client.Core.ClientError (
    ClientError (..),
    ) where

import           Prelude ()
import           Prelude.Compat

import           Control.DeepSeq
                 (NFData (..))
import           Control.Exception
                 (SomeException (..))
import           Control.Monad.Catch
                 (Exception)
import qualified Data.ByteString              as BS
import           Data.Text
                 (Text)
import           Data.Typeable
                 (Typeable, typeOf)
import           GHC.Generics
                 (Generic)
import           Network.HTTP.Media
                 (MediaType)
import           Network.HTTP.Types ()

import           Servant.Client.Core.BaseUrl
import           Servant.Client.Core.Internal
                 (mediaTypeRnf)
import           Servant.Client.Core.Request
import           Servant.Client.Core.Response


-- | A type representing possible errors in a request
--
-- Note that this type substantially changed in 0.12.
data ClientError =
  -- | The server returned an error response including the
  -- failing request. 'requestPath' includes the 'BaseUrl' and the
  -- path of the request.
    FailureResponse (RequestF () (BaseUrl, BS.ByteString)) Response
  -- | The body could not be decoded at the expected type
  | DecodeFailure Text Response
  -- | The content-type of the response is not supported
  | UnsupportedContentType MediaType Response
  -- | The content-type header is invalid
  | InvalidContentTypeHeader Response
  -- | There was a connection error, and no response was received
  | ConnectionError SomeException
  deriving (Int -> ClientError -> ShowS
[ClientError] -> ShowS
ClientError -> String
(Int -> ClientError -> ShowS)
-> (ClientError -> String)
-> ([ClientError] -> ShowS)
-> Show ClientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientError] -> ShowS
$cshowList :: [ClientError] -> ShowS
show :: ClientError -> String
$cshow :: ClientError -> String
showsPrec :: Int -> ClientError -> ShowS
$cshowsPrec :: Int -> ClientError -> ShowS
Show, (forall x. ClientError -> Rep ClientError x)
-> (forall x. Rep ClientError x -> ClientError)
-> Generic ClientError
forall x. Rep ClientError x -> ClientError
forall x. ClientError -> Rep ClientError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientError x -> ClientError
$cfrom :: forall x. ClientError -> Rep ClientError x
Generic, Typeable)

instance Eq ClientError where
  FailureResponse RequestF () (BaseUrl, ByteString)
req Response
res     == :: ClientError -> ClientError -> Bool
== FailureResponse RequestF () (BaseUrl, ByteString)
req' Response
res'     = RequestF () (BaseUrl, ByteString)
req RequestF () (BaseUrl, ByteString)
-> RequestF () (BaseUrl, ByteString) -> Bool
forall a. Eq a => a -> a -> Bool
== RequestF () (BaseUrl, ByteString)
req' Bool -> Bool -> Bool
&& Response
res Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
res'
  DecodeFailure Text
t Response
r           == DecodeFailure Text
t' Response
r'           = Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t' Bool -> Bool -> Bool
&& Response
r Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
r'
  UnsupportedContentType MediaType
mt Response
r == UnsupportedContentType MediaType
mt' Response
r' = MediaType
mt MediaType -> MediaType -> Bool
forall a. Eq a => a -> a -> Bool
== MediaType
mt' Bool -> Bool -> Bool
&& Response
r Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
r'
  InvalidContentTypeHeader Response
r  == InvalidContentTypeHeader Response
r'   = Response
r Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
r'
  ConnectionError SomeException
exc         == ConnectionError SomeException
exc'          = SomeException -> SomeException -> Bool
eqSomeException SomeException
exc SomeException
exc'
    where
      -- returns true, if type of exception is the same
      eqSomeException :: SomeException -> SomeException -> Bool
eqSomeException (SomeException e
a) (SomeException b) = e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
b

  -- prevent wild card blindness
  FailureResponse          {} == ClientError
_ = Bool
False
  DecodeFailure            {} == ClientError
_ = Bool
False
  UnsupportedContentType   {} == ClientError
_ = Bool
False
  InvalidContentTypeHeader {} == ClientError
_ = Bool
False
  ConnectionError          {} == ClientError
_ = Bool
False

instance Exception ClientError

-- | Note: an exception in 'ConnectionError' might not be evaluated fully,
-- We only 'rnf' its 'show'ed value.
instance NFData ClientError where
    rnf :: ClientError -> ()
rnf (FailureResponse RequestF () (BaseUrl, ByteString)
req Response
res)        = RequestF () (BaseUrl, ByteString) -> ()
forall a. NFData a => a -> ()
rnf RequestF () (BaseUrl, ByteString)
req () -> () -> ()
`seq` Response -> ()
forall a. NFData a => a -> ()
rnf Response
res
    rnf (DecodeFailure Text
err Response
res)          = Text -> ()
forall a. NFData a => a -> ()
rnf Text
err () -> () -> ()
`seq` Response -> ()
forall a. NFData a => a -> ()
rnf Response
res
    rnf (UnsupportedContentType MediaType
mt' Response
res) = MediaType -> ()
mediaTypeRnf MediaType
mt' () -> () -> ()
`seq` Response -> ()
forall a. NFData a => a -> ()
rnf Response
res
    rnf (InvalidContentTypeHeader Response
res)   = Response -> ()
forall a. NFData a => a -> ()
rnf Response
res
    rnf (ConnectionError SomeException
err)            = SomeException
err SomeException -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf (SomeException -> String
forall a. Show a => a -> String
show SomeException
err)