{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Mattermost.Exceptions
( -- Exception Types
  LoginFailureException(..)
, URIParseException(..)
, ContentTypeException(..)
, JSONDecodeException(..)
, HeaderNotFoundException(..)
, HTTPResponseException(..)
, MattermostError(..)
, ConnectionException(..)
, MattermostServerError(..)
, RateLimitException(..)
) where

import qualified Data.Aeson as A
import qualified Data.Text as T
import           Data.Typeable ( Typeable )
import           Control.Exception ( Exception(..) )
import           Network.Stream ( ConnError )

--

-- Unlike many exceptions in this file, this is a mattermost specific exception
data LoginFailureException = LoginFailureException String
  deriving (Int -> LoginFailureException -> ShowS
[LoginFailureException] -> ShowS
LoginFailureException -> String
(Int -> LoginFailureException -> ShowS)
-> (LoginFailureException -> String)
-> ([LoginFailureException] -> ShowS)
-> Show LoginFailureException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoginFailureException] -> ShowS
$cshowList :: [LoginFailureException] -> ShowS
show :: LoginFailureException -> String
$cshow :: LoginFailureException -> String
showsPrec :: Int -> LoginFailureException -> ShowS
$cshowsPrec :: Int -> LoginFailureException -> ShowS
Show, Typeable)

instance Exception LoginFailureException

--

data URIParseException = URIParseException String
  deriving (Int -> URIParseException -> ShowS
[URIParseException] -> ShowS
URIParseException -> String
(Int -> URIParseException -> ShowS)
-> (URIParseException -> String)
-> ([URIParseException] -> ShowS)
-> Show URIParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URIParseException] -> ShowS
$cshowList :: [URIParseException] -> ShowS
show :: URIParseException -> String
$cshow :: URIParseException -> String
showsPrec :: Int -> URIParseException -> ShowS
$cshowsPrec :: Int -> URIParseException -> ShowS
Show, Typeable)

instance Exception URIParseException

--

data ContentTypeException = ContentTypeException String
  deriving (Int -> ContentTypeException -> ShowS
[ContentTypeException] -> ShowS
ContentTypeException -> String
(Int -> ContentTypeException -> ShowS)
-> (ContentTypeException -> String)
-> ([ContentTypeException] -> ShowS)
-> Show ContentTypeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentTypeException] -> ShowS
$cshowList :: [ContentTypeException] -> ShowS
show :: ContentTypeException -> String
$cshow :: ContentTypeException -> String
showsPrec :: Int -> ContentTypeException -> ShowS
$cshowsPrec :: Int -> ContentTypeException -> ShowS
Show, Typeable)

instance Exception ContentTypeException

--

data JSONDecodeException
  = JSONDecodeException
  { JSONDecodeException -> String
jsonDecodeExceptionMsg  :: String
  , JSONDecodeException -> String
jsonDecodeExceptionJSON :: String
  } deriving (Int -> JSONDecodeException -> ShowS
[JSONDecodeException] -> ShowS
JSONDecodeException -> String
(Int -> JSONDecodeException -> ShowS)
-> (JSONDecodeException -> String)
-> ([JSONDecodeException] -> ShowS)
-> Show JSONDecodeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONDecodeException] -> ShowS
$cshowList :: [JSONDecodeException] -> ShowS
show :: JSONDecodeException -> String
$cshow :: JSONDecodeException -> String
showsPrec :: Int -> JSONDecodeException -> ShowS
$cshowsPrec :: Int -> JSONDecodeException -> ShowS
Show, Typeable)

instance Exception JSONDecodeException

--

data HeaderNotFoundException = HeaderNotFoundException String
  deriving (Int -> HeaderNotFoundException -> ShowS
[HeaderNotFoundException] -> ShowS
HeaderNotFoundException -> String
(Int -> HeaderNotFoundException -> ShowS)
-> (HeaderNotFoundException -> String)
-> ([HeaderNotFoundException] -> ShowS)
-> Show HeaderNotFoundException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderNotFoundException] -> ShowS
$cshowList :: [HeaderNotFoundException] -> ShowS
show :: HeaderNotFoundException -> String
$cshow :: HeaderNotFoundException -> String
showsPrec :: Int -> HeaderNotFoundException -> ShowS
$cshowsPrec :: Int -> HeaderNotFoundException -> ShowS
Show, Typeable)

instance Exception HeaderNotFoundException

--

data MattermostError = MattermostError
  { MattermostError -> Text
mattermostErrorId         :: T.Text
  , MattermostError -> Text
mattermostErrorMessage    :: T.Text
  , MattermostError -> Text
mattermostErrorRequestId  :: T.Text
  , MattermostError -> Int
mattermostErrorStatusCode :: Int
  , MattermostError -> Bool
mattermostErrorIsOAuth    :: Bool
  } deriving (Int -> MattermostError -> ShowS
[MattermostError] -> ShowS
MattermostError -> String
(Int -> MattermostError -> ShowS)
-> (MattermostError -> String)
-> ([MattermostError] -> ShowS)
-> Show MattermostError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MattermostError] -> ShowS
$cshowList :: [MattermostError] -> ShowS
show :: MattermostError -> String
$cshow :: MattermostError -> String
showsPrec :: Int -> MattermostError -> ShowS
$cshowsPrec :: Int -> MattermostError -> ShowS
Show, Typeable)

