patrol 1.0.0.11 → 1.0.1.0

raw patch · 22 files changed

+655/−34 lines, 22 filesdep +http-client-tlsdep ~aesondep ~basedep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-client-tls

Dependency ranges changed: aeson, base, bytestring, case-insensitive, exceptions, network-uri

API changes (from Hackage documentation)

Files

• patrol.cabal +13/−7
• source/library/Patrol.hs +10/−1
• source/library/Patrol/Client.hs +40/−0
• source/library/Patrol/Constant.hs +3/−0
• source/library/Patrol/Type/ClientSdkInfo.hs +8/−0
• source/library/Patrol/Type/Dsn.hs +5/−0
• source/library/Patrol/Type/Envelope.hs +92/−0
• source/library/Patrol/Type/Event.hs +34/−10
• source/library/Patrol/Type/Exception.hs +9/−3
• source/library/Patrol/Type/Exceptions.hs +12/−0
• source/library/Patrol/Type/Headers.hs +27/−0
• source/library/Patrol/Type/Item.hs +37/−0
• source/test-suite/Patrol/ConstantSpec.hs +4/−0
• source/test-suite/Patrol/Type/ClientSdkInfoSpec.hs +7/−0
• source/test-suite/Patrol/Type/DsnSpec.hs +31/−0
• source/test-suite/Patrol/Type/EnvelopeSpec.hs +150/−0
• source/test-suite/Patrol/Type/EventSpec.hs +43/−10
• source/test-suite/Patrol/Type/ExceptionSpec.hs +8/−3
• source/test-suite/Patrol/Type/ExceptionsSpec.hs +5/−0
• source/test-suite/Patrol/Type/HeadersSpec.hs +40/−0
• source/test-suite/Patrol/Type/ItemSpec.hs +71/−0
• source/test-suite/PatrolSpec.hs +6/−0

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: patrol-version: 1.0.0.11+version: 1.0.1.0 synopsis: Sentry SDK description: Patrol is a Sentry SDK. build-type: Simple@@ -22,7 +22,7 @@   manual: True  common library-  build-depends: base ^>=4.19.0.0 || ^>=4.20.0.0 || ^>=4.21.0.0+  build-depends: base ^>=4.19 || ^>=4.20 || ^>=4.21   default-language: Haskell2010   ghc-options:     -Weverything@@ -51,14 +51,15 @@   import: library   autogen-modules: Paths_patrol   build-depends:-    aeson ^>=2.1.2.1 || ^>=2.2.2.0,-    bytestring ^>=0.11.4.0 || ^>=0.12.0.2,-    case-insensitive ^>=1.2.1.0,+    aeson ^>=2.1.2.1 || ^>=2.2.2,+    bytestring ^>=0.11.4 || ^>=0.12.0.2,+    case-insensitive ^>=1.2.1,     containers ^>=0.6.7 || ^>=0.7,     exceptions ^>=0.10.7,     http-client ^>=0.7.17,+    http-client-tls ^>=0.3.6.4,     http-types ^>=0.12.4,-    network-uri ^>=2.6.4.2 || ^>=2.7.0.0,+    network-uri ^>=2.6.4.2 || ^>=2.7,     text ^>=2.0.2 || ^>=2.1,     time ^>=1.12.2 || ^>=1.14,     uuid ^>=1.3.15,@@ -85,6 +86,7 @@     Patrol.Type.DebugMeta     Patrol.Type.DeviceContext     Patrol.Type.Dsn+    Patrol.Type.Envelope     Patrol.Type.ErrorType     Patrol.Type.Event     Patrol.Type.EventId@@ -95,6 +97,8 @@     Patrol.Type.Frame     Patrol.Type.Geo     Patrol.Type.GpuContext+    Patrol.Type.Headers+    Patrol.Type.Item     Patrol.Type.Level     Patrol.Type.LogEntry     Patrol.Type.MachException@@ -130,7 +134,6 @@     bytestring,     case-insensitive,     containers,-    exceptions,     hspec ^>=2.11.8,     http-client,     http-types,@@ -161,6 +164,7 @@     Patrol.Type.DebugMetaSpec     Patrol.Type.DeviceContextSpec     Patrol.Type.DsnSpec+    Patrol.Type.EnvelopeSpec     Patrol.Type.ErrorTypeSpec     Patrol.Type.EventIdSpec     Patrol.Type.EventProcessingErrorSpec@@ -171,6 +175,8 @@     Patrol.Type.FrameSpec     Patrol.Type.GeoSpec     Patrol.Type.GpuContextSpec+    Patrol.Type.HeadersSpec+    Patrol.Type.ItemSpec     Patrol.Type.LevelSpec     Patrol.Type.LogEntrySpec     Patrol.Type.MachExceptionSpec

