patrol 1.0.1.0 → 1.1.0.0

raw patch · 12 files changed

+70/−92 lines, 12 filesdep ~exceptionsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: exceptions

API changes (from Hackage documentation)

Files

• patrol.cabal +2/−1
• source/library/Patrol/Client.hs +12/−12
• source/library/Patrol/Type/Dsn.hs +9/−8
• source/library/Patrol/Type/Envelope.hs +0/−12
• source/library/Patrol/Type/Event.hs +5/−9
• source/library/Patrol/Type/Exception.hs +3/−9
• source/library/Patrol/Type/Exceptions.hs +3/−8
• source/test-suite/Patrol/Type/DsnSpec.hs +6/−0
• source/test-suite/Patrol/Type/EnvelopeSpec.hs +11/−13
• source/test-suite/Patrol/Type/EventSpec.hs +12/−9
• source/test-suite/Patrol/Type/ExceptionSpec.hs +4/−9
• source/test-suite/Patrol/Type/ExceptionsSpec.hs +3/−2

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: patrol-version: 1.0.1.0+version: 1.1.0.0 synopsis: Sentry SDK description: Patrol is a Sentry SDK. build-type: Simple@@ -134,6 +134,7 @@     bytestring,     case-insensitive,     containers,+    exceptions,     hspec ^>=2.11.8,     http-client,     http-types,

