{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE OverloadedStrings #-}

module Ratel
  ( notify
  , toError
  , toTraces
  , toTrace
  , ApiKey
  , Payload(..)
  , Error(..)
  , Notifier(..)
  , Request(..)
  , Server(..)
  , Trace(..)
  , Project(..)
  , Notice(..)
  , NoticeUuid(..)
  ) where

import qualified Control.Exception as Exception
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Typeable as Typeable
import qualified Data.UUID as UUID
import qualified Data.Version as Version
import qualified GHC.Stack as Stack
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Client.TLS as Client
import qualified Network.HTTP.Types as HTTP
import qualified Paths_ratel as This


notify :: ApiKey -> Maybe Client.Manager -> Payload -> IO UUID.UUID
notify :: ApiKey -> Maybe Manager -> Payload -> IO UUID
notify ApiKey
apiKey Maybe Manager
maybeManager Payload
initialPayload = do
  let
    notifier :: Notifier
notifier = Notifier :: Maybe ApiKey -> Maybe ApiKey -> Maybe ApiKey -> Notifier
Notifier
      { notifierName :: Maybe ApiKey
notifierName = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just ApiKey
"Ratel"
      , notifierUrl :: Maybe ApiKey
notifierUrl = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just ApiKey
"https://github.com/tfausak/ratel"
      , notifierVersion :: Maybe ApiKey
notifierVersion = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just (Version -> ApiKey
Version.showVersion Version
This.version)
      }
  let
    payload :: Payload
payload = case Payload -> Maybe Notifier
payloadNotifier Payload
initialPayload of
      Maybe Notifier
Nothing -> Payload
initialPayload { payloadNotifier :: Maybe Notifier
payloadNotifier = Notifier -> Maybe Notifier
forall a. a -> Maybe a
Just Notifier
notifier }
      Maybe Notifier
_ -> Payload
initialPayload

  Request
initialRequest <- ApiKey -> IO Request
forall (m :: * -> *). MonadThrow m => ApiKey -> m Request
Client.parseUrlThrow
    ApiKey
"https://api.honeybadger.io/v1/notices"
  let body :: RequestBody
body = ByteString -> RequestBody
Client.RequestBodyLBS (Payload -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode Payload
payload)
  let
    headers :: [(HeaderName, ByteString)]
headers =
      [ (HeaderName
HTTP.hAccept, ApiKey -> ByteString
BS.pack ApiKey
"application/json")
      , (HeaderName
HTTP.hContentType, ApiKey -> ByteString
BS.pack ApiKey
"application/json")
      , (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (ApiKey -> ByteString
BS.pack ApiKey
"X-API-Key"), ApiKey -> ByteString
BS.pack ApiKey
apiKey)
      ]
  let
    request :: Request
request = Request
initialRequest
      { method :: ByteString
Client.method = ApiKey -> ByteString
BS.pack ApiKey
"POST"
      , requestBody :: RequestBody
Client.requestBody = RequestBody
body
      , requestHeaders :: [(HeaderName, ByteString)]
Client.requestHeaders = [(HeaderName, ByteString)]
headers
      }

  Manager
manager <- case Maybe Manager
maybeManager of
    Maybe Manager
Nothing -> ManagerSettings -> IO Manager
Client.newManager ManagerSettings
Client.tlsManagerSettings
    Just Manager
manager -> Manager -> IO Manager
forall (m :: * -> *) a. Monad m => a -> m a
return (Manager -> Manager
forall a. HasHttpManager a => a -> Manager
Client.getHttpManager Manager
manager)

  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager
  case ByteString -> Either ApiKey Notice
forall a. FromJSON a => ByteString -> Either ApiKey a
JSON.eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response) of
    Left ApiKey
message -> ApiKey -> IO UUID
forall (m :: * -> *) a. MonadFail m => ApiKey -> m a
fail ApiKey
message
    Right Notice
notice -> UUID -> IO UUID
forall (m :: * -> *) a. Monad m => a -> m a
return (NoticeUuid -> UUID
unwrapNoticeUuid (Notice -> NoticeUuid
noticeUuid Notice
notice))


toError
  :: (Exception.Exception exception, Stack.HasCallStack) => exception -> Error