@@ -1,5 +1,7 @@ module Patrol-  ( Patrol.Exception.Problem.Problem,+  ( Patrol.Client.captureException,+    Patrol.Client.captureExceptionWith,+    Patrol.Exception.Problem.Problem,     Patrol.Type.AppContext.AppContext,     Patrol.Type.AppleDebugImage.AppleDebugImage,     Patrol.Type.Breadcrumb.Breadcrumb,@@ -14,7 +16,10 @@     Patrol.Type.DebugMeta.DebugMeta,     Patrol.Type.DeviceContext.DeviceContext,     Patrol.Type.Dsn.Dsn,+    Patrol.Type.Envelope.Envelope,     Patrol.Type.ErrorType.ErrorType,+    Patrol.Type.Headers.Headers,+    Patrol.Type.Item.Item,     Patrol.Type.Event.Event,     Patrol.Type.EventId.EventId,     Patrol.Type.EventProcessingError.EventProcessingError,@@ -50,6 +55,7 @@   ) where +import qualified Patrol.Client import qualified Patrol.Exception.Problem import qualified Patrol.Type.AppContext import qualified Patrol.Type.AppleDebugImage@@ -65,6 +71,7 @@ import qualified Patrol.Type.DebugMeta import qualified Patrol.Type.DeviceContext import qualified Patrol.Type.Dsn+import qualified Patrol.Type.Envelope import qualified Patrol.Type.ErrorType import qualified Patrol.Type.Event import qualified Patrol.Type.EventId@@ -75,6 +82,8 @@ import qualified Patrol.Type.Frame import qualified Patrol.Type.Geo import qualified Patrol.Type.GpuContext+import qualified Patrol.Type.Headers+import qualified Patrol.Type.Item import qualified Patrol.Type.Level import qualified Patrol.Type.LogEntry import qualified Patrol.Type.MachException

@@ -3,12 +3,52 @@ 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 import qualified Patrol.Type.Dsn as Dsn+import qualified Patrol.Type.Envelope as Envelope import qualified Patrol.Type.Event as Event import qualified Patrol.Type.Response as Response+import qualified System.Environment as Environment +-- | Capture an exception by sending it to Sentry. The DSN is read from the+-- @SENTRY_DSN@ environment variable. To customize the behavior, use+-- 'captureExceptionWith'.+captureException ::+  (Catch.Exception e, IO.MonadIO io, Catch.MonadThrow io) =>+  e ->+  io Response.Response+captureException e = do+  dsn <- do+    maybeString <- IO.liftIO $ Environment.lookupEnv "SENTRY_DSN"+    Dsn.fromText $ maybe Text.empty Text.pack maybeString+  captureExceptionWith (const Nothing) 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) ->+  Dsn.Dsn ->+  e ->+  io Response.Response+captureExceptionWith getCallStack modifyEnvelope dsn e = do+  initialEnvelope <- Envelope.fromException getCallStack dsn e+  envelope <- modifyEnvelope initialEnvelope+  request <- Envelope.intoRequest dsn envelope+  manager <- Tls.newTlsManager+  response <- IO.liftIO $ Client.httpLbs request manager+  either (Catch.throwM . Problem.Problem . mappend "invalid response body: ") pure+    . Aeson.eitherDecode+    $ Client.responseBody response++-- TODO: Deprecate. store ::   (IO.MonadIO io, Catch.MonadThrow io) =>   Client.Manager ->

