{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module Network.Nakadi.Internal.Types.Problem where
import Data.Aeson
import Data.Aeson.Types
import Data.HashMap.Lazy ( HashMap )
import Data.Text ( Text )
import Prelude
import Network.HTTP.Types.Status as HTTP
( Status )
import qualified Data.HashMap.Lazy as HashMap
import Data.Maybe
import qualified Text.URI as URI
import Text.URI ( URI )
import GHC.Generics
data Problem = Problem
{ problemType :: Maybe URI
, problemTitle :: Text
, problemStatus :: Maybe HTTP.Status
, problemDetail :: Maybe Text
, problemInstance :: Maybe URI
, problemCustom :: HashMap Text Value
} deriving (Show, Eq, Generic)
instance ToJSON Problem where
toJSON Problem {..} =
let hm = HashMap.fromList
(("title", String problemTitle) : catMaybes
[ ("type", ) . String . URI.render <$> problemType
, ("status", ) . Number . fromIntegral . fromEnum <$> problemStatus
, ("detail", ) . String <$> problemDetail
, ("instance", ) . String . URI.render <$> problemInstance
]
)
in Object (HashMap.union hm problemCustom)
instance FromJSON Problem where
parseJSON val = withObject "Problem" parser val
where
parser obj = do
let custom = HashMap.filterWithKey
(\k _ -> k `notElem` ["type", "title", "status", "detail", "instance"])
obj
typeURI <- obj .:? "type" >>= \case
Nothing -> pure Nothing
Just uriText -> Just <$> parseURI uriText
title <- obj .: "title"
status <- obj .:? "status"
detail <- obj .:? "detail"
instanceURI <- obj .:? "instance" >>= \case
Nothing -> pure Nothing
Just uriText -> Just <$> parseURI uriText
pure Problem { problemType = typeURI
, problemTitle = title
, problemStatus = toEnum <$> status
, problemDetail = detail
, problemInstance = instanceURI
, problemCustom = custom
}
parseURI uriText = case URI.mkURI uriText of
Right uri -> pure uri
Left _exn -> typeMismatch "Failed to parse type URI" val