toError :: exception -> Error
toError exception
exception = Error :: Maybe [Trace]
-> Maybe ApiKey
-> Maybe ApiKey
-> Maybe (Map ApiKey ApiKey)
-> Maybe [ApiKey]
-> Error
Error
  { errorBacktrace :: Maybe [Trace]
errorBacktrace = [Trace] -> Maybe [Trace]
forall a. a -> Maybe a
Just (CallStack -> [Trace]
toTraces ?callStack::CallStack
CallStack
?callStack)
  , errorClass :: Maybe ApiKey
errorClass = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just (TypeRep -> ApiKey
forall a. Show a => a -> ApiKey
show (exception -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf exception
exception))
  , errorMessage :: Maybe ApiKey
errorMessage = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just (exception -> ApiKey
forall e. Exception e => e -> ApiKey
Exception.displayException exception
exception)
  , errorSource :: Maybe (Map ApiKey ApiKey)
errorSource = Maybe (Map ApiKey ApiKey)
forall a. Maybe a
Nothing
  , errorTags :: Maybe [ApiKey]
errorTags = Maybe [ApiKey]
forall a. Maybe a
Nothing
  }


toTraces :: Stack.CallStack -> [Trace]
toTraces :: CallStack -> [Trace]
toTraces CallStack
callStack = ((ApiKey, SrcLoc) -> Trace) -> [(ApiKey, SrcLoc)] -> [Trace]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ApiKey -> SrcLoc -> Trace) -> (ApiKey, SrcLoc) -> Trace
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ApiKey -> SrcLoc -> Trace
toTrace) (CallStack -> [(ApiKey, SrcLoc)]
Stack.getCallStack CallStack
callStack)


toTrace :: String -> Stack.SrcLoc -> Trace
toTrace :: ApiKey -> SrcLoc -> Trace
toTrace ApiKey
function SrcLoc
srcLoc = Trace :: Maybe ApiKey -> Maybe ApiKey -> Maybe ApiKey -> Trace
Trace
  { traceFile :: Maybe ApiKey
traceFile = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just (SrcLoc -> ApiKey
Stack.srcLocFile SrcLoc
srcLoc)
  , traceMethod :: Maybe ApiKey
traceMethod = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just
    (ApiKey -> [ApiKey] -> ApiKey
forall a. [a] -> [[a]] -> [a]
List.intercalate ApiKey
"." [SrcLoc -> ApiKey
Stack.srcLocModule SrcLoc
srcLoc, ApiKey
function])
  , traceNumber :: Maybe ApiKey
traceNumber = ApiKey -> Maybe ApiKey
forall a. a -> Maybe a
Just
    (ApiKey -> [ApiKey] -> ApiKey
forall a. [a] -> [[a]] -> [a]
List.intercalate
      ApiKey
":"
      ((Int -> ApiKey) -> [Int] -> [ApiKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ApiKey
forall a. Show a => a -> ApiKey
show [SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
srcLoc, SrcLoc -> Int
Stack.srcLocStartCol SrcLoc
srcLoc])
    )
  }


type ApiKey = String


data Payload = Payload
  { Payload -> Error
payloadError :: Error
  , Payload -> Maybe Notifier
payloadNotifier :: Maybe Notifier
  , Payload -> Maybe Request
payloadRequest :: Maybe Request
  , Payload -> Server
payloadServer :: Server
  }
  deriving (Payload -> Payload -> Bool
(Payload -> Payload -> Bool)
-> (Payload -> Payload -> Bool) -> Eq Payload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Payload -> Payload -> Bool
$c/= :: Payload -> Payload -> Bool
== :: Payload -> Payload -> Bool
$c== :: Payload -> Payload -> Bool
Eq, Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> ApiKey
(Int -> Payload -> ShowS)
-> (Payload -> ApiKey) -> ([Payload] -> ShowS) -> Show Payload
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Payload] -> ShowS
$cshowList :: [Payload] -> ShowS
show :: Payload -> ApiKey
$cshow :: Payload -> ApiKey
showsPrec :: Int -> Payload -> ShowS
$cshowsPrec :: Int -> Payload -> ShowS
Show)