@@ -10,6 +10,9 @@ applicationJson :: ByteString.ByteString applicationJson = Text.encodeUtf8 $ Text.pack "application/json" +applicationXSentryEnvelope :: ByteString.ByteString+applicationXSentryEnvelope = Text.encodeUtf8 $ Text.pack "application/x-sentry-envelope"+ sentryVersion :: Text.Text sentryVersion = Text.singleton '7' 

@@ -4,6 +4,7 @@ import qualified Data.Text as Text import qualified Patrol.Extra.Aeson as Aeson import qualified Patrol.Type.ClientSdkPackage as ClientSdkPackage+import qualified Patrol.Version as Version  -- | <https://develop.sentry.dev/sdk/event-payloads/types/#clientsdkinfo> data ClientSdkInfo = ClientSdkInfo@@ -30,4 +31,11 @@       name = Text.empty,       packages = [],       version = Text.empty+    }++patrol :: ClientSdkInfo+patrol =+  empty+    { name = Text.pack "patrol",+      version = Version.text     }

@@ -23,6 +23,11 @@   }   deriving (Eq, Show) +fromText :: (Catch.MonadThrow m) => Text.Text -> m Dsn+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

@@ -0,0 +1,92 @@+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+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as LazyByteString+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+import qualified Patrol.Extra.List as List+import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo+import qualified Patrol.Type.Dsn as Dsn+import qualified Patrol.Type.Event as Event+import qualified Patrol.Type.Headers as Headers+import qualified Patrol.Type.Item as Item++-- | <https://develop.sentry.dev/sdk/data-model/envelopes/>+data Envelope = Envelope+  { headers :: Headers.Headers,+    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 =+  Envelope+    { headers =+        Headers.fromObject+          . KeyMap.fromList+          $ Maybe.catMaybes+            [ Just (Key.fromString "dsn", Aeson.toJSON $ Dsn.intoUri dsn),+              Just (Key.fromString "sdk", Aeson.toJSON ClientSdkInfo.patrol),+              (,) (Key.fromString "sent_at") . Aeson.toJSON <$> Event.timestamp event+            ],+      items = [Item.fromEvent event]+    }++intoRequest :: (Catch.MonadThrow m) => Dsn.Dsn -> Envelope -> m Client.Request+intoRequest dsn envelope = do+  request <-+    Client.parseUrlThrow $+      mconcat+        [ Text.unpack $ Dsn.protocol dsn,+          "://",+          Text.unpack $ Dsn.host dsn,+          maybe "" ((':' :) . show) $ Dsn.port dsn,+          Text.unpack $ Dsn.path dsn,+          "api/",+          Text.unpack $ Dsn.projectId dsn,+          "/envelope/"+        ]+  let body =+        LazyByteString.toStrict+          . Builder.toLazyByteString+          $ serialize envelope+  pure+    request+      { Client.method = Http.methodPost,+        Client.requestHeaders =+          List.insertAll+            [ (Http.hContentLength, Encoding.encodeUtf8 . Text.pack . show $ ByteString.length body),+              (Http.hContentType, Constant.applicationXSentryEnvelope),+              (Http.hUserAgent, Encoding.encodeUtf8 Constant.userAgent),+              (Constant.xSentryAuth, Dsn.intoAuthorization dsn)+            ]+            $ Client.requestHeaders request,+        Client.requestBody = Client.RequestBodyBS body+      }++serialize :: Envelope -> Builder.Builder+serialize envelope =+  Headers.serialize (headers envelope)+    <> Builder.char7 '\n'+    <> foldMap ((<> Builder.char7 '\n') . Item.serialize) (items envelope)