@@ -1,10 +1,12 @@+-- In the use of ‘intoRequest’ (imported from Patrol.Type.Event)+{-# OPTIONS_GHC -Wno-deprecations #-}+ module Patrol.Client where  import qualified Control.Monad.Catch as Catch import qualified Control.Monad.IO.Class as IO import qualified Data.Aeson as Aeson import qualified Data.Text as Text-import qualified GHC.Stack as Stack import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Client.TLS as Tls import qualified Patrol.Exception.Problem as Problem@@ -25,22 +27,20 @@   dsn <- do     maybeString <- IO.liftIO $ Environment.lookupEnv "SENTRY_DSN"     Dsn.fromText $ maybe Text.empty Text.pack maybeString-  captureExceptionWith (const Nothing) pure dsn e+  captureExceptionWith pure dsn e  captureExceptionWith ::   (Catch.Exception e, IO.MonadIO io, Catch.MonadThrow io) =>-  -- | How to get a 'Stack.CallStack' from a 'Catch.SomeException'. Use-  -- @'const' 'Nothing'@ if you don't want to get a call stack.-  (Catch.SomeException -> Maybe Stack.CallStack) ->-  -- | How to modify the 'Envelope.Envelope' before it is sent. Use @'pure'@ if-  -- you don't want to modify the envelope.-  (Envelope.Envelope -> io Envelope.Envelope) ->+  -- | How to modify the 'Event.Event' before it is sent. Use @'pure'@ if you+  -- don't want to modify the event.+  (Event.Event -> io Event.Event) ->   Dsn.Dsn ->   e ->   io Response.Response-captureExceptionWith getCallStack modifyEnvelope dsn e = do-  initialEnvelope <- Envelope.fromException getCallStack dsn e-  envelope <- modifyEnvelope initialEnvelope+captureExceptionWith modifyEvent dsn e = do+  initialEvent <- Event.fromSomeException $ Catch.toException e+  event <- modifyEvent initialEvent+  let envelope = Envelope.fromEvent dsn event   request <- Envelope.intoRequest dsn envelope   manager <- Tls.newTlsManager   response <- IO.liftIO $ Client.httpLbs request manager@@ -48,7 +48,7 @@     . Aeson.eitherDecode     $ Client.responseBody response --- TODO: Deprecate.+{-# DEPRECATED store "Use 'captureException' instead." #-} store ::   (IO.MonadIO io, Catch.MonadThrow io) =>   Client.Manager ->

@@ -24,23 +24,24 @@   deriving (Eq, Show)  fromText :: (Catch.MonadThrow m) => Text.Text -> m Dsn-fromText text = case Uri.parseURI (Text.unpack text) of+fromText text = case Uri.parseURI $ Text.unpack text of   Nothing -> Catch.throwM $ Problem.Problem "invalid URI"   Just uri -> fromUri uri  fromUri :: (Catch.MonadThrow m) => Uri.URI -> m Dsn-fromUri uri = do-  theProtocol <- maybe (Catch.throwM $ Problem.Problem "invalid scheme") pure . Text.stripSuffix (Text.singleton ':') . Text.pack $ Uri.uriScheme uri-  uriAuth <- maybe (Catch.throwM $ Problem.Problem "missing authority") pure $ Uri.uriAuthority uri-  userInfo <- maybe (Catch.throwM $ Problem.Problem "invalid user information") pure . Text.stripSuffix (Text.singleton '@') . Text.pack $ Uri.uriUserInfo uriAuth+fromUri uri = either (Catch.throwM . Problem.Problem) pure $ do+  Monad.unless (null $ Uri.uriQuery uri) $ Left "unexpected query"+  Monad.unless (null $ Uri.uriFragment uri) $ Left "unexpected fragment"+  theProtocol <- maybe (Left "invalid scheme") pure . Text.stripSuffix (Text.singleton ':') . Text.pack $ Uri.uriScheme uri+  uriAuth <- maybe (Left "missing authority") pure $ Uri.uriAuthority uri+  userInfo <- maybe (Left "invalid user information") pure . Text.stripSuffix (Text.singleton '@') . Text.pack $ Uri.uriUserInfo uriAuth   let (thePublicKey, theSecretKey) = fmap (Text.drop 1) $ Text.breakOn (Text.singleton ':') userInfo       theHost = Text.pack $ Uri.uriRegName uriAuth   maybePort <- case Text.stripPrefix (Text.singleton ':') . Text.pack $ Uri.uriPort uriAuth of     Nothing -> pure Nothing-    Just text -> maybe (Catch.throwM $ Problem.Problem "invalid port") (pure . Just) . Read.readMaybe $ Text.unpack text+    Just text -> maybe (Left "invalid port") (pure . Just) . Read.readMaybe $ Text.unpack text   let (thePath, theProjectId) = Text.breakOnEnd (Text.singleton '/') . Text.pack $ Uri.uriPath uri-  Monad.unless (null $ Uri.uriQuery uri) . Catch.throwM $ Problem.Problem "unexpected query"-  Monad.unless (null $ Uri.uriFragment uri) . Catch.throwM $ Problem.Problem "unexpected fragment"+  Monad.when (Text.null theProjectId) $ Left "missing project ID"   pure     Dsn       { protocol = theProtocol,

@@ -1,7 +1,6 @@ module Patrol.Type.Envelope where  import qualified Control.Monad.Catch as Catch-import qualified Control.Monad.IO.Class as IO import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KeyMap@@ -11,7 +10,6 @@ import qualified Data.Maybe as Maybe import qualified Data.Text as Text import qualified Data.Text.Encoding as Encoding-import qualified GHC.Stack as Stack import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Types as Http import qualified Patrol.Constant as Constant@@ -28,16 +26,6 @@     items :: [Item.Item]   }   deriving (Eq, Show)--fromException ::-  (Catch.Exception e, IO.MonadIO io) =>-  (Catch.SomeException -> Maybe Stack.CallStack) ->-  Dsn.Dsn ->-  e ->-  io Envelope-fromException getCallStack dsn =-  fmap (fromEvent dsn)-    . Event.fromException getCallStack  fromEvent :: Dsn.Dsn -> Event.Event -> Envelope fromEvent dsn event =

@@ -8,7 +8,6 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Time as Time-import qualified GHC.Stack as Stack import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Types as Http import qualified Patrol.Constant as Constant@@ -136,6 +135,7 @@     { environment = Text.pack "production",       level = Just Level.Error,       platform = Just Platform.Haskell,+      sdk = Just ClientSdkInfo.patrol,       type_ = Just EventType.Default,       version = Constant.sentryVersion     }@@ -155,19 +155,15 @@   withEventId <- setEventId initial   setTimestamp withEventId -fromException ::-  (Catch.Exception e, IO.MonadIO io) =>-  (Catch.SomeException -> Maybe Stack.CallStack) ->-  e ->-  io Event-fromException getCallStack e = do+fromSomeException :: (IO.MonadIO io) => Catch.SomeException -> io Event+fromSomeException e = do   event <- new   pure     event-      { exception = Just $ Exceptions.fromException getCallStack e+      { exception = Just $ Exceptions.fromSomeException e       } --- TODO: Deprecate.+{-# DEPRECATED intoRequest "Use 'Patrol.Type.Envelope.intoRequest' instead." #-} intoRequest :: (Catch.MonadThrow m) => Dsn.Dsn -> Event -> m Client.Request intoRequest dsn event = do   theRequest <-

@@ -4,7 +4,6 @@ import qualified Data.Aeson as Aeson import qualified Data.Text as Text import qualified Data.Typeable as Typeable-import qualified GHC.Stack as Stack import qualified Patrol.Extra.Aeson as Aeson import qualified Patrol.Type.Mechanism as Mechanism import qualified Patrol.Type.Stacktrace as Stacktrace@@ -42,14 +41,9 @@       value = Text.empty     } -fromException ::-  (Catch.Exception e) =>-  (Catch.SomeException -> Maybe Stack.CallStack) ->-  e ->-  Exception-fromException getCallStack e =+fromSomeException :: Catch.SomeException -> Exception+fromSomeException (Catch.SomeException e) =   empty-    { stacktrace = fmap Stacktrace.fromCallStack . getCallStack $ Catch.toException e,-      type_ = Text.pack . show $ Typeable.typeOf e,+    { type_ = Text.pack . show $ Typeable.typeOf e,       value = Text.pack $ Catch.displayException e     }

@@ -2,7 +2,6 @@  import qualified Control.Monad.Catch as Catch import qualified Data.Aeson as Aeson-import qualified GHC.Stack as Stack import qualified Patrol.Extra.Aeson as Aeson import qualified Patrol.Type.Exception as Exception @@ -24,12 +23,8 @@     { values = []     } -fromException ::-  (Catch.Exception e) =>-  (Catch.SomeException -> Maybe Stack.CallStack) ->-  e ->-  Exceptions-fromException getCallStack e =+fromSomeException :: Catch.SomeException -> Exceptions+fromSomeException e =   Exceptions-    { values = [Exception.fromException getCallStack e]+    { values = [Exception.fromSomeException e]     }

@@ -78,6 +78,12 @@     Hspec.it "fails with a fragment" $ do       Dsn.fromUri [Uri.uri|a://b@c/d#|] `Hspec.shouldBe` Nothing +    Hspec.it "fails without a project ID" $ do+      Dsn.fromUri [Uri.uri|a://b@c|] `Hspec.shouldBe` Nothing++    Hspec.it "fails with a trailing slash" $ do+      Dsn.fromUri [Uri.uri|a://b@c/d/|] `Hspec.shouldBe` Nothing+   Hspec.describe "intoUri" $ do     Hspec.it "converts a minimal DSN into URI" $ do       let dsn =

@@ -69,8 +69,7 @@   Hspec.describe "fromEvent" $ do     Hspec.it "sets the header" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      event <- Event.fromException (const Nothing) $ userError ""-      let envelope = Envelope.fromEvent dsn event {Event.timestamp = Nothing}+      let envelope = Envelope.fromEvent dsn Event.empty       let expected =             Headers.fromObject $               KeyMap.fromList@@ -86,44 +85,43 @@      Hspec.it "sets the items" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      event <- Event.fromException (const Nothing) $ userError ""-      let envelope = Envelope.fromEvent dsn event+      let envelope = Envelope.fromEvent dsn Event.empty       Envelope.items envelope `Hspec.shouldNotSatisfy` null    Hspec.describe "intoRequest" $ do     Hspec.it "sets the method" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       Client.method request `Hspec.shouldBe` Http.methodPost      Hspec.it "sets the host" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       Client.host request `Hspec.shouldBe` "sentry.test"      Hspec.it "sets the port" $ do       dsn <- Dsn.fromText "http://key@sentry.test:8080/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       Client.port request `Hspec.shouldBe` 8080      Hspec.it "sets the path" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       Client.path request `Hspec.shouldBe` "/api/1/envelope/"      Hspec.it "handles a custom path" $ do       dsn <- Dsn.fromText "http://key@sentry.test/custom/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       Client.path request `Hspec.shouldBe` "/custom/api/1/envelope/"      Hspec.it "sets the body" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       actual <- case Client.requestBody request of         Client.RequestBodyBS byteString -> pure byteString@@ -133,18 +131,18 @@      Hspec.it "sets the content type" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       lookup Http.hContentType (Client.requestHeaders request) `Hspec.shouldBe` Just Constant.applicationXSentryEnvelope      Hspec.it "sets the user agent" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       lookup Http.hUserAgent (Client.requestHeaders request) `Hspec.shouldBe` Just (Text.encodeUtf8 Constant.userAgent)      Hspec.it "sets the authorization" $ do       dsn <- Dsn.fromText "http://key@sentry.test/1"-      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      let envelope = Envelope.fromEvent dsn Event.empty       request <- Envelope.intoRequest dsn envelope       lookup Constant.xSentryAuth (Client.requestHeaders request) `Hspec.shouldBe` Just (Dsn.intoAuthorization dsn)

@@ -1,8 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+-- In the use of ‘intoRequest’ (imported from Patrol.Type.Event)+{-# OPTIONS_GHC -Wno-deprecations #-}  module Patrol.Type.EventSpec where +import qualified Control.Exception as Catch import qualified Data.Aeson as Aeson import qualified Data.Aeson.QQ.Simple as Aeson import qualified Data.ByteString.Lazy as LazyByteString@@ -273,35 +276,35 @@       request <- Event.intoRequest dsn event       lookup Constant.xSentryAuth (Client.requestHeaders request) `Hspec.shouldSatisfy` Maybe.isJust -  Hspec.describe "fromException" $ do+  Hspec.describe "fromSomeException" $ do     Hspec.it "sets the environment" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.environment event `Hspec.shouldBe` Text.pack "production"      Hspec.it "sets the event ID" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.eventId event `Hspec.shouldNotBe` EventId.empty      Hspec.it "sets the exception" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.exception event `Hspec.shouldSatisfy` Maybe.isJust      Hspec.it "sets the level" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.level event `Hspec.shouldBe` Just Level.Error      Hspec.it "sets the platform" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.platform event `Hspec.shouldBe` Just Platform.Haskell      Hspec.it "sets the timestamp" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.timestamp event `Hspec.shouldSatisfy` Maybe.isJust      Hspec.it "sets the type" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.type_ event `Hspec.shouldBe` Just EventType.Default      Hspec.it "sets the version" $ do-      event <- Event.fromException (const Nothing) $ userError ""+      event <- Event.fromSomeException . Catch.toException $ userError ""       Event.version event `Hspec.shouldBe` Constant.sentryVersion

@@ -2,11 +2,11 @@  module Patrol.Type.ExceptionSpec where +import qualified Control.Monad.Catch as Catch import qualified Data.Aeson as Aeson import qualified Data.Aeson.QQ.Simple as Aeson import qualified Data.Map as Map import qualified Data.Text as Text-import qualified GHC.Stack as Stack import qualified Patrol.Type.Exception as Exception import qualified Patrol.Type.Mechanism as Mechanism import qualified Patrol.Type.Stacktrace as Stacktrace@@ -52,16 +52,11 @@           json = [Aeson.aesonQQ| { "value": "example-value" } |]       Aeson.toJSON exception `Hspec.shouldBe` json -  Hspec.describe "fromException" $ do-    Hspec.it "sets the stacktrace" $ do-      let callStack = Stack.callStack-      let exception = Exception.fromException (const $ Just callStack) $ userError ""-      Exception.stacktrace exception `Hspec.shouldBe` Just (Stacktrace.fromCallStack callStack)-+  Hspec.describe "fromSomeException" $ do     Hspec.it "sets the type" $ do-      let exception = Exception.fromException (const Nothing) $ userError ""+      let exception = Exception.fromSomeException . Catch.toException $ userError ""       Exception.type_ exception `Hspec.shouldBe` Text.pack "IOException"      Hspec.it "sets the value" $ do-      let exception = Exception.fromException (const Nothing) $ userError "example-exception-value"+      let exception = Exception.fromSomeException . Catch.toException $ userError "example-exception-value"       Exception.value exception `Hspec.shouldBe` Text.pack "user error (example-exception-value)"

@@ -2,6 +2,7 @@  module Patrol.Type.ExceptionsSpec where +import qualified Control.Monad.Catch as Catch import qualified Data.Aeson as Aeson import qualified Data.Aeson.QQ.Simple as Aeson import qualified Data.Text as Text@@ -23,7 +24,7 @@           json = [Aeson.aesonQQ| { "values": [ { "type": "example-type" } ] } |]       Aeson.toJSON exceptions `Hspec.shouldBe` json -  Hspec.describe "fromException" $ do+  Hspec.describe "fromSomeException" $ do     Hspec.it "works" $ do-      let exceptions = Exceptions.fromException (const Nothing) $ userError ""+      let exceptions = Exceptions.fromSomeException . Catch.toException $ userError ""       Exceptions.values exceptions `Hspec.shouldNotSatisfy` null