instance Exception MattermostError

instance A.FromJSON MattermostError where
  parseJSON :: Value -> Parser MattermostError
parseJSON = String
-> (Object -> Parser MattermostError)
-> Value
-> Parser MattermostError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MattermostError" ((Object -> Parser MattermostError)
 -> Value -> Parser MattermostError)
-> (Object -> Parser MattermostError)
-> Value
-> Parser MattermostError
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
mattermostErrorId         <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Text
mattermostErrorMessage    <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"message"
    Text
mattermostErrorRequestId  <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"request_id"
    Int
mattermostErrorStatusCode <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"status_code"
    Bool
mattermostErrorIsOAuth    <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"is_oauth" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False
    MattermostError -> Parser MattermostError
forall (m :: * -> *) a. Monad m => a -> m a
return MattermostError :: Text -> Text -> Text -> Int -> Bool -> MattermostError
MattermostError { Bool
Int
Text
mattermostErrorIsOAuth :: Bool
mattermostErrorStatusCode :: Int
mattermostErrorRequestId :: Text
mattermostErrorMessage :: Text
mattermostErrorId :: Text
mattermostErrorIsOAuth :: Bool
mattermostErrorStatusCode :: Int
mattermostErrorRequestId :: Text
mattermostErrorMessage :: Text
mattermostErrorId :: Text
.. }

data MattermostServerError = MattermostServerError T.Text
  deriving (Int -> MattermostServerError -> ShowS
[MattermostServerError] -> ShowS
MattermostServerError -> String
(Int -> MattermostServerError -> ShowS)
-> (MattermostServerError -> String)
-> ([MattermostServerError] -> ShowS)
-> Show MattermostServerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MattermostServerError] -> ShowS
$cshowList :: [MattermostServerError] -> ShowS
show :: MattermostServerError -> String
$cshow :: MattermostServerError -> String
showsPrec :: Int -> MattermostServerError -> ShowS
$cshowsPrec :: Int -> MattermostServerError -> ShowS
Show, Typeable)

instance Exception MattermostServerError

-- | An exception raised when a request could not be completed due to a
-- request rate limit violation.
data RateLimitException =
    RateLimitException { RateLimitException -> Maybe Int
rateLimitExceptionLimit :: Maybe Int
                       -- ^ The total number of requests allowed in the
                       -- current rate limit window.
                       , RateLimitException -> Maybe Int
rateLimitExceptionRemaining :: Maybe Int
                       -- ^ The number of requests remaining in the
                       -- current rate limit window.
                       , RateLimitException -> Maybe Int
rateLimitExceptionReset :: Maybe Int
                       -- ^ The number of seconds until the rate limit
                       -- window resets.
                       }
                       deriving (Int -> RateLimitException -> ShowS
[RateLimitException] -> ShowS
RateLimitException -> String
(Int -> RateLimitException -> ShowS)
-> (RateLimitException -> String)
-> ([RateLimitException] -> ShowS)
-> Show RateLimitException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RateLimitException] -> ShowS
$cshowList :: [RateLimitException] -> ShowS
show :: RateLimitException -> String
$cshow :: RateLimitException -> String
showsPrec :: Int -> RateLimitException -> ShowS
$cshowsPrec :: Int -> RateLimitException -> ShowS
Show, Typeable)

instance Exception RateLimitException

--

data HTTPResponseException = HTTPResponseException String
  deriving (Int -> HTTPResponseException -> ShowS
[HTTPResponseException] -> ShowS
HTTPResponseException -> String
(Int -> HTTPResponseException -> ShowS)
-> (HTTPResponseException -> String)
-> ([HTTPResponseException] -> ShowS)
-> Show HTTPResponseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTTPResponseException] -> ShowS
$cshowList :: [HTTPResponseException] -> ShowS
show :: HTTPResponseException -> String
$cshow :: HTTPResponseException -> String
showsPrec :: Int -> HTTPResponseException -> ShowS
$cshowsPrec :: Int -> HTTPResponseException -> ShowS
Show, Typeable)

instance Exception HTTPResponseException

--

data ConnectionException = ConnectionException ConnError
 deriving (Int -> ConnectionException -> ShowS
[ConnectionException] -> ShowS
ConnectionException -> String
(Int -> ConnectionException -> ShowS)
-> (ConnectionException -> String)
-> ([ConnectionException] -> ShowS)
-> Show ConnectionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionException] -> ShowS
$cshowList :: [ConnectionException] -> ShowS
show :: ConnectionException -> String
$cshow :: ConnectionException -> String
showsPrec :: Int -> ConnectionException -> ShowS
$cshowsPrec :: Int -> ConnectionException -> ShowS
Show, Typeable)

instance Exception ConnectionException