@@ -8,6 +8,7 @@ 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@@ -129,21 +130,44 @@       version = Text.empty     } -new :: (IO.MonadIO io) => io Event-new = do+initial :: Event+initial =+  empty+    { environment = Text.pack "production",+      level = Just Level.Error,+      platform = Just Platform.Haskell,+      type_ = Just EventType.Default,+      version = Constant.sentryVersion+    }++setEventId :: (IO.MonadIO io) => Event -> io Event+setEventId event = do   theEventId <- EventId.random+  pure event {eventId = theEventId}++setTimestamp :: (IO.MonadIO io) => Event -> io Event+setTimestamp event = do   theTimestamp <- IO.liftIO Time.getCurrentTime+  pure event {timestamp = Just theTimestamp}++new :: (IO.MonadIO io) => io Event+new = do+  withEventId <- setEventId initial+  setTimestamp withEventId++fromException ::+  (Catch.Exception e, IO.MonadIO io) =>+  (Catch.SomeException -> Maybe Stack.CallStack) ->+  e ->+  io Event+fromException getCallStack e = do+  event <- new   pure-    empty-      { environment = Text.pack "production",-        eventId = theEventId,-        level = Just Level.Error,-        platform = Just Platform.Haskell,-        timestamp = Just theTimestamp,-        type_ = Just EventType.Default,-        version = Constant.sentryVersion+    event+      { exception = Just $ Exceptions.fromException getCallStack e       } +-- TODO: Deprecate. intoRequest :: (Catch.MonadThrow m) => Dsn.Dsn -> Event -> m Client.Request intoRequest dsn event = do   theRequest <-

@@ -4,6 +4,7 @@ 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@@ -41,9 +42,14 @@       value = Text.empty     } -fromSomeException :: Catch.SomeException -> Exception-fromSomeException (Catch.SomeException e) =+fromException ::+  (Catch.Exception e) =>+  (Catch.SomeException -> Maybe Stack.CallStack) ->+  e ->+  Exception+fromException getCallStack e =   empty-    { type_ = Text.pack . show $ Typeable.typeOf e,+    { stacktrace = fmap Stacktrace.fromCallStack . getCallStack $ Catch.toException e,+      type_ = Text.pack . show $ Typeable.typeOf e,       value = Text.pack $ Catch.displayException e     }

@@ -1,6 +1,8 @@ module Patrol.Type.Exceptions where +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 @@ -20,4 +22,14 @@ empty =   Exceptions     { values = []+    }++fromException ::+  (Catch.Exception e) =>+  (Catch.SomeException -> Maybe Stack.CallStack) ->+  e ->+  Exceptions+fromException getCallStack e =+  Exceptions+    { values = [Exception.fromException getCallStack e]     }

@@ -0,0 +1,27 @@+module Patrol.Type.Headers where++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Builder as Builder++-- | <https://develop.sentry.dev/sdk/data-model/envelopes/#headers>+newtype Headers+  = Headers Aeson.Object+  deriving (Eq, Show)++instance Aeson.FromJSON Headers where+  parseJSON = fmap fromObject . Aeson.parseJSON++instance Aeson.ToJSON Headers where+  toJSON = Aeson.Object . intoObject++fromObject :: Aeson.Object -> Headers+fromObject = Headers++intoObject :: Headers -> Aeson.Object+intoObject (Headers object) = object++empty :: Headers+empty = fromObject mempty++serialize :: Headers -> Builder.Builder+serialize = Aeson.fromEncoding . Aeson.toEncoding

@@ -0,0 +1,37 @@+module Patrol.Type.Item where++import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Patrol.Type.Event as Event+import qualified Patrol.Type.Headers as Headers++-- | <https://develop.sentry.dev/sdk/data-model/envelope-items/>+data Item = Item+  { headers :: Headers.Headers,+    payload :: ByteString.ByteString+  }+  deriving (Eq, Show)++fromEvent :: Event.Event -> Item+fromEvent event =+  let thePayload = LazyByteString.toStrict $ Aeson.encode event+   in Item+        { headers =+            Headers.fromObject $+              KeyMap.fromList+                [ (Key.fromString "type", Aeson.toJSON "event"),+                  (Key.fromString "length", Aeson.toJSON $ ByteString.length thePayload),+                  (Key.fromString "event_id", Aeson.toJSON $ Event.eventId event)+                ],+          payload = thePayload+        }++serialize :: Item -> Builder.Builder+serialize item =+  Headers.serialize (headers item)+    <> Builder.char7 '\n'+    <> Builder.byteString (payload item)

@@ -12,6 +12,10 @@     Hspec.it "is correct" $ do       Constant.applicationJson `Hspec.shouldBe` Text.encodeUtf8 (Text.pack "application/json") +  Hspec.describe "applicationXSentryEnvelope" $ do+    Hspec.it "is correct" $ do+      Constant.applicationXSentryEnvelope `Hspec.shouldBe` Text.encodeUtf8 (Text.pack "application/x-sentry-envelope")+   Hspec.describe "sentryVersion" $ do     Hspec.it "is correct" $ do       Constant.sentryVersion `Hspec.shouldBe` Text.singleton '7'

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  module Patrol.Type.ClientSdkInfoSpec where@@ -5,6 +6,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.QQ.Simple as Aeson import qualified Data.Text as Text+import qualified Patrol.Constant as Constant import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo import qualified Patrol.Type.ClientSdkPackage as ClientSdkPackage import qualified Test.Hspec as Hspec@@ -37,3 +39,8 @@       let clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.version = Text.pack "example-version"}           json = [Aeson.aesonQQ| { "version": "example-version" } |]       Aeson.toJSON clientSdkInfo `Hspec.shouldBe` json++  Hspec.describe "patrol" $ do+    Hspec.it "agrees with the user agent" $ do+      let actual = ClientSdkInfo.name ClientSdkInfo.patrol <> "/" <> ClientSdkInfo.version ClientSdkInfo.patrol+      actual `Hspec.shouldBe` Constant.userAgent

