Skip to content

Commit

Permalink
Updates to request, and updates to GHC2021
Browse files Browse the repository at this point in the history
Bumps version to 2.2.1, since only internals changed.

Updates the request as follows:
* Send the authentication token as a header
* `sha` is deprecated in favor of `code_version`
* add `haskell` as the `langauge`

Updates to GHC2021 and removes OverloadedStrings as a default extension
  • Loading branch information
onslaughtq committed Nov 8, 2024
1 parent 784732b commit 749cd4a
Show file tree
Hide file tree
Showing 4 changed files with 33 additions and 27 deletions.
6 changes: 3 additions & 3 deletions package.yaml
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: rollbar
version: 2.2.0
version: 2.2.1
synopsis: error tracking through rollbar.com
homepage: https://github.com/flipstone/rollbar-haskell
license: MIT
Expand All @@ -8,8 +8,8 @@ maintainer: [email protected]
copyright: Daggerboard Inc. makers of docmunch.com, Azara Solutions Inc.
category: Logging

default-extensions:
- OverloadedStrings
language: GHC2021

ghc-options:
- -Wall
- -Werror
Expand Down
8 changes: 3 additions & 5 deletions rollbar.cabal
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.36.0.
-- This file has been generated from package.yaml by hpack version 0.37.0.
--
-- see: https://github.com/sol/hpack

name: rollbar
version: 2.2.0
version: 2.2.1
synopsis: error tracking through rollbar.com
category: Logging
homepage: https://github.com/flipstone/rollbar-haskell
Expand All @@ -23,8 +23,6 @@ library
Paths_rollbar
hs-source-dirs:
src
default-extensions:
OverloadedStrings
ghc-options: -Wall -Werror -Wcpp-undef -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-orphans
build-depends:
aeson >=1.2 && <2.3
Expand All @@ -36,4 +34,4 @@ library
, resourcet >=1.1 && <1.4
, text >=1.2 && <2.2
, vector >=0.12 && <0.14
default-language: Haskell2010
default-language: GHC2021
38 changes: 22 additions & 16 deletions src/Rollbar.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Main entry point to the application.
module Rollbar
Expand All @@ -20,17 +19,18 @@ module Rollbar
, buildJSON
) where

import qualified Control.Exception as Ex
import Control.Exception qualified as Ex
import Control.Exception.Lifted (catch)
import qualified Control.Monad as Monad
import qualified Control.Monad.IO.Class as MIO
import Control.Monad qualified as Monad
import Control.Monad.IO.Class qualified as MIO
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson ((.:), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (parseMaybe)
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Maybe qualified as Maybe
import Data.Text qualified as T
import Data.Text.Encoding qualified as Enc
import Data.Vector qualified as V
import GHC.Stack (CallStack, SrcLoc (..), getCallStack)
import Network.HTTP.Conduit
( Request (method, requestBody)
Expand All @@ -39,6 +39,7 @@ import Network.HTTP.Conduit
, httpLbs
, newManager
, parseUrlThrow
, requestHeaders
, tlsManagerSettings
)

Expand Down Expand Up @@ -70,7 +71,6 @@ data Settings = Settings
, hostName :: String
, reportErrors :: Bool
}
deriving (Show)

data Options = Options
{ optionsPerson :: Maybe Person
Expand Down Expand Up @@ -176,11 +176,16 @@ reportErrorSWithOptions settings opts section loggerS msg fingerprint callstack
do
logger msg
MIO.liftIO $ do
initReq <- parseUrlThrow "https://api.rollbar.com/api/1/item/"
unauthenticatedReq <- parseUrlThrow "https://api.rollbar.com/api/1/item/"
manager <- newManager tlsManagerSettings
let
req = initReq {method = "POST", requestBody = RequestBodyLBS $ Aeson.encode rollbarJson}
response <- httpLbs req manager
authenticatedRequest =
unauthenticatedReq
{ method = "POST"
, requestHeaders = [("X-Rollbar-Access-Token", Enc.encodeUtf8 . unApiToken $ token settings)]
, requestBody = RequestBodyLBS $ Aeson.encode rollbarJson
}
response <- httpLbs authenticatedRequest manager
let
body = responseBody response
uuid =
Expand Down Expand Up @@ -222,12 +227,13 @@ buildJSON ::
Aeson.Value
buildJSON settings opts section msg fingerprint callstack level =
Aeson.object
[ "access_token" .= unApiToken (token settings)
, "data"
[ "data"
.= Aeson.object
( [ "environment" .= T.toLower (unEnvironment $ environment settings)
, "level" .= Aeson.toJSON level
, "server" .= Aeson.object ["host" .= hostName settings, "sha" .= optionsRevisionSha opts]
, "code_version" .= optionsRevisionSha opts
, "language" .= ("haskell" :: T.Text)
, "server" .= Aeson.object ["host" .= hostName settings]
, "person" .= Aeson.toJSON (optionsPerson opts)
, "body"
.= Aeson.object
Expand Down
8 changes: 5 additions & 3 deletions src/Rollbar/MonadLogger.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,10 @@
module Rollbar.MonadLogger (reportErrorS) where
module Rollbar.MonadLogger
( reportErrorS
) where

import qualified Data.Text as T
import Data.Text qualified as T
import GHC.Exception (CallStack)
import qualified Rollbar
import Rollbar qualified

-- | report errors to rollbar.com and log them with monad-logger
reportErrorS ::
Expand Down

0 comments on commit 749cd4a

Please sign in to comment.