{-# 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 :: [Char] -> Maybe Manager -> Payload -> IO UUID notify [Char] apiKey Maybe Manager maybeManager Payload initialPayload = do let notifier :: Notifier notifier = Notifier { notifierName :: Maybe [Char] notifierName = forall a. a -> Maybe a Just [Char] "Ratel", notifierUrl :: Maybe [Char] notifierUrl = forall a. a -> Maybe a Just [Char] "https://github.com/tfausak/ratel", notifierVersion :: Maybe [Char] notifierVersion = forall a. a -> Maybe a Just (Version -> [Char] 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 = forall a. a -> Maybe a Just Notifier notifier} Maybe Notifier _ -> Payload initialPayload Request initialRequest <- forall (m :: * -> *). MonadThrow m => [Char] -> m Request Client.parseUrlThrow [Char] "https://api.honeybadger.io/v1/notices" let body :: RequestBody body = ByteString -> RequestBody Client.RequestBodyLBS (forall a. ToJSON a => a -> ByteString JSON.encode Payload payload) let headers :: [(HeaderName, ByteString)] headers = [ (HeaderName HTTP.hAccept, [Char] -> ByteString BS.pack [Char] "application/json"), (HeaderName HTTP.hContentType, [Char] -> ByteString BS.pack [Char] "application/json"), (forall s. FoldCase s => s -> CI s CI.mk ([Char] -> ByteString BS.pack [Char] "X-API-Key"), [Char] -> ByteString BS.pack [Char] apiKey) ] let request :: Request request = Request initialRequest { method :: ByteString Client.method = [Char] -> ByteString BS.pack [Char] "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 -> forall (f :: * -> *) a. Applicative f => a -> f a pure (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 forall a. FromJSON a => ByteString -> Either [Char] a JSON.eitherDecode (forall body. Response body -> body Client.responseBody Response ByteString response) of Left [Char] message -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] message Right Notice notice -> forall (f :: * -> *) a. Applicative f => a -> f a pure (NoticeUuid -> UUID unwrapNoticeUuid (Notice -> NoticeUuid noticeUuid Notice notice)) toError :: (Exception.Exception exception, Stack.HasCallStack) => exception -> Error toError :: forall exception. (Exception exception, HasCallStack) => exception -> Error toError exception exception = Error { errorBacktrace :: Maybe [Trace] errorBacktrace = forall a. a -> Maybe a Just (CallStack -> [Trace] toTraces HasCallStack ?callStack), errorClass :: Maybe [Char] errorClass = forall a. a -> Maybe a Just (forall a. Show a => a -> [Char] show (forall a. Typeable a => a -> TypeRep Typeable.typeOf exception exception)), errorMessage :: Maybe [Char] errorMessage = forall a. a -> Maybe a Just (forall e. Exception e => e -> [Char] Exception.displayException exception exception), errorSource :: Maybe (Map [Char] [Char]) errorSource = forall a. Maybe a Nothing, errorTags :: Maybe [[Char]] errorTags = forall a. Maybe a Nothing } toTraces :: Stack.CallStack -> [Trace] toTraces :: CallStack -> [Trace] toTraces CallStack callStack = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry [Char] -> SrcLoc -> Trace toTrace) (CallStack -> [([Char], SrcLoc)] Stack.getCallStack CallStack callStack) toTrace :: String -> Stack.SrcLoc -> Trace toTrace :: [Char] -> SrcLoc -> Trace toTrace [Char] function SrcLoc srcLoc = Trace { traceFile :: Maybe [Char] traceFile = forall a. a -> Maybe a Just (SrcLoc -> [Char] Stack.srcLocFile SrcLoc srcLoc), traceMethod :: Maybe [Char] traceMethod = forall a. a -> Maybe a Just (forall a. [a] -> [[a]] -> [a] List.intercalate [Char] "." [SrcLoc -> [Char] Stack.srcLocModule SrcLoc srcLoc, [Char] function]), traceNumber :: Maybe [Char] traceNumber = forall a. a -> Maybe a Just ( forall a. [a] -> [[a]] -> [a] List.intercalate [Char] ":" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. Show a => a -> [Char] 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 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Payload] -> ShowS $cshowList :: [Payload] -> ShowS show :: Payload -> [Char] $cshow :: Payload -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Error payloadError Payload x, Key "notifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Maybe Notifier payloadNotifier Payload x, Key "request" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Maybe Request payloadRequest Payload x, Key "server" 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 [Char] errorClass :: Maybe String, Error -> Maybe [Char] errorMessage :: Maybe String, Error -> Maybe (Map [Char] [Char]) errorSource :: Maybe (Map.Map String String), Error -> Maybe [[Char]] errorTags :: Maybe [String] } deriving (Error -> Error -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Error] -> ShowS $cshowList :: [Error] -> ShowS show :: Error -> [Char] $cshow :: Error -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [Trace] errorBacktrace Error x, Key "class" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [Char] errorClass Error x, Key "message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [Char] errorMessage Error x, Key "source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe (Map [Char] [Char]) errorSource Error x, Key "tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [[Char]] errorTags Error x ] data Notifier = Notifier { Notifier -> Maybe [Char] notifierName :: Maybe String, Notifier -> Maybe [Char] notifierUrl :: Maybe String, Notifier -> Maybe [Char] notifierVersion :: Maybe String } deriving (Notifier -> Notifier -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Notifier] -> ShowS $cshowList :: [Notifier] -> ShowS show :: Notifier -> [Char] $cshow :: Notifier -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Notifier -> Maybe [Char] notifierName Notifier x, Key "url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Notifier -> Maybe [Char] notifierUrl Notifier x, Key "version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Notifier -> Maybe [Char] notifierVersion Notifier x ] data Request = Request { Request -> Maybe [Char] requestAction :: Maybe String, Request -> Maybe (Map [Char] [Char]) requestCgiData :: Maybe (Map.Map String String), Request -> Maybe [Char] requestComponent :: Maybe String, Request -> Maybe (Map [Char] Value) requestContext :: Maybe (Map.Map String JSON.Value), Request -> Maybe (Map [Char] [Char]) requestParams :: Maybe (Map.Map String String), Request -> Maybe (Map [Char] [Char]) requestSession :: Maybe (Map.Map String String), Request -> Maybe [Char] requestUrl :: Maybe String } deriving (Request -> Request -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Request] -> ShowS $cshowList :: [Request] -> ShowS show :: Request -> [Char] $cshow :: Request -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe [Char] requestAction Request x, Key "cgi_data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] [Char]) requestCgiData Request x, Key "component" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe [Char] requestComponent Request x, Key "context" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] Value) requestContext Request x, Key "params" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] [Char]) requestParams Request x, Key "session" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] [Char]) requestSession Request x, Key "url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe [Char] requestUrl Request x ] data Server = Server { Server -> Maybe [Char] serverEnvironmentName :: Maybe String, Server -> Maybe [Char] serverHostname :: Maybe String, Server -> Maybe Project serverProjectRoot :: Maybe Project } deriving (Server -> Server -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Server] -> ShowS $cshowList :: [Server] -> ShowS show :: Server -> [Char] $cshow :: Server -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Server -> Maybe [Char] serverEnvironmentName Server x, Key "hostname" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Server -> Maybe [Char] serverHostname Server x, Key "project_root" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Server -> Maybe Project serverProjectRoot Server x ] data Trace = Trace { Trace -> Maybe [Char] traceFile :: Maybe String, Trace -> Maybe [Char] traceMethod :: Maybe String, Trace -> Maybe [Char] traceNumber :: Maybe String } deriving (Trace -> Trace -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Trace] -> ShowS $cshowList :: [Trace] -> ShowS show :: Trace -> [Char] $cshow :: Trace -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Trace -> Maybe [Char] traceFile Trace x, Key "method" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Trace -> Maybe [Char] traceMethod Trace x, Key "number" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Trace -> Maybe [Char] traceNumber Trace x ] newtype Project = Project { Project -> Maybe [Char] projectPath :: Maybe String } deriving (Project -> Project -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Project] -> ShowS $cshowList :: [Project] -> ShowS show :: Project -> [Char] $cshow :: Project -> [Char] 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv JSON..= Project -> Maybe [Char] projectPath Project x] newtype Notice = Notice { Notice -> NoticeUuid noticeUuid :: NoticeUuid } deriving (Notice -> Notice -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Notice] -> ShowS $cshowList :: [Notice] -> ShowS show :: Notice -> [Char] $cshow :: Notice -> [Char] 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 forall a. FromJSON a => Object -> Key -> Parser a JSON..: Key "id" forall (f :: * -> *) a. Applicative f => a -> f a pure Notice {noticeUuid :: NoticeUuid noticeUuid = NoticeUuid uuid} Value _ -> forall a. [Char] -> Value -> Parser a JSON.typeMismatch [Char] "Notice" Value json newtype NoticeUuid = NoticeUuid { NoticeUuid -> UUID unwrapNoticeUuid :: UUID.UUID } deriving (NoticeUuid -> NoticeUuid -> Bool 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 -> [Char] forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [NoticeUuid] -> ShowS $cshowList :: [NoticeUuid] -> ShowS show :: NoticeUuid -> [Char] $cshow :: NoticeUuid -> [Char] 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 -> forall a. [Char] -> Value -> Parser a JSON.typeMismatch [Char] "UUID" Value json Just UUID uuid -> forall (f :: * -> *) a. Applicative f => a -> f a pure (UUID -> NoticeUuid NoticeUuid UUID uuid) Value _ -> forall a. [Char] -> Value -> Parser a JSON.typeMismatch [Char] "UUID" Value json