@@ -5,12 +5,43 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Network.URI.Static as Uri+import qualified Patrol.Exception.Problem as Problem import qualified Patrol.Type.Dsn as Dsn import qualified Patrol.Version as Version import qualified Test.Hspec as Hspec  spec :: Hspec.Spec spec = Hspec.describe "Patrol.Type.Dsn" $ do+  Hspec.describe "fromText" $ do+    Hspec.it "fails with an invalid DSN" $ do+      Dsn.fromText (Text.pack "a:") `Hspec.shouldThrow` (\(Problem.Problem _) -> True)++    Hspec.it "succeeds with a minimal DSN" $ do+      dsn <- Dsn.fromText (Text.pack "a://b@c/d")+      dsn+        `Hspec.shouldBe` Dsn.Dsn+          { Dsn.protocol = Text.singleton 'a',+            Dsn.publicKey = Text.singleton 'b',+            Dsn.secretKey = Text.empty,+            Dsn.host = Text.singleton 'c',+            Dsn.port = Nothing,+            Dsn.path = Text.singleton '/',+            Dsn.projectId = Text.singleton 'd'+          }++    Hspec.it "succeeds with a maximal DSN" $ do+      dsn <- Dsn.fromText (Text.pack "a://b:c@d:5/f/g")+      dsn+        `Hspec.shouldBe` Dsn.Dsn+          { Dsn.protocol = Text.singleton 'a',+            Dsn.publicKey = Text.singleton 'b',+            Dsn.secretKey = Text.singleton 'c',+            Dsn.host = Text.singleton 'd',+            Dsn.port = Just 5,+            Dsn.path = Text.pack "/f/",+            Dsn.projectId = Text.singleton 'g'+          }+   Hspec.describe "fromUri" $ do     Hspec.it "fails with an invalid DSN" $ do       Dsn.fromUri [Uri.uri|a:|] `Hspec.shouldBe` Nothing