instance JSON.ToJSON Payload where
  toJSON :: Payload -> Value
toJSON Payload
x = [Pair] -> Value
JSON.object
    [ Key
"error" Key -> Error -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Payload -> Error
payloadError Payload
x
    , Key
"notifier" Key -> Maybe Notifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Payload -> Maybe Notifier
payloadNotifier Payload
x
    , Key
"request" Key -> Maybe Request -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Payload -> Maybe Request
payloadRequest Payload
x
    , Key
"server" Key -> Server -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Payload -> Server
payloadServer Payload
x
    ]


data Error = Error
  { Error -> Maybe [Trace]
errorBacktrace :: Maybe [Trace]
  , Error -> Maybe ApiKey
errorClass :: Maybe String
  , Error -> Maybe ApiKey
errorMessage :: Maybe String
  , Error -> Maybe (Map ApiKey ApiKey)
errorSource :: Maybe (Map.Map String String)
  , Error -> Maybe [ApiKey]
errorTags :: Maybe [String]
  }
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> ApiKey
(Int -> Error -> ShowS)
-> (Error -> ApiKey) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> ApiKey
$cshow :: Error -> ApiKey
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

instance JSON.ToJSON Error where
  toJSON :: Error -> Value
toJSON Error
x = [Pair] -> Value
JSON.object
    [ Key
"backtrace" Key -> Maybe [Trace] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Error -> Maybe [Trace]
errorBacktrace Error
x
    , Key
"class" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Error -> Maybe ApiKey
errorClass Error
x
    , Key
"message" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Error -> Maybe ApiKey
errorMessage Error
x
    , Key
"source" Key -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Error -> Maybe (Map ApiKey ApiKey)
errorSource Error
x
    , Key
"tags" Key -> Maybe [ApiKey] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Error -> Maybe [ApiKey]
errorTags Error
x
    ]


data Notifier = Notifier
  { Notifier -> Maybe ApiKey
notifierName :: Maybe String
  , Notifier -> Maybe ApiKey
notifierUrl :: Maybe String
  , Notifier -> Maybe ApiKey
notifierVersion :: Maybe String
  }
  deriving (Notifier -> Notifier -> Bool
(Notifier -> Notifier -> Bool)
-> (Notifier -> Notifier -> Bool) -> Eq Notifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notifier -> Notifier -> Bool
$c/= :: Notifier -> Notifier -> Bool
== :: Notifier -> Notifier -> Bool
$c== :: Notifier -> Notifier -> Bool
Eq, Int -> Notifier -> ShowS
[Notifier] -> ShowS
Notifier -> ApiKey
(Int -> Notifier -> ShowS)
-> (Notifier -> ApiKey) -> ([Notifier] -> ShowS) -> Show Notifier
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Notifier] -> ShowS
$cshowList :: [Notifier] -> ShowS
show :: Notifier -> ApiKey
$cshow :: Notifier -> ApiKey
showsPrec :: Int -> Notifier -> ShowS
$cshowsPrec :: Int -> Notifier -> ShowS
Show)

instance JSON.ToJSON Notifier where
  toJSON :: Notifier -> Value
toJSON Notifier
x = [Pair] -> Value
JSON.object
    [ Key
"name" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Notifier -> Maybe ApiKey
notifierName Notifier
x
    , Key
"url" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Notifier -> Maybe ApiKey
notifierUrl Notifier
x
    , Key
"version" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Notifier -> Maybe ApiKey
notifierVersion Notifier
x
    ]


data Request = Request
  { Request -> Maybe ApiKey
requestAction :: Maybe String
  , Request -> Maybe (Map ApiKey ApiKey)
requestCgiData :: Maybe (Map.Map String String)
  , Request -> Maybe ApiKey
requestComponent :: Maybe String
  , Request -> Maybe (Map ApiKey Value)
requestContext :: Maybe (Map.Map String JSON.Value)
  , Request -> Maybe (Map ApiKey ApiKey)
requestParams :: Maybe (Map.Map String String)
  , Request -> Maybe (Map ApiKey ApiKey)
requestSession :: Maybe (Map.Map String String)
  , Request -> Maybe ApiKey
requestUrl :: Maybe String
  }
  deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Int -> Request -> ShowS
