module Network.Wai.Utilities.JSONResponse
( JSONResponse (..),
waiErrorToJSONResponse,
jsonResponseToWai,
)
where
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.OpenApi qualified as S
import Data.Schema
import Imports
import Network.HTTP.Types.Status
import Network.Wai
import Network.Wai.Utilities.Error qualified as Wai
import Network.Wai.Utilities.Response
data JSONResponse = JSONResponse
{ JSONResponse -> Status
status :: Status,
JSONResponse -> Value
value :: A.Value
}
deriving (JSONResponse -> JSONResponse -> Bool
(JSONResponse -> JSONResponse -> Bool)
-> (JSONResponse -> JSONResponse -> Bool) -> Eq JSONResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONResponse -> JSONResponse -> Bool
== :: JSONResponse -> JSONResponse -> Bool
$c/= :: JSONResponse -> JSONResponse -> Bool
/= :: JSONResponse -> JSONResponse -> Bool
Eq, Eq JSONResponse
Eq JSONResponse =>
(JSONResponse -> JSONResponse -> Ordering)
-> (JSONResponse -> JSONResponse -> Bool)
-> (JSONResponse -> JSONResponse -> Bool)
-> (JSONResponse -> JSONResponse -> Bool)
-> (JSONResponse -> JSONResponse -> Bool)
-> (JSONResponse -> JSONResponse -> JSONResponse)
-> (JSONResponse -> JSONResponse -> JSONResponse)
-> Ord JSONResponse
JSONResponse -> JSONResponse -> Bool
JSONResponse -> JSONResponse -> Ordering
JSONResponse -> JSONResponse -> JSONResponse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JSONResponse -> JSONResponse -> Ordering
compare :: JSONResponse -> JSONResponse -> Ordering
$c< :: JSONResponse -> JSONResponse -> Bool
< :: JSONResponse -> JSONResponse -> Bool
$c<= :: JSONResponse -> JSONResponse -> Bool
<= :: JSONResponse -> JSONResponse -> Bool
$c> :: JSONResponse -> JSONResponse -> Bool
> :: JSONResponse -> JSONResponse -> Bool
$c>= :: JSONResponse -> JSONResponse -> Bool
>= :: JSONResponse -> JSONResponse -> Bool
$cmax :: JSONResponse -> JSONResponse -> JSONResponse
max :: JSONResponse -> JSONResponse -> JSONResponse
$cmin :: JSONResponse -> JSONResponse -> JSONResponse
min :: JSONResponse -> JSONResponse -> JSONResponse
Ord, Int -> JSONResponse -> ShowS
[JSONResponse] -> ShowS
JSONResponse -> String
(Int -> JSONResponse -> ShowS)
-> (JSONResponse -> String)
-> ([JSONResponse] -> ShowS)
-> Show JSONResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSONResponse -> ShowS
showsPrec :: Int -> JSONResponse -> ShowS
$cshow :: JSONResponse -> String
show :: JSONResponse -> String
$cshowList :: [JSONResponse] -> ShowS
showList :: [JSONResponse] -> ShowS
Show)
deriving (Value -> Parser [JSONResponse]
Value -> Parser JSONResponse
(Value -> Parser JSONResponse)
-> (Value -> Parser [JSONResponse]) -> FromJSON JSONResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser JSONResponse
parseJSON :: Value -> Parser JSONResponse
$cparseJSONList :: Value -> Parser [JSONResponse]
parseJSONList :: Value -> Parser [JSONResponse]
FromJSON, [JSONResponse] -> Value
[JSONResponse] -> Encoding
JSONResponse -> Value
JSONResponse -> Encoding
(JSONResponse -> Value)
-> (JSONResponse -> Encoding)
-> ([JSONResponse] -> Value)
-> ([JSONResponse] -> Encoding)
-> ToJSON JSONResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: JSONResponse -> Value
toJSON :: JSONResponse -> Value
$ctoEncoding :: JSONResponse -> Encoding
toEncoding :: JSONResponse -> Encoding
$ctoJSONList :: [JSONResponse] -> Value
toJSONList :: [JSONResponse] -> Value
$ctoEncodingList :: [JSONResponse] -> Encoding
toEncodingList :: [JSONResponse] -> Encoding
ToJSON, Typeable JSONResponse
Typeable JSONResponse =>
(Proxy JSONResponse -> Declare (Definitions Schema) NamedSchema)
-> ToSchema JSONResponse
Proxy JSONResponse -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy JSONResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy JSONResponse -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema JSONResponse
instance ToSchema JSONResponse where
schema :: ValueSchema NamedSwaggerDoc JSONResponse
schema =
Text
-> SchemaP SwaggerDoc Object [Pair] JSONResponse JSONResponse
-> ValueSchema NamedSwaggerDoc JSONResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"JSONResponse" (SchemaP SwaggerDoc Object [Pair] JSONResponse JSONResponse
-> ValueSchema NamedSwaggerDoc JSONResponse)
-> SchemaP SwaggerDoc Object [Pair] JSONResponse JSONResponse
-> ValueSchema NamedSwaggerDoc JSONResponse
forall a b. (a -> b) -> a -> b
$
Status -> Value -> JSONResponse
JSONResponse
(Status -> Value -> JSONResponse)
-> SchemaP SwaggerDoc Object [Pair] JSONResponse Status
-> SchemaP
SwaggerDoc Object [Pair] JSONResponse (Value -> JSONResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSONResponse -> Status
status (JSONResponse -> Status)
-> SchemaP SwaggerDoc Object [Pair] Status Status
-> SchemaP SwaggerDoc Object [Pair] JSONResponse Status
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Status Status
-> SchemaP SwaggerDoc Object [Pair] Status Status
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" (Int -> Status
forall a. Enum a => Int -> a
toEnum (Int -> Status)
-> SchemaP NamedSwaggerDoc Value Value Status Int
-> SchemaP NamedSwaggerDoc Value Value Status Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Status -> Int
forall a. Enum a => a -> Int
fromEnum (Status -> Int)
-> SchemaP NamedSwaggerDoc Value Value Int Int
-> SchemaP NamedSwaggerDoc Value Value Status Int
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Int Int
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
SchemaP
SwaggerDoc Object [Pair] JSONResponse (Value -> JSONResponse)
-> SchemaP SwaggerDoc Object [Pair] JSONResponse Value
-> SchemaP SwaggerDoc Object [Pair] JSONResponse JSONResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] JSONResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] JSONResponse a
-> SchemaP SwaggerDoc Object [Pair] JSONResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSONResponse -> Value
value (JSONResponse -> Value)
-> SchemaP SwaggerDoc Object [Pair] Value Value
-> SchemaP SwaggerDoc Object [Pair] JSONResponse Value
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value Value Value
-> SchemaP SwaggerDoc Object [Pair] Value Value
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"value" SchemaP SwaggerDoc Value Value Value Value
jsonValue
instance Exception JSONResponse
waiErrorToJSONResponse :: Wai.Error -> JSONResponse
waiErrorToJSONResponse :: Error -> JSONResponse
waiErrorToJSONResponse Error
e =
JSONResponse
{ $sel:status:JSONResponse :: Status
status = Error -> Status
Wai.code Error
e,
$sel:value:JSONResponse :: Value
value = Error -> Value
forall a. ToJSON a => a -> Value
toJSON Error
e
}
jsonResponseToWai :: JSONResponse -> Response
jsonResponseToWai :: JSONResponse -> Response
jsonResponseToWai JSONResponse
r = Status -> ResponseHeaders -> ByteString -> Response
responseLBS JSONResponse
r.status [Header
jsonContent] (Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode JSONResponse
r.value)