@@ -0,0 +1,150 @@+{-# LANGUAGE OverloadedStrings #-}++module Patrol.Type.EnvelopeSpec where++import qualified Data.Aeson as Aeson+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.Text.Encoding as Text+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Types as Http+import qualified Patrol.Constant as Constant+import qualified Patrol.Extra.Aeson as Aeson+import qualified Patrol.Type.Dsn as Dsn+import qualified Patrol.Type.Envelope as Envelope+import qualified Patrol.Type.Event as Event+import qualified Patrol.Type.Headers as Headers+import qualified Patrol.Type.Item as Item+import qualified Patrol.Version as Version+import qualified Test.Hspec as Hspec++spec :: Hspec.Spec+spec = Hspec.describe "Patrol.Type.Envelope" $ do+  Hspec.describe "serialize" $ do+    Hspec.it "works with no items" $ do+      let actual =+            Builder.toLazyByteString $+              Envelope.serialize+                Envelope.Envelope+                  { Envelope.headers = Headers.empty,+                    Envelope.items = []+                  }+      actual `Hspec.shouldBe` "{}\n"++    Hspec.it "works with one item" $ do+      let actual =+            Builder.toLazyByteString $+              Envelope.serialize+                Envelope.Envelope+                  { Envelope.headers = Headers.fromObject . KeyMap.singleton "a" $ Aeson.toJSON False,+                    Envelope.items =+                      [ Item.Item+                          { Item.headers = Headers.fromObject . KeyMap.singleton "b" $ Aeson.toJSON True,+                            Item.payload = "c"+                          }+                      ]+                  }+      actual `Hspec.shouldBe` "{\"a\":false}\n{\"b\":true}\nc\n"++    Hspec.it "works with two items" $ do+      let actual =+            Builder.toLazyByteString $+              Envelope.serialize+                Envelope.Envelope+                  { Envelope.headers = Headers.fromObject . KeyMap.singleton "a" $ Aeson.toJSON (1 :: Int),+                    Envelope.items =+                      [ Item.Item+                          { Item.headers = Headers.fromObject . KeyMap.singleton "b" $ Aeson.toJSON (2 :: Int),+                            Item.payload = "c"+                          },+                        Item.Item+                          { Item.headers = Headers.fromObject . KeyMap.singleton "d" $ Aeson.toJSON (3 :: Int),+                            Item.payload = "e"+                          }+                      ]+                  }+      actual `Hspec.shouldBe` "{\"a\":1}\n{\"b\":2}\nc\n{\"d\":3}\ne\n"++  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 expected =+            Headers.fromObject $+              KeyMap.fromList+                [ ("dsn", "http://key@sentry.test/1"),+                  ( "sdk",+                    Aeson.object+                      [ Aeson.pair "name" ("patrol" :: String),+                        Aeson.pair "version" Version.version+                      ]+                  )+                ]+      Envelope.headers envelope `Hspec.shouldBe` expected++    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+      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 ""+      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 ""+      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 ""+      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 ""+      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 ""+      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 ""+      request <- Envelope.intoRequest dsn envelope+      actual <- case Client.requestBody request of+        Client.RequestBodyBS byteString -> pure byteString+        _ -> fail "unexpected request body"+      let expected = LazyByteString.toStrict . Builder.toLazyByteString $ Envelope.serialize envelope+      actual `Hspec.shouldBe` expected++    Hspec.it "sets the content type" $ do+      dsn <- Dsn.fromText "http://key@sentry.test/1"+      envelope <- Envelope.fromException (const Nothing) dsn $ userError ""+      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 ""+      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 ""+      request <- Envelope.intoRequest dsn envelope+      lookup Constant.xSentryAuth (Client.requestHeaders request) `Hspec.shouldBe` Just (Dsn.intoAuthorization dsn)

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}  module Patrol.Type.EventSpec where@@ -12,7 +13,6 @@ import qualified Data.Time as Time import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Types as Http-import qualified Network.URI.Static as Uri import qualified Patrol.Constant as Constant import qualified Patrol.Type.Breadcrumb as Breadcrumb import qualified Patrol.Type.Breadcrumbs as Breadcrumbs@@ -218,37 +218,37 @@    Hspec.describe "intoRequest" $ do     Hspec.it "sets the method" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       Client.method request `Hspec.shouldBe` Http.methodPost      Hspec.it "sets the host" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test:8080/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test:8080/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       Client.host request `Hspec.shouldBe` Text.encodeUtf8 (Text.pack "sentry.test")      Hspec.it "sets the port" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test:8080/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test:8080/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       Client.port request `Hspec.shouldBe` 8080      Hspec.it "sets the path" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       Client.path request `Hspec.shouldBe` Text.encodeUtf8 (Text.pack "/api/project-id/store/")      Hspec.it "handles a custom path" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/custom/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/custom/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       Client.path request `Hspec.shouldBe` Text.encodeUtf8 (Text.pack "/custom/api/project-id/store/")      Hspec.it "sets the body" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       case Client.requestBody request of@@ -256,19 +256,52 @@         _ -> fail "unexpected request body"      Hspec.it "sets the content type" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       lookup Http.hContentType (Client.requestHeaders request) `Hspec.shouldSatisfy` Maybe.isJust      Hspec.it "sets the user agent" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       lookup Http.hUserAgent (Client.requestHeaders request) `Hspec.shouldSatisfy` Maybe.isJust      Hspec.it "sets the authorization" $ do-      dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|http://public-key@sentry.test/project-id|]+      dsn <- Dsn.fromText "http://public-key@sentry.test/project-id"       event <- Event.new       request <- Event.intoRequest dsn event       lookup Constant.xSentryAuth (Client.requestHeaders request) `Hspec.shouldSatisfy` Maybe.isJust++  Hspec.describe "fromException" $ do+    Hspec.it "sets the environment" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.environment event `Hspec.shouldBe` Text.pack "production"++    Hspec.it "sets the event ID" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.eventId event `Hspec.shouldNotBe` EventId.empty++    Hspec.it "sets the exception" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.exception event `Hspec.shouldSatisfy` Maybe.isJust++    Hspec.it "sets the level" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.level event `Hspec.shouldBe` Just Level.Error++    Hspec.it "sets the platform" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.platform event `Hspec.shouldBe` Just Platform.Haskell++    Hspec.it "sets the timestamp" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.timestamp event `Hspec.shouldSatisfy` Maybe.isJust++    Hspec.it "sets the type" $ do+      event <- Event.fromException (const Nothing) $ userError ""+      Event.type_ event `Hspec.shouldBe` Just EventType.Default++    Hspec.it "sets the version" $ do+      event <- Event.fromException (const Nothing) $ 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,11 +52,16 @@           json = [Aeson.aesonQQ| { "value": "example-value" } |]       Aeson.toJSON exception `Hspec.shouldBe` json -  Hspec.describe "fromSomeException" $ do-    let exception = Exception.fromSomeException . Catch.toException $ userError "example-exception-value"+  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.it "sets the type" $ do+      let exception = Exception.fromException (const Nothing) $ 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"       Exception.value exception `Hspec.shouldBe` Text.pack "user error (example-exception-value)"