[Request] -> ShowS
Request -> ApiKey
(Int -> Request -> ShowS)
-> (Request -> ApiKey) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> ApiKey
$cshow :: Request -> ApiKey
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

instance JSON.ToJSON Request where
  toJSON :: Request -> Value
toJSON Request
x = [Pair] -> Value
JSON.object
    [ Key
"action" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe ApiKey
requestAction Request
x
    , Key
"cgi_data" Key -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe (Map ApiKey ApiKey)
requestCgiData Request
x
    , Key
"component" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe ApiKey
requestComponent Request
x
    , Key
"context" Key -> Maybe (Map ApiKey Value) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe (Map ApiKey Value)
requestContext Request
x
    , Key
"params" Key -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe (Map ApiKey ApiKey)
requestParams Request
x
    , Key
"session" Key -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe (Map ApiKey ApiKey)
requestSession Request
x
    , Key
"url" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Request -> Maybe ApiKey
requestUrl Request
x
    ]


data Server = Server
  { Server -> Maybe ApiKey
serverEnvironmentName :: Maybe String
  , Server -> Maybe ApiKey
serverHostname :: Maybe String
  , Server -> Maybe Project
serverProjectRoot :: Maybe Project
  }
  deriving (Server -> Server -> Bool
(Server -> Server -> Bool)
-> (Server -> Server -> Bool) -> Eq Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, Int -> Server -> ShowS
[Server] -> ShowS
Server -> ApiKey
(Int -> Server -> ShowS)
-> (Server -> ApiKey) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> ApiKey
$cshow :: Server -> ApiKey
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show)

instance JSON.ToJSON Server where
  toJSON :: Server -> Value
toJSON Server
x = [Pair] -> Value
JSON.object
    [ Key
"environment_name" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Server -> Maybe ApiKey
serverEnvironmentName Server
x
    , Key
"hostname" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Server -> Maybe ApiKey
serverHostname Server
x
    , Key
"project_root" Key -> Maybe Project -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Server -> Maybe Project
serverProjectRoot Server
x
    ]


data Trace = Trace
  { Trace -> Maybe ApiKey
traceFile :: Maybe String
  , Trace -> Maybe ApiKey
traceMethod :: Maybe String
  , Trace -> Maybe ApiKey
traceNumber :: Maybe String
  }
  deriving (Trace -> Trace -> Bool
(Trace -> Trace -> Bool) -> (Trace -> Trace -> Bool) -> Eq Trace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trace -> Trace -> Bool
$c/= :: Trace -> Trace -> Bool
== :: Trace -> Trace -> Bool
$c== :: Trace -> Trace -> Bool
Eq, Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> ApiKey
(Int -> Trace -> ShowS)
-> (Trace -> ApiKey) -> ([Trace] -> ShowS) -> Show Trace
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> ApiKey
$cshow :: Trace -> ApiKey
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show)

instance JSON.ToJSON Trace where
  toJSON :: Trace -> Value
toJSON Trace
x = [Pair] -> Value
JSON.object
    [ Key
"file" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Trace -> Maybe ApiKey
traceFile Trace
x
    , Key
"method" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Trace -> Maybe ApiKey
traceMethod Trace
x
    , Key
"number" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Trace -> Maybe ApiKey
traceNumber Trace
x
    ]


newtype Project = Project
    { Project -> Maybe ApiKey
projectPath :: Maybe String
    } deriving (Project -> Project -> Bool
(Project -> Project -> Bool)
-> (Project -> Project -> Bool) -> Eq Project
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Project -> Project -> Bool
$c/= :: Project -> Project -> Bool
== :: Project -> Project -> Bool
$c== :: Project -> Project -> Bool
Eq, Int -> Project -> ShowS
[Project] -> ShowS
Project -> ApiKey
(Int -> Project -> ShowS)
-> (Project -> ApiKey) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Project] -> ShowS
$cshowList :: [Project] -> ShowS
show :: Project -> ApiKey
$cshow :: Project -> ApiKey
showsPrec :: Int -> Project -> ShowS
$cshowsPrec :: Int -> Project -> ShowS
Show)

