diff --git a/patrol.cabal b/patrol.cabal --- a/patrol.cabal +++ b/patrol.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: patrol -version: 1.1.0.0 +version: 1.2.0.0 synopsis: Sentry SDK description: Patrol is a Sentry SDK. build-type: Simple @@ -99,6 +99,7 @@ Patrol.Type.GpuContext Patrol.Type.Headers Patrol.Type.Item + Patrol.Type.Items Patrol.Type.Level Patrol.Type.LogEntry Patrol.Type.MachException @@ -178,6 +179,7 @@ Patrol.Type.GpuContextSpec Patrol.Type.HeadersSpec Patrol.Type.ItemSpec + Patrol.Type.ItemsSpec Patrol.Type.LevelSpec Patrol.Type.LogEntrySpec Patrol.Type.MachExceptionSpec diff --git a/source/library/Patrol/Type/BreadcrumbType.hs b/source/library/Patrol/Type/BreadcrumbType.hs --- a/source/library/Patrol/Type/BreadcrumbType.hs +++ b/source/library/Patrol/Type/BreadcrumbType.hs @@ -2,14 +2,42 @@ import qualified Data.Aeson as Aeson +-- | data BreadcrumbType - = Default - | Http - | Navigation + = -- | A generic breadcrumb, typically a log message or something user-generated. + Default + | -- | A generic debug event, typically a log message. + Debug + | -- | An error that occurred before the exception that generates an + -- 'Patrol.Type.Event.Event'. + Error + | -- | A URL change in a web application, a UI transition on mobile or desktop, + -- or some other event with similar semantics. + Navigation + | -- | An HTTP request transmitted from your application. + Http + | -- | Information that helps identify the root cause of the issue or for whom + -- the error occurred. + Info + | -- | A query made to the application. + Query + | -- | A tracing event. + Transaction + | -- | A user interaction with the application's UI, synonymouos with 'User'. + UI + | -- | A user interaction with the application's UI, synonymous with 'UI'. + User deriving (Eq, Show) instance Aeson.ToJSON BreadcrumbType where toJSON breadcrumbType = Aeson.toJSON $ case breadcrumbType of Default -> "default" - Http -> "http" + Debug -> "debug" + Error -> "error" Navigation -> "navigation" + Http -> "http" + Info -> "info" + Query -> "query" + Transaction -> "transaction" + UI -> "ui" + User -> "user" diff --git a/source/library/Patrol/Type/Envelope.hs b/source/library/Patrol/Type/Envelope.hs --- a/source/library/Patrol/Type/Envelope.hs +++ b/source/library/Patrol/Type/Envelope.hs @@ -1,13 +1,9 @@ module Patrol.Type.Envelope where import qualified Control.Monad.Catch as Catch -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 Network.HTTP.Client as Client @@ -19,11 +15,12 @@ import qualified Patrol.Type.Event as Event import qualified Patrol.Type.Headers as Headers import qualified Patrol.Type.Item as Item +import qualified Patrol.Type.Items as Items -- | data Envelope = Envelope { headers :: Headers.Headers, - items :: [Item.Item] + items :: Items.Items } deriving (Eq, Show) @@ -31,14 +28,13 @@ 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] + Headers.empty + { Headers.eventId = Just $ Event.eventId event, + Headers.dsn = Just dsn, + Headers.sdk = Just ClientSdkInfo.patrol, + Headers.sentAt = Event.timestamp event + }, + items = Items.EnvelopeItems [Item.Event event] } intoRequest :: (Catch.MonadThrow m) => Dsn.Dsn -> Envelope -> m Client.Request @@ -77,4 +73,4 @@ serialize envelope = Headers.serialize (headers envelope) <> Builder.char7 '\n' - <> foldMap ((<> Builder.char7 '\n') . Item.serialize) (items envelope) + <> Items.serialize (items envelope) diff --git a/source/library/Patrol/Type/Headers.hs b/source/library/Patrol/Type/Headers.hs --- a/source/library/Patrol/Type/Headers.hs +++ b/source/library/Patrol/Type/Headers.hs @@ -2,26 +2,38 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Builder as Builder +import qualified Data.Time as Time +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo +import qualified Patrol.Type.Dsn as Dsn +import qualified Patrol.Type.EventId as EventId -- | -newtype Headers - = Headers Aeson.Object +data Headers = Headers + { eventId :: Maybe EventId.EventId, + dsn :: Maybe Dsn.Dsn, + sdk :: Maybe ClientSdkInfo.ClientSdkInfo, + sentAt :: Maybe Time.UTCTime + } 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 + toJSON headers = + Aeson.intoObject + [ Aeson.pair "event_id" $ eventId headers, + Aeson.pair "dsn" . fmap Dsn.intoUri $ dsn headers, + Aeson.pair "sdk" $ sdk headers, + Aeson.pair "sent_at" $ sentAt headers + ] empty :: Headers -empty = fromObject mempty +empty = + Headers + { eventId = Nothing, + dsn = Nothing, + sdk = Nothing, + sentAt = Nothing + } serialize :: Headers -> Builder.Builder serialize = Aeson.fromEncoding . Aeson.toEncoding diff --git a/source/library/Patrol/Type/Item.hs b/source/library/Patrol/Type/Item.hs --- a/source/library/Patrol/Type/Item.hs +++ b/source/library/Patrol/Type/Item.hs @@ -1,37 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} + 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 -- | -data Item = Item - { headers :: Headers.Headers, - payload :: ByteString.ByteString - } +data Item + = -- | An 'Patrol.Type.Event.Event' item. + -- + -- + Event Event.Event + | -- | A sentinel item used to filter raw envelopes. + Raw 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) +serialize item = case item of + Event event -> + let payload = LazyByteString.toStrict $ Aeson.encode event + headers = buildHeaders "event" (ByteString.length payload) + in headers <> Builder.char7 '\n' <> Builder.byteString payload + Raw -> mempty + where + buildHeaders :: Key.Key -> Int -> Builder.Builder + buildHeaders type_ length_ = + Aeson.fromEncoding $ + Aeson.pairs ("type" Aeson..= type_ <> "length" Aeson..= length_) diff --git a/source/library/Patrol/Type/Items.hs b/source/library/Patrol/Type/Items.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Items.hs @@ -0,0 +1,20 @@ +module Patrol.Type.Items where + +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Builder as Builder +import qualified Patrol.Type.Item as Item + +-- | The items contained in an 'Patrol.Type.Envelope.Envelope'. +-- +-- This is typically a list of 'Patrol.Type.Item.Item', but can also be a +-- binary blob of 'ByteString.ByteString'. +data Items + = EnvelopeItems [Item.Item] + | Raw ByteString.ByteString + deriving (Eq, Show) + +serialize :: Items -> Builder.Builder +serialize items = case items of + Raw buf -> Builder.byteString buf + EnvelopeItems envelopeItems -> + foldMap ((<> Builder.char7 '\n') . Item.serialize) envelopeItems diff --git a/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs b/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs --- a/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs +++ b/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs @@ -13,8 +13,29 @@ Hspec.it "works for Default" $ do Aeson.toJSON BreadcrumbType.Default `Hspec.shouldBe` [Aeson.aesonQQ| "default" |] - Hspec.it "works for Http" $ do - Aeson.toJSON BreadcrumbType.Http `Hspec.shouldBe` [Aeson.aesonQQ| "http" |] + Hspec.it "works for Debug" $ do + Aeson.toJSON BreadcrumbType.Debug `Hspec.shouldBe` [Aeson.aesonQQ| "debug" |] + Hspec.it "works for Error" $ do + Aeson.toJSON BreadcrumbType.Error `Hspec.shouldBe` [Aeson.aesonQQ| "error" |] + Hspec.it "works for Navigation" $ do Aeson.toJSON BreadcrumbType.Navigation `Hspec.shouldBe` [Aeson.aesonQQ| "navigation" |] + + Hspec.it "works for Http" $ do + Aeson.toJSON BreadcrumbType.Http `Hspec.shouldBe` [Aeson.aesonQQ| "http" |] + + Hspec.it "works for Info" $ do + Aeson.toJSON BreadcrumbType.Info `Hspec.shouldBe` [Aeson.aesonQQ| "info" |] + + Hspec.it "works for Query" $ do + Aeson.toJSON BreadcrumbType.Query `Hspec.shouldBe` [Aeson.aesonQQ| "query" |] + + Hspec.it "works for Transaction" $ do + Aeson.toJSON BreadcrumbType.Transaction `Hspec.shouldBe` [Aeson.aesonQQ| "transaction" |] + + Hspec.it "works for UI" $ do + Aeson.toJSON BreadcrumbType.UI `Hspec.shouldBe` [Aeson.aesonQQ| "ui" |] + + Hspec.it "works for User" $ do + Aeson.toJSON BreadcrumbType.User `Hspec.shouldBe` [Aeson.aesonQQ| "user" |] diff --git a/source/test-suite/Patrol/Type/EnvelopeSpec.hs b/source/test-suite/Patrol/Type/EnvelopeSpec.hs --- a/source/test-suite/Patrol/Type/EnvelopeSpec.hs +++ b/source/test-suite/Patrol/Type/EnvelopeSpec.hs @@ -2,21 +2,20 @@ 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.ClientSdkInfo as ClientSdkInfo 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.EventId as EventId import qualified Patrol.Type.Headers as Headers import qualified Patrol.Type.Item as Item -import qualified Patrol.Version as Version +import qualified Patrol.Type.Items as Items import qualified Test.Hspec as Hspec spec :: Hspec.Spec @@ -28,65 +27,50 @@ Envelope.serialize Envelope.Envelope { Envelope.headers = Headers.empty, - Envelope.items = [] + Envelope.items = Items.EnvelopeItems [] } actual `Hspec.shouldBe` "{}\n" - Hspec.it "works with one item" $ do + Hspec.it "works with 'Items.Raw'" $ 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" - } - ] + { Envelope.headers = Headers.empty, + Envelope.items = Items.Raw "" } - actual `Hspec.shouldBe` "{\"a\":false}\n{\"b\":true}\nc\n" + actual `Hspec.shouldBe` "{}\n" - Hspec.it "works with two items" $ do + Hspec.it "works with 'Items.EnvelopeItems'" $ 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" - } - ] + { Envelope.headers = Headers.empty, + Envelope.items = Items.EnvelopeItems [Item.Event Event.empty] } - actual `Hspec.shouldBe` "{\"a\":1}\n{\"b\":2}\nc\n{\"d\":3}\ne\n" + actual `Hspec.shouldBe` "{}\n{\"type\":\"event\",\"length\":47}\n{\"event_id\":\"00000000000000000000000000000000\"}\n" Hspec.describe "fromEvent" $ do Hspec.it "sets the header" $ do dsn <- Dsn.fromText "http://key@sentry.test/1" let envelope = Envelope.fromEvent dsn Event.empty 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 - ] - ) - ] + Headers.Headers + { Headers.eventId = Just EventId.empty, + Headers.dsn = Just dsn, + Headers.sdk = Just ClientSdkInfo.patrol, + Headers.sentAt = Event.timestamp Event.empty + } Envelope.headers envelope `Hspec.shouldBe` expected Hspec.it "sets the items" $ do dsn <- Dsn.fromText "http://key@sentry.test/1" let envelope = Envelope.fromEvent dsn Event.empty - Envelope.items envelope `Hspec.shouldNotSatisfy` null + case Envelope.items envelope of + Items.EnvelopeItems items -> + items `Hspec.shouldBe` [Item.Event Event.empty] + other -> Hspec.expectationFailure $ "expected an envelope containing an event, got: " <> show other Hspec.describe "intoRequest" $ do Hspec.it "sets the method" $ do diff --git a/source/test-suite/Patrol/Type/HeadersSpec.hs b/source/test-suite/Patrol/Type/HeadersSpec.hs --- a/source/test-suite/Patrol/Type/HeadersSpec.hs +++ b/source/test-suite/Patrol/Type/HeadersSpec.hs @@ -2,39 +2,50 @@ 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 Data.Text as Text +import qualified Data.Time as Time +import qualified Data.UUID as Uuid +import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo +import qualified Patrol.Type.Dsn as Dsn +import qualified Patrol.Type.EventId as EventId 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 + Hspec.it "works with empty Headers" $ do let actual = Builder.toLazyByteString $ Headers.serialize Headers.empty actual `Hspec.shouldBe` "{}" - Hspec.it "works with a singleton object" $ do + Hspec.it "works with an EventId" $ do let actual = Builder.toLazyByteString . Headers.serialize - . Headers.fromObject - $ KeyMap.singleton "k" Aeson.Null - actual `Hspec.shouldBe` "{\"k\":null}" + $ Headers.empty {Headers.eventId = Just $ EventId.fromUuid Uuid.nil} + actual `Hspec.shouldBe` "{\"event_id\":\"00000000000000000000000000000000\"}" - Hspec.it "works with a non-empty object" $ do + Hspec.it "works with a DSN" $ do + dsn <- Dsn.fromText (Text.pack "a://b@c/d") 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}" + $ Headers.empty {Headers.dsn = Just dsn} + actual `Hspec.shouldBe` "{\"dsn\":\"a://b@c/d\"}" - Hspec.it "escapes newlines" $ do + Hspec.it "works with ClientSdkInfo" $ do + let clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.name = "patrol"} let actual = Builder.toLazyByteString . Headers.serialize - . Headers.fromObject - $ KeyMap.singleton "k" "\n" - actual `Hspec.shouldBe` "{\"k\":\"\\n\"}" + $ Headers.empty {Headers.sdk = Just clientSdkInfo} + actual `Hspec.shouldBe` "{\"sdk\":{\"name\":\"patrol\"}}" + + Hspec.it "works with a 'sentAt' timestamp" $ do + let timestamp = Time.UTCTime (Time.fromGregorian 1970 1 1) 0 + let actual = + Builder.toLazyByteString + . Headers.serialize + $ Headers.empty {Headers.sentAt = Just timestamp} + actual `Hspec.shouldBe` "{\"sent_at\":\"1970-01-01T00:00:00Z\"}" diff --git a/source/test-suite/Patrol/Type/ItemSpec.hs b/source/test-suite/Patrol/Type/ItemSpec.hs --- a/source/test-suite/Patrol/Type/ItemSpec.hs +++ b/source/test-suite/Patrol/Type/ItemSpec.hs @@ -2,70 +2,21 @@ 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 Data.ByteString.Lazy as LazyByteString 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 - -- - -- If no `length` is specified, the payload implicitly goes to the next - -- newline. For payloads containing newline characters, the `length` must - -- be specified. + Hspec.it "works on Event" $ do 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 + LazyByteString.toStrict + . Builder.toLazyByteString + . Item.serialize + $ Item.Event Event.empty + let expected = "{\"type\":\"event\",\"length\":47}\n{\"event_id\":\"00000000000000000000000000000000\"}" :: ByteString.ByteString + actual `Hspec.shouldBe` expected diff --git a/source/test-suite/Patrol/Type/ItemsSpec.hs b/source/test-suite/Patrol/Type/ItemsSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ItemsSpec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Patrol.Type.ItemsSpec where + +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.Item as Item +import qualified Patrol.Type.Items as Items +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Items" $ do + Hspec.describe "serialize" $ do + Hspec.it "works on a raw binary blob" $ do + let actual = + LazyByteString.toStrict + . Builder.toLazyByteString + . Items.serialize + $ Items.Raw "test" + actual `Hspec.shouldBe` "test" + + Hspec.it "works with a single Event" $ do + let actual = + LazyByteString.toStrict + . Builder.toLazyByteString + . Items.serialize + $ Items.EnvelopeItems [Item.Event Event.empty] + actual `Hspec.shouldBe` "{\"type\":\"event\",\"length\":47}\n{\"event_id\":\"00000000000000000000000000000000\"}\n" diff --git a/source/test-suite/PatrolSpec.hs b/source/test-suite/PatrolSpec.hs --- a/source/test-suite/PatrolSpec.hs +++ b/source/test-suite/PatrolSpec.hs @@ -31,6 +31,7 @@ import qualified Patrol.Type.GpuContextSpec import qualified Patrol.Type.HeadersSpec import qualified Patrol.Type.ItemSpec +import qualified Patrol.Type.ItemsSpec import qualified Patrol.Type.LevelSpec import qualified Patrol.Type.LogEntrySpec import qualified Patrol.Type.MachExceptionSpec @@ -79,6 +80,7 @@ Patrol.Type.EnvelopeSpec.spec Patrol.Type.HeadersSpec.spec Patrol.Type.ItemSpec.spec + Patrol.Type.ItemsSpec.spec Patrol.Type.ErrorTypeSpec.spec Patrol.Type.EventIdSpec.spec Patrol.Type.EventProcessingErrorSpec.spec