@@ -22,3 +22,8 @@           exceptions = Exceptions.empty {Exceptions.values = [exception]}           json = [Aeson.aesonQQ| { "values": [ { "type": "example-type" } ] } |]       Aeson.toJSON exceptions `Hspec.shouldBe` json++  Hspec.describe "fromException" $ do+    Hspec.it "works" $ do+      let exceptions = Exceptions.fromException (const Nothing) $ userError ""+      Exceptions.values exceptions `Hspec.shouldNotSatisfy` null

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module Patrol.Type.HeadersSpec where++import qualified Data.Aeson as Aeson+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.ByteString.Builder as Builder+import qualified Patrol.Type.Headers as Headers+import qualified Test.Hspec as Hspec++spec :: Hspec.Spec+spec = Hspec.describe "Patrol.Type.Headers" $ do+  Hspec.describe "serialize" $ do+    Hspec.it "works with an empty object" $ do+      let actual = Builder.toLazyByteString $ Headers.serialize Headers.empty+      actual `Hspec.shouldBe` "{}"++    Hspec.it "works with a singleton object" $ do+      let actual =+            Builder.toLazyByteString+              . Headers.serialize+              . Headers.fromObject+              $ KeyMap.singleton "k" Aeson.Null+      actual `Hspec.shouldBe` "{\"k\":null}"++    Hspec.it "works with a non-empty object" $ do+      let actual =+            Builder.toLazyByteString+              . Headers.serialize+              . Headers.fromObject+              $ KeyMap.fromList [("a", Aeson.toJSON False), ("b", Aeson.toJSON True)]+      actual `Hspec.shouldBe` "{\"a\":false,\"b\":true}"++    Hspec.it "escapes newlines" $ do+      let actual =+            Builder.toLazyByteString+              . Headers.serialize+              . Headers.fromObject+              $ KeyMap.singleton "k" "\n"+      actual `Hspec.shouldBe` "{\"k\":\"\\n\"}"

