{-# LANGUAGE ImplicitParams #-}

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.Text as Text
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 a b. (a -> b) -> [a] -> [b]
map ((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 a b. (a -> b) -> [a] -> [b]
map 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
        [ ApiKey -> Text
Text.pack ApiKey
"error" Text -> Error -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Payload -> Error
payloadError Payload
x
        , ApiKey -> Text
Text.pack ApiKey
"notifier" Text -> Maybe Notifier -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Payload -> Maybe Notifier
payloadNotifier Payload
x
        , ApiKey -> Text
Text.pack ApiKey
"request" Text -> Maybe Request -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Payload -> Maybe Request
payloadRequest Payload
x
        , ApiKey -> Text
Text.pack ApiKey
"server" Text -> Server -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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
        [ ApiKey -> Text
Text.pack ApiKey
"backtrace" Text -> Maybe [Trace] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Error -> Maybe [Trace]
errorBacktrace Error
x
        , ApiKey -> Text
Text.pack ApiKey
"class" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Error -> Maybe ApiKey
errorClass Error
x
        , ApiKey -> Text
Text.pack ApiKey
"message" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Error -> Maybe ApiKey
errorMessage Error
x
        , ApiKey -> Text
Text.pack ApiKey
"source" Text -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Error -> Maybe (Map ApiKey ApiKey)
errorSource Error
x
        , ApiKey -> Text
Text.pack ApiKey
"tags" Text -> Maybe [ApiKey] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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
        [ ApiKey -> Text
Text.pack ApiKey
"name" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Notifier -> Maybe ApiKey
notifierName Notifier
x
        , ApiKey -> Text
Text.pack ApiKey
"url" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Notifier -> Maybe ApiKey
notifierUrl Notifier
x
        , ApiKey -> Text
Text.pack ApiKey
"version" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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
        [ ApiKey -> Text
Text.pack ApiKey
"action" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Request -> Maybe ApiKey
requestAction Request
x
        , ApiKey -> Text
Text.pack ApiKey
"cgi_data" Text -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Request -> Maybe (Map ApiKey ApiKey)
requestCgiData Request
x
        , ApiKey -> Text
Text.pack ApiKey
"component" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Request -> Maybe ApiKey
requestComponent Request
x
        , ApiKey -> Text
Text.pack ApiKey
"context" Text -> Maybe (Map ApiKey Value) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Request -> Maybe (Map ApiKey Value)
requestContext Request
x
        , ApiKey -> Text
Text.pack ApiKey
"params" Text -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Request -> Maybe (Map ApiKey ApiKey)
requestParams Request
x
        , ApiKey -> Text
Text.pack ApiKey
"session" Text -> Maybe (Map ApiKey ApiKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Request -> Maybe (Map ApiKey ApiKey)
requestSession Request
x
        , ApiKey -> Text
Text.pack ApiKey
"url" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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
        [ ApiKey -> Text
Text.pack ApiKey
"environment_name" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Server -> Maybe ApiKey
serverEnvironmentName Server
x
        , ApiKey -> Text
Text.pack ApiKey
"hostname" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Server -> Maybe ApiKey
serverHostname Server
x
        , ApiKey -> Text
Text.pack ApiKey
"project_root" Text -> Maybe Project -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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
        [ ApiKey -> Text
Text.pack ApiKey
"file" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Trace -> Maybe ApiKey
traceFile Trace
x
        , ApiKey -> Text
Text.pack ApiKey
"method" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Trace -> Maybe ApiKey
traceMethod Trace
x
        , ApiKey -> Text
Text.pack ApiKey
"number" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Trace -> Maybe ApiKey
traceNumber Trace
x
        ]


data 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
        [ ApiKey -> Text
Text.pack ApiKey
"path" Text -> Maybe ApiKey -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
JSON..= Project -> Maybe ApiKey
projectPath Project
x
        ]


data 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 -> Text -> Parser NoticeUuid
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: ApiKey -> Text
Text.pack ApiKey
"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