instance JSON.ToJSON Project where
  toJSON :: Project -> Value
toJSON Project
x = [Pair] -> Value
JSON.object [Key
"path" Key -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
JSON..= Project -> Maybe ApiKey
projectPath Project
x]


newtype Notice = Notice
    { Notice -> NoticeUuid
noticeUuid :: NoticeUuid
    } deriving (Notice -> Notice -> Bool
(Notice -> Notice -> Bool)
-> (Notice -> Notice -> Bool) -> Eq Notice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notice -> Notice -> Bool
$c/= :: Notice -> Notice -> Bool
== :: Notice -> Notice -> Bool
$c== :: Notice -> Notice -> Bool
Eq, Int -> Notice -> ShowS
[Notice] -> ShowS
Notice -> ApiKey
(Int -> Notice -> ShowS)
-> (Notice -> ApiKey) -> ([Notice] -> ShowS) -> Show Notice
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [Notice] -> ShowS
$cshowList :: [Notice] -> ShowS
show :: Notice -> ApiKey
$cshow :: Notice -> ApiKey
showsPrec :: Int -> Notice -> ShowS
$cshowsPrec :: Int -> Notice -> ShowS
Show)

instance JSON.FromJSON Notice where
  parseJSON :: Value -> Parser Notice
parseJSON Value
json = case Value
json of
    JSON.Object Object
object -> do
      NoticeUuid
uuid <- Object
object Object -> Key -> Parser NoticeUuid
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"id"
      Notice -> Parser Notice
forall (m :: * -> *) a. Monad m => a -> m a
return Notice :: NoticeUuid -> Notice
Notice { noticeUuid :: NoticeUuid
noticeUuid = NoticeUuid
uuid }
    Value
_ -> ApiKey -> Value -> Parser Notice
forall a. ApiKey -> Value -> Parser a
JSON.typeMismatch ApiKey
"Notice" Value
json


newtype NoticeUuid = NoticeUuid
    { NoticeUuid -> UUID
unwrapNoticeUuid :: UUID.UUID
    } deriving (NoticeUuid -> NoticeUuid -> Bool
(NoticeUuid -> NoticeUuid -> Bool)
-> (NoticeUuid -> NoticeUuid -> Bool) -> Eq NoticeUuid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoticeUuid -> NoticeUuid -> Bool
$c/= :: NoticeUuid -> NoticeUuid -> Bool
== :: NoticeUuid -> NoticeUuid -> Bool
$c== :: NoticeUuid -> NoticeUuid -> Bool
Eq, Int -> NoticeUuid -> ShowS
[NoticeUuid] -> ShowS
NoticeUuid -> ApiKey
(Int -> NoticeUuid -> ShowS)
-> (NoticeUuid -> ApiKey)
-> ([NoticeUuid] -> ShowS)
-> Show NoticeUuid
forall a.
(Int -> a -> ShowS) -> (a -> ApiKey) -> ([a] -> ShowS) -> Show a
showList :: [NoticeUuid] -> ShowS
$cshowList :: [NoticeUuid] -> ShowS
show :: NoticeUuid -> ApiKey
$cshow :: NoticeUuid -> ApiKey
showsPrec :: Int -> NoticeUuid -> ShowS
$cshowsPrec :: Int -> NoticeUuid -> ShowS
Show)

instance JSON.FromJSON NoticeUuid where
  parseJSON :: Value -> Parser NoticeUuid
parseJSON Value
json = case Value
json of
    JSON.String Text
text -> case Text -> Maybe UUID
UUID.fromText Text
text of
      Maybe UUID
Nothing -> ApiKey -> Value -> Parser NoticeUuid
forall a. ApiKey -> Value -> Parser a
JSON.typeMismatch ApiKey
"UUID" Value
json
      Just UUID
uuid -> NoticeUuid -> Parser NoticeUuid
forall (m :: * -> *) a. Monad m => a -> m a
return (UUID -> NoticeUuid
NoticeUuid UUID
uuid)
    Value
_ -> ApiKey -> Value -> Parser NoticeUuid
forall a. ApiKey -> Value -> Parser a
JSON.typeMismatch ApiKey
"UUID" Value
json