@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++module Patrol.Type.ItemSpec where++import qualified Data.Aeson as Aeson+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder+import qualified Patrol.Type.Event as Event+import qualified Patrol.Type.Headers as Headers+import qualified Patrol.Type.Item as Item+import qualified Test.Hspec as Hspec++spec :: Hspec.Spec+spec = Hspec.describe "Patrol.Type.Item" $ do+  Hspec.describe "serialize" $ do+    Hspec.it "works with an empty payload" $ do+      let actual =+            Builder.toLazyByteString $+              Item.serialize+                Item.Item+                  { Item.headers = Headers.empty,+                    Item.payload = ""+                  }+      actual `Hspec.shouldBe` "{}\n"++    Hspec.it "works with a non-empty payload" $ do+      let actual =+            Builder.toLazyByteString $+              Item.serialize+                Item.Item+                  { Item.headers = Headers.empty,+                    Item.payload = "x"+                  }+      actual `Hspec.shouldBe` "{}\nx"++    Hspec.it "allows newlines in the payload" $ do+      -- <https://develop.sentry.dev/sdk/data-model/envelopes/#items>+      -- If no `length` is specified, the payload implicitly goes to the next+      -- newline. For payloads containing newline characters, the `length` must+      -- be specified.+      let actual =+            Builder.toLazyByteString $+              Item.serialize+                Item.Item+                  { Item.headers =+                      Headers.fromObject+                        . KeyMap.singleton "length"+                        $ Aeson.toJSON (3 :: Int),+                    Item.payload = "a\nb"+                  }+      actual `Hspec.shouldBe` "{\"length\":3}\na\nb"++  Hspec.describe "fromEvent" $ do+    Hspec.it "sets the headers" $ do+      let event = Event.empty+      let actual = Item.fromEvent event+      let expected =+            Headers.fromObject $+              KeyMap.fromList+                [ ("type", "event"),+                  ("length", Aeson.toJSON (47 :: Int)),+                  ("event_id", Aeson.toJSON $ Event.eventId event)+                ]+      Item.headers actual `Hspec.shouldBe` expected++    Hspec.it "sets the payload" $ do+      let event = Event.empty+      let actual = Item.fromEvent event+      let expected = "{\"event_id\":\"00000000000000000000000000000000\"}" :: ByteString.ByteString+      Item.payload actual `Hspec.shouldBe` expected

@@ -18,6 +18,7 @@ import qualified Patrol.Type.DebugMetaSpec import qualified Patrol.Type.DeviceContextSpec import qualified Patrol.Type.DsnSpec+import qualified Patrol.Type.EnvelopeSpec import qualified Patrol.Type.ErrorTypeSpec import qualified Patrol.Type.EventIdSpec import qualified Patrol.Type.EventProcessingErrorSpec@@ -28,6 +29,8 @@ import qualified Patrol.Type.FrameSpec import qualified Patrol.Type.GeoSpec import qualified Patrol.Type.GpuContextSpec+import qualified Patrol.Type.HeadersSpec+import qualified Patrol.Type.ItemSpec import qualified Patrol.Type.LevelSpec import qualified Patrol.Type.LogEntrySpec import qualified Patrol.Type.MachExceptionSpec@@ -73,6 +76,9 @@   Patrol.Type.DebugMetaSpec.spec   Patrol.Type.DeviceContextSpec.spec   Patrol.Type.DsnSpec.spec+  Patrol.Type.EnvelopeSpec.spec+  Patrol.Type.HeadersSpec.spec+  Patrol.Type.ItemSpec.spec   Patrol.Type.ErrorTypeSpec.spec   Patrol.Type.EventIdSpec.spec   Patrol.Type.EventProcessingErrorSpec.spec