diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,4 +1,4 @@ # Change log -Patrol uses [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +Patrol uses the [Package Versioning Policy](https://pvp.haskell.org). The change log is available through [the releases](https://github.com/tfausak/patrol/releases) on GitHub. diff --git a/LICENSE.markdown b/LICENSE.markdown deleted file mode 100644 --- a/LICENSE.markdown +++ /dev/null @@ -1,13 +0,0 @@ -Copyright 2022 Taylor Fausak - -Permission to use, copy, modify, and/or distribute this software for any -purpose with or without fee is hereby granted, provided that the above -copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH -REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, -INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM -LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR -OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR -PERFORMANCE OF THIS SOFTWARE. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2022 Taylor Fausak + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/patrol.cabal b/patrol.cabal --- a/patrol.cabal +++ b/patrol.cabal @@ -1,72 +1,184 @@ -cabal-version: 2.0 +cabal-version: 2.2 name: patrol -version: 0.0.4 +version: 0.1.0.1 synopsis: Sentry SDK description: Patrol is a Sentry SDK. build-type: Simple category: Exceptions -extra-source-files: - CHANGELOG.markdown - README.markdown -license-file: LICENSE.markdown -license: ISC +extra-source-files: CHANGELOG.markdown README.markdown +license-file: LICENSE.txt +license: MIT maintainer: Taylor Fausak source-repository head location: https://github.com/tfausak/patrol type: git -library - autogen-modules: Paths_patrol +flag pedantic + default: False + manual: True + +common library build-depends: - base >= 4.13.0 && < 4.17 - , aeson >= 1.4.6 && < 1.6 || >= 2.0.3 && < 2.2 - , bytestring >= 0.10.10 && < 0.12 + , aeson >= 2.1 && < 2.2 + , base >= 4.15 && < 4.18 + , bytestring >= 0.10.12 && < 0.12 , case-insensitive >= 1.2.1 && < 1.3 - , containers >= 0.6.2 && < 0.7 - , http-client >= 0.6.4 && < 0.8 + , containers >= 0.6.4 && < 0.7 + , exceptions >= 0.10.4 && < 0.11 + , http-client >= 0.7.13 && < 0.8 , http-types >= 0.12.3 && < 0.13 - , network-uri >= 2.6.2 && < 2.7 - , text >= 1.2.4 && < 1.3 || >= 2.0 && < 2.1 - , time >= 1.9.3 && < 1.12 - , uuid >= 1.3.13 && < 1.4 - default-extensions: NamedFieldPuns + , network-uri >= 2.6.4 && < 2.7 + , text >= 1.2.4 && < 1.3 || >= 2.0.1 && < 2.1 + , time >= 1.9.3 && < 1.13 + , uuid >= 1.3.15 && < 1.4 default-language: Haskell2010 + ghc-options: + -Weverything + -Wno-all-missed-specialisations + -Wno-implicit-prelude + -Wno-missed-specialisations + -Wno-missing-deriving-strategies + -Wno-missing-export-lists + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + -Wno-safe + -Wno-unsafe + + if impl(ghc >= 9.2) + ghc-options: -Wno-missing-kind-signatures + + if flag(pedantic) + ghc-options: -Werror + +common executable + import: library + + build-depends: patrol + ghc-options: -rtsopts -threaded + +library + import: library + + autogen-modules: Paths_patrol exposed-modules: Patrol Patrol.Client - Patrol.Utility.Json - Patrol.Utility.Maybe + Patrol.Constant + Patrol.Exception.Problem + Patrol.Extra.Aeson + Patrol.Extra.List + Patrol.Type.AppContext + Patrol.Type.AppleDebugImage + Patrol.Type.Breadcrumb + Patrol.Type.Breadcrumbs + Patrol.Type.BreadcrumbType + Patrol.Type.BrowserContext + Patrol.Type.CError + Patrol.Type.ClientSdkInfo + Patrol.Type.ClientSdkPackage + Patrol.Type.Context + Patrol.Type.DebugImage + Patrol.Type.DebugMeta + Patrol.Type.DeviceContext Patrol.Type.Dsn + Patrol.Type.ErrorType Patrol.Type.Event Patrol.Type.EventId + Patrol.Type.EventProcessingError + Patrol.Type.EventType Patrol.Type.Exception + Patrol.Type.Exceptions Patrol.Type.Frame + Patrol.Type.Geo + Patrol.Type.GpuContext Patrol.Type.Level + Patrol.Type.LogEntry + Patrol.Type.MachException + Patrol.Type.Mechanism + Patrol.Type.MechanismMeta + Patrol.Type.NativeDebugImage + Patrol.Type.NsError + Patrol.Type.OsContext Patrol.Type.Platform + Patrol.Type.PosixSignal + Patrol.Type.ProguardDebugImage Patrol.Type.Request Patrol.Type.Response - Patrol.Type.StackTrace - Patrol.Type.Timestamp + Patrol.Type.RuntimeContext + Patrol.Type.SpanStatus + Patrol.Type.Stacktrace + Patrol.Type.SystemSdkInfo + Patrol.Type.Thread + Patrol.Type.Threads + Patrol.Type.TraceContext + Patrol.Type.TransactionInfo + Patrol.Type.TransactionSource Patrol.Type.User - ghc-options: - -Weverything - -Wno-all-missed-specialisations - -Wno-implicit-prelude - -Wno-missing-deriving-strategies - -Wno-missing-exported-signatures - -Wno-safe - -Wno-unsafe - hs-source-dirs: src/lib + Patrol.Version + hs-source-dirs: source/library other-modules: Paths_patrol - if impl(ghc >= 8.10) - ghc-options: - -Wno-missing-safe-haskell-mode - -Wno-prepositive-qualified-module +test-suite patrol-test-suite + import: executable - if impl(ghc >= 9.2) - ghc-options: - -Wno-missing-kind-signatures + build-depends: + , hspec >= 2.10.6 && < 2.11 + hs-source-dirs: source/test-suite + main-is: Main.hs + other-modules: + Patrol.ClientSpec + Patrol.ConstantSpec + Patrol.Extra.AesonSpec + Patrol.Extra.ListSpec + Patrol.Type.AppContextSpec + Patrol.Type.AppleDebugImageSpec + Patrol.Type.BreadcrumbSpec + Patrol.Type.BreadcrumbsSpec + Patrol.Type.BreadcrumbTypeSpec + Patrol.Type.BrowserContextSpec + Patrol.Type.CErrorSpec + Patrol.Type.ClientSdkInfoSpec + Patrol.Type.ClientSdkPackageSpec + Patrol.Type.ContextSpec + Patrol.Type.DebugImageSpec + Patrol.Type.DebugMetaSpec + Patrol.Type.DeviceContextSpec + Patrol.Type.DsnSpec + Patrol.Type.ErrorTypeSpec + Patrol.Type.EventIdSpec + Patrol.Type.EventProcessingErrorSpec + Patrol.Type.EventSpec + Patrol.Type.EventTypeSpec + Patrol.Type.ExceptionSpec + Patrol.Type.ExceptionsSpec + Patrol.Type.FrameSpec + Patrol.Type.GeoSpec + Patrol.Type.GpuContextSpec + Patrol.Type.LevelSpec + Patrol.Type.LogEntrySpec + Patrol.Type.MachExceptionSpec + Patrol.Type.MechanismMetaSpec + Patrol.Type.MechanismSpec + Patrol.Type.NativeDebugImageSpec + Patrol.Type.NsErrorSpec + Patrol.Type.OsContextSpec + Patrol.Type.PlatformSpec + Patrol.Type.PosixSignalSpec + Patrol.Type.ProguardDebugImageSpec + Patrol.Type.RequestSpec + Patrol.Type.ResponseSpec + Patrol.Type.RuntimeContextSpec + Patrol.Type.SpanStatusSpec + Patrol.Type.StacktraceSpec + Patrol.Type.SystemSdkInfoSpec + Patrol.Type.ThreadSpec + Patrol.Type.ThreadsSpec + Patrol.Type.TraceContextSpec + Patrol.Type.TransactionInfoSpec + Patrol.Type.TransactionSourceSpec + Patrol.Type.UserSpec + PatrolSpec + type: exitcode-stdio-1.0 diff --git a/source/library/Patrol.hs b/source/library/Patrol.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol.hs @@ -0,0 +1,100 @@ +module Patrol + ( Patrol.Exception.Problem.Problem, + Patrol.Type.AppContext.AppContext, + Patrol.Type.AppleDebugImage.AppleDebugImage, + Patrol.Type.Breadcrumb.Breadcrumb, + Patrol.Type.Breadcrumbs.Breadcrumbs, + Patrol.Type.BreadcrumbType.BreadcrumbType, + Patrol.Type.BrowserContext.BrowserContext, + Patrol.Type.CError.CError, + Patrol.Type.ClientSdkInfo.ClientSdkInfo, + Patrol.Type.ClientSdkPackage.ClientSdkPackage, + Patrol.Type.Context.Context, + Patrol.Type.DebugImage.DebugImage, + Patrol.Type.DebugMeta.DebugMeta, + Patrol.Type.DeviceContext.DeviceContext, + Patrol.Type.Dsn.Dsn, + Patrol.Type.ErrorType.ErrorType, + Patrol.Type.Event.Event, + Patrol.Type.EventId.EventId, + Patrol.Type.EventProcessingError.EventProcessingError, + Patrol.Type.EventType.EventType, + Patrol.Type.Exception.Exception, + Patrol.Type.Exceptions.Exceptions, + Patrol.Type.Frame.Frame, + Patrol.Type.Geo.Geo, + Patrol.Type.GpuContext.GpuContext, + Patrol.Type.Level.Level, + Patrol.Type.LogEntry.LogEntry, + Patrol.Type.MachException.MachException, + Patrol.Type.Mechanism.Mechanism, + Patrol.Type.MechanismMeta.MechanismMeta, + Patrol.Type.NativeDebugImage.NativeDebugImage, + Patrol.Type.NsError.NsError, + Patrol.Type.OsContext.OsContext, + Patrol.Type.Platform.Platform, + Patrol.Type.PosixSignal.PosixSignal, + Patrol.Type.ProguardDebugImage.ProguardDebugImage, + Patrol.Type.Request.Request, + Patrol.Type.Response.Response, + Patrol.Type.RuntimeContext.RuntimeContext, + Patrol.Type.SpanStatus.SpanStatus, + Patrol.Type.Stacktrace.Stacktrace, + Patrol.Type.SystemSdkInfo.SystemSdkInfo, + Patrol.Type.Thread.Thread, + Patrol.Type.Threads.Threads, + Patrol.Type.TraceContext.TraceContext, + Patrol.Type.TransactionInfo.TransactionInfo, + Patrol.Type.TransactionSource.TransactionSource, + Patrol.Type.User.User, + ) +where + +import qualified Patrol.Exception.Problem +import qualified Patrol.Type.AppContext +import qualified Patrol.Type.AppleDebugImage +import qualified Patrol.Type.Breadcrumb +import qualified Patrol.Type.BreadcrumbType +import qualified Patrol.Type.Breadcrumbs +import qualified Patrol.Type.BrowserContext +import qualified Patrol.Type.CError +import qualified Patrol.Type.ClientSdkInfo +import qualified Patrol.Type.ClientSdkPackage +import qualified Patrol.Type.Context +import qualified Patrol.Type.DebugImage +import qualified Patrol.Type.DebugMeta +import qualified Patrol.Type.DeviceContext +import qualified Patrol.Type.Dsn +import qualified Patrol.Type.ErrorType +import qualified Patrol.Type.Event +import qualified Patrol.Type.EventId +import qualified Patrol.Type.EventProcessingError +import qualified Patrol.Type.EventType +import qualified Patrol.Type.Exception +import qualified Patrol.Type.Exceptions +import qualified Patrol.Type.Frame +import qualified Patrol.Type.Geo +import qualified Patrol.Type.GpuContext +import qualified Patrol.Type.Level +import qualified Patrol.Type.LogEntry +import qualified Patrol.Type.MachException +import qualified Patrol.Type.Mechanism +import qualified Patrol.Type.MechanismMeta +import qualified Patrol.Type.NativeDebugImage +import qualified Patrol.Type.NsError +import qualified Patrol.Type.OsContext +import qualified Patrol.Type.Platform +import qualified Patrol.Type.PosixSignal +import qualified Patrol.Type.ProguardDebugImage +import qualified Patrol.Type.Request +import qualified Patrol.Type.Response +import qualified Patrol.Type.RuntimeContext +import qualified Patrol.Type.SpanStatus +import qualified Patrol.Type.Stacktrace +import qualified Patrol.Type.SystemSdkInfo +import qualified Patrol.Type.Thread +import qualified Patrol.Type.Threads +import qualified Patrol.Type.TraceContext +import qualified Patrol.Type.TransactionInfo +import qualified Patrol.Type.TransactionSource +import qualified Patrol.Type.User diff --git a/source/library/Patrol/Client.hs b/source/library/Patrol/Client.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Client.hs @@ -0,0 +1,23 @@ +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 Network.HTTP.Client as Client +import qualified Patrol.Exception.Problem as Problem +import qualified Patrol.Type.Dsn as Dsn +import qualified Patrol.Type.Event as Event +import qualified Patrol.Type.Response as Response + +store :: + (IO.MonadIO io, Catch.MonadThrow io) => + Client.Manager -> + Dsn.Dsn -> + Event.Event -> + io Response.Response +store manager dsn event = do + request <- Event.intoRequest dsn event + response <- IO.liftIO $ Client.httpLbs request manager + either (Catch.throwM . Problem.Problem . mappend "invalid response body: ") pure + . Aeson.eitherDecode + $ Client.responseBody response diff --git a/source/library/Patrol/Constant.hs b/source/library/Patrol/Constant.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Constant.hs @@ -0,0 +1,20 @@ +module Patrol.Constant where + +import qualified Data.ByteString as ByteString +import qualified Data.CaseInsensitive as CI +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Network.HTTP.Types as Http +import qualified Patrol.Version as Version + +applicationJson :: ByteString.ByteString +applicationJson = Text.encodeUtf8 $ Text.pack "application/json" + +sentryVersion :: Text.Text +sentryVersion = Text.singleton '7' + +userAgent :: Text.Text +userAgent = Text.pack "patrol/" <> Version.text + +xSentryAuth :: Http.HeaderName +xSentryAuth = CI.mk . Text.encodeUtf8 $ Text.pack "X-Sentry-Auth" diff --git a/source/library/Patrol/Exception/Problem.hs b/source/library/Patrol/Exception/Problem.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Exception/Problem.hs @@ -0,0 +1,9 @@ +module Patrol.Exception.Problem where + +import qualified Control.Monad.Catch as Catch + +newtype Problem + = Problem String + deriving (Eq, Show) + +instance Catch.Exception Problem diff --git a/source/library/Patrol/Extra/Aeson.hs b/source/library/Patrol/Extra/Aeson.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Extra/Aeson.hs @@ -0,0 +1,20 @@ +module Patrol.Extra.Aeson where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.Types as Aeson +import qualified Data.Text as Text + +intoObject :: [Aeson.Pair] -> Aeson.Value +intoObject = Aeson.object . filter (not . isEmpty . snd) + +isEmpty :: Aeson.Value -> Bool +isEmpty value = case value of + Aeson.Array array -> null array + Aeson.Null -> True + Aeson.Object object -> null object + Aeson.String string -> Text.null string + _ -> False + +pair :: Aeson.ToJSON a => String -> a -> Aeson.Pair +pair = (Aeson..=) . Key.fromString diff --git a/source/library/Patrol/Extra/List.hs b/source/library/Patrol/Extra/List.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Extra/List.hs @@ -0,0 +1,16 @@ +module Patrol.Extra.List where + +import qualified Data.Function as Function + +insertAll :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)] +insertAll = flip $ foldr insert + +insert :: Eq k => (k, v) -> [(k, v)] -> [(k, v)] +insert = insertBy $ Function.on (==) fst + +insertBy :: (a -> a -> Bool) -> a -> [a] -> [a] +insertBy p x xs = case xs of + [] -> [x] + h : t + | p x h -> h : t + | otherwise -> h : insertBy p x t diff --git a/source/library/Patrol/Type/AppContext.hs b/source/library/Patrol/Type/AppContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/AppContext.hs @@ -0,0 +1,45 @@ +module Patrol.Type.AppContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data AppContext = AppContext + { appBuild :: Text.Text, + appIdentifier :: Text.Text, + appMemory :: Maybe Int, + appName :: Text.Text, + appStartTime :: Maybe Time.UTCTime, + appVersion :: Text.Text, + buildType :: Text.Text, + deviceAppHash :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON AppContext where + toJSON appContext = + Aeson.intoObject + [ Aeson.pair "app_build" $ appBuild appContext, + Aeson.pair "app_identifier" $ appIdentifier appContext, + Aeson.pair "app_memory" $ appMemory appContext, + Aeson.pair "app_name" $ appName appContext, + Aeson.pair "app_start_time" $ appStartTime appContext, + Aeson.pair "app_version" $ appVersion appContext, + Aeson.pair "build_type" $ buildType appContext, + Aeson.pair "device_app_hash" $ deviceAppHash appContext + ] + +empty :: AppContext +empty = + AppContext + { appBuild = Text.empty, + appIdentifier = Text.empty, + appMemory = Nothing, + appName = Text.empty, + appStartTime = Nothing, + appVersion = Text.empty, + buildType = Text.empty, + deviceAppHash = Text.empty + } diff --git a/source/library/Patrol/Type/AppleDebugImage.hs b/source/library/Patrol/Type/AppleDebugImage.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/AppleDebugImage.hs @@ -0,0 +1,44 @@ +module Patrol.Type.AppleDebugImage where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data AppleDebugImage = AppleDebugImage + { arch :: Text.Text, + cpuSubtype :: Maybe Int, + cpuType :: Maybe Int, + imageAddr :: Text.Text, + imageSize :: Maybe Int, + imageVmaddr :: Text.Text, + name :: Text.Text, + uuid :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON AppleDebugImage where + toJSON appleDebugImage = + Aeson.intoObject + [ Aeson.pair "arch" $ arch appleDebugImage, + Aeson.pair "cpu_subtype" $ cpuSubtype appleDebugImage, + Aeson.pair "cpu_type" $ cpuType appleDebugImage, + Aeson.pair "image_addr" $ imageAddr appleDebugImage, + Aeson.pair "image_size" $ imageSize appleDebugImage, + Aeson.pair "image_vmaddr" $ imageVmaddr appleDebugImage, + Aeson.pair "name" $ name appleDebugImage, + Aeson.pair "uuid" $ uuid appleDebugImage + ] + +empty :: AppleDebugImage +empty = + AppleDebugImage + { arch = Text.empty, + cpuSubtype = Nothing, + cpuType = Nothing, + imageAddr = Text.empty, + imageSize = Nothing, + imageVmaddr = Text.empty, + name = Text.empty, + uuid = Text.empty + } diff --git a/source/library/Patrol/Type/Breadcrumb.hs b/source/library/Patrol/Type/Breadcrumb.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Breadcrumb.hs @@ -0,0 +1,46 @@ +module Patrol.Type.Breadcrumb where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.BreadcrumbType as BreadcrumbType +import qualified Patrol.Type.EventId as EventId +import qualified Patrol.Type.Level as Level + +-- | +data Breadcrumb = Breadcrumb + { category :: Text.Text, + data_ :: Map.Map Text.Text Aeson.Value, + eventId :: Maybe EventId.EventId, + level :: Maybe Level.Level, + message :: Text.Text, + timestamp :: Maybe Time.UTCTime, + type_ :: Maybe BreadcrumbType.BreadcrumbType + } + deriving (Eq, Show) + +instance Aeson.ToJSON Breadcrumb where + toJSON breadcrumb = + Aeson.intoObject + [ Aeson.pair "category" $ category breadcrumb, + Aeson.pair "data" $ data_ breadcrumb, + Aeson.pair "event_id" $ eventId breadcrumb, + Aeson.pair "level" $ level breadcrumb, + Aeson.pair "message" $ message breadcrumb, + Aeson.pair "timestamp" $ timestamp breadcrumb, + Aeson.pair "type" $ type_ breadcrumb + ] + +empty :: Breadcrumb +empty = + Breadcrumb + { category = Text.empty, + data_ = Map.empty, + eventId = Nothing, + level = Nothing, + message = Text.empty, + timestamp = Nothing, + type_ = Nothing + } diff --git a/source/library/Patrol/Type/BreadcrumbType.hs b/source/library/Patrol/Type/BreadcrumbType.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/BreadcrumbType.hs @@ -0,0 +1,15 @@ +module Patrol.Type.BreadcrumbType where + +import qualified Data.Aeson as Aeson + +data BreadcrumbType + = Default + | Http + | Navigation + deriving (Eq, Show) + +instance Aeson.ToJSON BreadcrumbType where + toJSON breadcrumbType = Aeson.toJSON $ case breadcrumbType of + Default -> "default" + Http -> "http" + Navigation -> "navigation" diff --git a/source/library/Patrol/Type/Breadcrumbs.hs b/source/library/Patrol/Type/Breadcrumbs.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Breadcrumbs.hs @@ -0,0 +1,23 @@ +module Patrol.Type.Breadcrumbs where + +import qualified Data.Aeson as Aeson +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Breadcrumb as Breadcrumb + +-- | +newtype Breadcrumbs = Breadcrumbs + { values :: [Breadcrumb.Breadcrumb] + } + deriving (Eq, Show) + +instance Aeson.ToJSON Breadcrumbs where + toJSON breadcrumbs = + Aeson.intoObject + [ Aeson.pair "values" $ values breadcrumbs + ] + +empty :: Breadcrumbs +empty = + Breadcrumbs + { values = [] + } diff --git a/source/library/Patrol/Type/BrowserContext.hs b/source/library/Patrol/Type/BrowserContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/BrowserContext.hs @@ -0,0 +1,26 @@ +module Patrol.Type.BrowserContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data BrowserContext = BrowserContext + { name :: Text.Text, + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON BrowserContext where + toJSON browserContext = + Aeson.intoObject + [ Aeson.pair "name" $ name browserContext, + Aeson.pair "version" $ version browserContext + ] + +empty :: BrowserContext +empty = + BrowserContext + { name = Text.empty, + version = Text.empty + } diff --git a/source/library/Patrol/Type/CError.hs b/source/library/Patrol/Type/CError.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/CError.hs @@ -0,0 +1,26 @@ +module Patrol.Type.CError where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data CError = CError + { name :: Text.Text, + number :: Maybe Int + } + deriving (Eq, Show) + +instance Aeson.ToJSON CError where + toJSON cError = + Aeson.intoObject + [ Aeson.pair "name" $ name cError, + Aeson.pair "number" $ number cError + ] + +empty :: CError +empty = + CError + { name = Text.empty, + number = Nothing + } diff --git a/source/library/Patrol/Type/ClientSdkInfo.hs b/source/library/Patrol/Type/ClientSdkInfo.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/ClientSdkInfo.hs @@ -0,0 +1,33 @@ +module Patrol.Type.ClientSdkInfo where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.ClientSdkPackage as ClientSdkPackage + +-- | +data ClientSdkInfo = ClientSdkInfo + { integrations :: [Text.Text], + name :: Text.Text, + packages :: [ClientSdkPackage.ClientSdkPackage], + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON ClientSdkInfo where + toJSON clientSdkInfo = + Aeson.intoObject + [ Aeson.pair "integrations" $ integrations clientSdkInfo, + Aeson.pair "name" $ name clientSdkInfo, + Aeson.pair "packages" $ packages clientSdkInfo, + Aeson.pair "version" $ version clientSdkInfo + ] + +empty :: ClientSdkInfo +empty = + ClientSdkInfo + { integrations = [], + name = Text.empty, + packages = [], + version = Text.empty + } diff --git a/source/library/Patrol/Type/ClientSdkPackage.hs b/source/library/Patrol/Type/ClientSdkPackage.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/ClientSdkPackage.hs @@ -0,0 +1,26 @@ +module Patrol.Type.ClientSdkPackage where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data ClientSdkPackage = ClientSdkPackage + { name :: Text.Text, + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON ClientSdkPackage where + toJSON clientSdkPackage = + Aeson.intoObject + [ Aeson.pair "name" $ name clientSdkPackage, + Aeson.pair "version" $ version clientSdkPackage + ] + +empty :: ClientSdkPackage +empty = + ClientSdkPackage + { name = Text.empty, + version = Text.empty + } diff --git a/source/library/Patrol/Type/Context.hs b/source/library/Patrol/Type/Context.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Context.hs @@ -0,0 +1,34 @@ +module Patrol.Type.Context where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Patrol.Type.AppContext as AppContext +import qualified Patrol.Type.BrowserContext as BrowserContext +import qualified Patrol.Type.DeviceContext as DeviceContext +import qualified Patrol.Type.GpuContext as GpuContext +import qualified Patrol.Type.OsContext as OsContext +import qualified Patrol.Type.RuntimeContext as RuntimeContext +import qualified Patrol.Type.TraceContext as TraceContext + +data Context + = App AppContext.AppContext + | Browser BrowserContext.BrowserContext + | Device DeviceContext.DeviceContext + | Gpu GpuContext.GpuContext + | Os OsContext.OsContext + | Runtime RuntimeContext.RuntimeContext + | Trace TraceContext.TraceContext + | Other (Map.Map Text.Text Aeson.Value) + deriving (Eq, Show) + +instance Aeson.ToJSON Context where + toJSON context = case context of + App appContext -> Aeson.toJSON appContext + Browser browserContext -> Aeson.toJSON browserContext + Device deviceContext -> Aeson.toJSON deviceContext + Gpu gpuContext -> Aeson.toJSON gpuContext + Os osContext -> Aeson.toJSON osContext + Runtime runtimeContext -> Aeson.toJSON runtimeContext + Trace traceContext -> Aeson.toJSON traceContext + Other other -> Aeson.toJSON other diff --git a/source/library/Patrol/Type/DebugImage.hs b/source/library/Patrol/Type/DebugImage.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/DebugImage.hs @@ -0,0 +1,22 @@ +module Patrol.Type.DebugImage where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Patrol.Type.AppleDebugImage as AppleDebugImage +import qualified Patrol.Type.NativeDebugImage as NativeDebugImage +import qualified Patrol.Type.ProguardDebugImage as ProguardDebugImage + +data DebugImage + = Apple AppleDebugImage.AppleDebugImage + | Native NativeDebugImage.NativeDebugImage + | Proguard ProguardDebugImage.ProguardDebugImage + | Other (Map.Map Text.Text Aeson.Value) + deriving (Eq, Show) + +instance Aeson.ToJSON DebugImage where + toJSON debugImage = case debugImage of + Apple appleDebugImage -> Aeson.toJSON appleDebugImage + Native nativeDebugImage -> Aeson.toJSON nativeDebugImage + Proguard proguardDebugImage -> Aeson.toJSON proguardDebugImage + Other other -> Aeson.toJSON other diff --git a/source/library/Patrol/Type/DebugMeta.hs b/source/library/Patrol/Type/DebugMeta.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/DebugMeta.hs @@ -0,0 +1,27 @@ +module Patrol.Type.DebugMeta where + +import qualified Data.Aeson as Aeson +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.DebugImage as DebugImage +import qualified Patrol.Type.SystemSdkInfo as SystemSdkInfo + +-- | +data DebugMeta = DebugMeta + { images :: [DebugImage.DebugImage], + sdkInfo :: Maybe SystemSdkInfo.SystemSdkInfo + } + deriving (Eq, Show) + +instance Aeson.ToJSON DebugMeta where + toJSON debugMeta = + Aeson.intoObject + [ Aeson.pair "images" $ images debugMeta, + Aeson.pair "sdk_info" $ sdkInfo debugMeta + ] + +empty :: DebugMeta +empty = + DebugMeta + { images = [], + sdkInfo = Nothing + } diff --git a/source/library/Patrol/Type/DeviceContext.hs b/source/library/Patrol/Type/DeviceContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/DeviceContext.hs @@ -0,0 +1,129 @@ +module Patrol.Type.DeviceContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data DeviceContext = DeviceContext + { arch :: Text.Text, + batteryLevel :: Maybe Double, + batteryStatus :: Text.Text, + bootTime :: Maybe Time.UTCTime, + brand :: Text.Text, + charging :: Maybe Bool, + cpuDescription :: Text.Text, + deviceType :: Text.Text, + deviceUniqueIdentifier :: Text.Text, + externalFreeStorage :: Maybe Int, + externalStorageSize :: Maybe Int, + family :: Text.Text, + freeMemory :: Maybe Int, + freeStorage :: Maybe Int, + lowMemory :: Maybe Bool, + manufacturer :: Text.Text, + memorySize :: Maybe Int, + model :: Text.Text, + modelId :: Text.Text, + name :: Text.Text, + online :: Maybe Bool, + orientation :: Text.Text, + processorCount :: Maybe Int, + processorFrequency :: Maybe Double, + screenDensity :: Maybe Double, + screenDpi :: Maybe Double, + screenResolution :: Text.Text, + simulator :: Maybe Bool, + storageSize :: Maybe Int, + supportsAccelerometer :: Maybe Bool, + supportsAudio :: Maybe Bool, + supportsGyroscope :: Maybe Bool, + supportsLocationService :: Maybe Bool, + supportsVibration :: Maybe Bool, + timezone :: Text.Text, + usableMemory :: Maybe Int + } + deriving (Eq, Show) + +instance Aeson.ToJSON DeviceContext where + toJSON deviceContext = + Aeson.intoObject + [ Aeson.pair "arch" $ arch deviceContext, + Aeson.pair "battery_level" $ batteryLevel deviceContext, + Aeson.pair "battery_status" $ batteryStatus deviceContext, + Aeson.pair "boot_time" $ bootTime deviceContext, + Aeson.pair "brand" $ brand deviceContext, + Aeson.pair "charging" $ charging deviceContext, + Aeson.pair "cpu_description" $ cpuDescription deviceContext, + Aeson.pair "device_type" $ deviceType deviceContext, + Aeson.pair "device_unique_identifier" $ deviceUniqueIdentifier deviceContext, + Aeson.pair "external_free_storage" $ externalFreeStorage deviceContext, + Aeson.pair "external_storage_size" $ externalStorageSize deviceContext, + Aeson.pair "family" $ family deviceContext, + Aeson.pair "free_memory" $ freeMemory deviceContext, + Aeson.pair "free_storage" $ freeStorage deviceContext, + Aeson.pair "low_memory" $ lowMemory deviceContext, + Aeson.pair "manufacturer" $ manufacturer deviceContext, + Aeson.pair "memory_size" $ memorySize deviceContext, + Aeson.pair "model" $ model deviceContext, + Aeson.pair "model_id" $ modelId deviceContext, + Aeson.pair "name" $ name deviceContext, + Aeson.pair "online" $ online deviceContext, + Aeson.pair "orientation" $ orientation deviceContext, + Aeson.pair "processor_count" $ processorCount deviceContext, + Aeson.pair "processor_frequency" $ processorFrequency deviceContext, + Aeson.pair "screen_density" $ screenDensity deviceContext, + Aeson.pair "screen_dpi" $ screenDpi deviceContext, + Aeson.pair "screen_resolution" $ screenResolution deviceContext, + Aeson.pair "simulator" $ simulator deviceContext, + Aeson.pair "storage_size" $ storageSize deviceContext, + Aeson.pair "supports_accelerometer" $ supportsAccelerometer deviceContext, + Aeson.pair "supports_audio" $ supportsAudio deviceContext, + Aeson.pair "supports_gyroscope" $ supportsGyroscope deviceContext, + Aeson.pair "supports_location_service" $ supportsLocationService deviceContext, + Aeson.pair "supports_vibration" $ supportsVibration deviceContext, + Aeson.pair "timezone" $ timezone deviceContext, + Aeson.pair "usable_memory" $ usableMemory deviceContext + ] + +empty :: DeviceContext +empty = + DeviceContext + { arch = Text.empty, + batteryLevel = Nothing, + batteryStatus = Text.empty, + bootTime = Nothing, + brand = Text.empty, + charging = Nothing, + cpuDescription = Text.empty, + deviceType = Text.empty, + deviceUniqueIdentifier = Text.empty, + externalFreeStorage = Nothing, + externalStorageSize = Nothing, + family = Text.empty, + freeMemory = Nothing, + freeStorage = Nothing, + lowMemory = Nothing, + manufacturer = Text.empty, + memorySize = Nothing, + model = Text.empty, + modelId = Text.empty, + name = Text.empty, + online = Nothing, + orientation = Text.empty, + processorCount = Nothing, + processorFrequency = Nothing, + screenDensity = Nothing, + screenDpi = Nothing, + screenResolution = Text.empty, + simulator = Nothing, + storageSize = Nothing, + supportsAccelerometer = Nothing, + supportsAudio = Nothing, + supportsGyroscope = Nothing, + supportsLocationService = Nothing, + supportsVibration = Nothing, + timezone = Text.empty, + usableMemory = Nothing + } diff --git a/source/library/Patrol/Type/Dsn.hs b/source/library/Patrol/Type/Dsn.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Dsn.hs @@ -0,0 +1,91 @@ +module Patrol.Type.Dsn where + +import qualified Control.Monad as Monad +import qualified Control.Monad.Catch as Catch +import qualified Data.ByteString as ByteString +import qualified Data.Maybe as Maybe +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Network.URI as Uri +import qualified Numeric.Natural as Natural +import qualified Patrol.Constant as Constant +import qualified Patrol.Exception.Problem as Problem +import qualified Text.Read as Read + +data Dsn = Dsn + { protocol :: Text.Text, + publicKey :: Text.Text, + secretKey :: Text.Text, + host :: Text.Text, + port :: Maybe Natural.Natural, + path :: Text.Text, + projectId :: Text.Text + } + deriving (Eq, Show) + +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 + 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 + 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" + pure + Dsn + { protocol = theProtocol, + publicKey = thePublicKey, + secretKey = theSecretKey, + host = theHost, + port = maybePort, + path = thePath, + projectId = theProjectId + } + +intoUri :: Dsn -> Uri.URI +intoUri dsn = + Uri.URI + { Uri.uriScheme = mconcat [Text.unpack $ protocol dsn, ":"], + Uri.uriAuthority = + Just + Uri.URIAuth + { Uri.uriUserInfo = + mconcat + [ Text.unpack $ publicKey dsn, + case secretKey dsn of + x + | Text.null x -> "" + | otherwise -> mconcat [":", Text.unpack x], + "@" + ], + Uri.uriRegName = Text.unpack $ host dsn, + Uri.uriPort = case port dsn of + Nothing -> "" + Just x -> mconcat [":", show x] + }, + Uri.uriPath = + mconcat + [ Text.unpack $ path dsn, + Text.unpack $ projectId dsn + ], + Uri.uriQuery = "", + Uri.uriFragment = "" + } + +intoAuthorization :: Dsn -> ByteString.ByteString +intoAuthorization dsn = + Text.encodeUtf8 + . (Text.pack "Sentry " <>) + . Text.intercalate (Text.singleton ',') + $ Maybe.mapMaybe + (\(k, v) -> if Text.null v then Nothing else Just (Text.pack k <> Text.singleton '=' <> v)) + [ ("sentry_version", Constant.sentryVersion), + ("sentry_client", Constant.userAgent), + ("sentry_key", publicKey dsn), + ("sentry_secret", secretKey dsn) + ] diff --git a/source/library/Patrol/Type/ErrorType.hs b/source/library/Patrol/Type/ErrorType.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/ErrorType.hs @@ -0,0 +1,89 @@ +module Patrol.Type.ErrorType where + +import qualified Data.Aeson as Aeson + +data ErrorType + = ClockDrift + | FetchGenericError + | FetchInvalidEncoding + | FetchInvalidHttpCode + | FetchTimeout + | FetchTooLarge + | FutureTimestamp + | InvalidAttribute + | InvalidData + | InvalidEnvironment + | JsFetchTimeout + | JsGenericFetchError + | JsInvalidContent + | JsInvalidHttpCode + | JsInvalidSourceEncoding + | JsInvalidSourcemap + | JsInvalidSourcemapLocation + | JsMissingSource + | JsNoColumn + | JsTooLarge + | JsTooManyRemoteSources + | MissingAttribute + | NativeBadDsym + | NativeInternalFailure + | NativeMissingDsym + | NativeMissingOptionallyBundledDsym + | NativeMissingSymbol + | NativeMissingSystemDsym + | NativeNoCrashedThread + | NativeSimulatorFrame + | NativeSymbolicatorFailed + | NativeUnknownImage + | PastTimestamp + | ProguardMissingLineno + | ProguardMissingMapping + | RestrictedIp + | SecurityViolation + | TooLargeForCache + | UnknownError + | ValueTooLong + deriving (Eq, Show) + +instance Aeson.ToJSON ErrorType where + toJSON errorType = Aeson.toJSON $ case errorType of + ClockDrift -> "clock_drift" + FetchGenericError -> "fetch_generic_error" + FetchInvalidEncoding -> "fetch_invalid_source_encoding" + FetchInvalidHttpCode -> "fetch_invalid_http_code" + FetchTimeout -> "fetch_timeout" + FetchTooLarge -> "fetch_too_large" + FutureTimestamp -> "future_timestamp" + InvalidAttribute -> "invalid_attribute" + InvalidData -> "invalid_data" + InvalidEnvironment -> "invalid_environment" + JsFetchTimeout -> "js_fetch_timeout" + JsGenericFetchError -> "js_generic_fetch_error" + JsInvalidContent -> "js_invalid_content" + JsInvalidHttpCode -> "js_invalid_http_code" + JsInvalidSourceEncoding -> "js_invalid_source_encoding" + JsInvalidSourcemap -> "js_invalid_source" + JsInvalidSourcemapLocation -> "js_invalid_sourcemap_location" + JsMissingSource -> "js_no_source" + JsNoColumn -> "js_no_column" + JsTooLarge -> "js_too_large" + JsTooManyRemoteSources -> "js_too_many_sources" + MissingAttribute -> "missing_attribute" + NativeBadDsym -> "native_bad_dsym" + NativeInternalFailure -> "native_internal_failure" + NativeMissingDsym -> "native_missing_dsym" + NativeMissingOptionallyBundledDsym -> "native_optionally_bundled_dsym" + NativeMissingSymbol -> "native_missing_symbol" + NativeMissingSystemDsym -> "native_missing_system_dsym" + NativeNoCrashedThread -> "native_no_crashed_thread" + NativeSimulatorFrame -> "native_simulator_frame" + NativeSymbolicatorFailed -> "native_symbolicator_failed" + NativeUnknownImage -> "native_unknown_image" + PastTimestamp -> "past_timestamp" + ProguardMissingLineno -> "proguard_missing_lineno" + ProguardMissingMapping -> "proguard_missing_mapping" + RestrictedIp -> "restricted_ip" + SecurityViolation -> "security_violation" + TooLargeForCache -> "too_large_for_cache" + UnknownError -> "unknown_error" + ValueTooLong -> "value_too_long" diff --git a/source/library/Patrol/Type/Event.hs b/source/library/Patrol/Type/Event.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Event.hs @@ -0,0 +1,174 @@ +module Patrol.Type.Event 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.ByteString.Lazy as LazyByteString +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Time as Time +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.Extra.List as List +import qualified Patrol.Type.Breadcrumbs as Breadcrumbs +import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo +import qualified Patrol.Type.Context as Context +import qualified Patrol.Type.DebugMeta as DebugMeta +import qualified Patrol.Type.Dsn as Dsn +import qualified Patrol.Type.EventId as EventId +import qualified Patrol.Type.EventProcessingError as EventProcessingError +import qualified Patrol.Type.EventType as EventType +import qualified Patrol.Type.Exceptions as Exceptions +import qualified Patrol.Type.Level as Level +import qualified Patrol.Type.LogEntry as LogEntry +import qualified Patrol.Type.Platform as Platform +import qualified Patrol.Type.Request as Request +import qualified Patrol.Type.Threads as Threads +import qualified Patrol.Type.TransactionInfo as TransactionInfo +import qualified Patrol.Type.User as User + +-- | +data Event = Event + { breadcrumbs :: Maybe Breadcrumbs.Breadcrumbs, + contexts :: Map.Map Text.Text Context.Context, + debugMeta :: Maybe DebugMeta.DebugMeta, + dist :: Text.Text, + environment :: Text.Text, + errors :: [EventProcessingError.EventProcessingError], + eventId :: EventId.EventId, + exception :: Maybe Exceptions.Exceptions, + extra :: Map.Map Text.Text Aeson.Value, + fingerprint :: [Text.Text], + level :: Maybe Level.Level, + logentry :: Maybe LogEntry.LogEntry, + logger :: Text.Text, + modules :: Map.Map Text.Text Text.Text, + platform :: Maybe Platform.Platform, + release :: Text.Text, + request :: Maybe Request.Request, + sdk :: Maybe ClientSdkInfo.ClientSdkInfo, + serverName :: Text.Text, + tags :: Map.Map Text.Text Text.Text, + threads :: Maybe Threads.Threads, + timeSpent :: Maybe Time.NominalDiffTime, + timestamp :: Maybe Time.UTCTime, + transaction :: Text.Text, + transactionInfo :: Maybe TransactionInfo.TransactionInfo, + type_ :: Maybe EventType.EventType, + user :: Maybe User.User, + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON Event where + toJSON event = + Aeson.intoObject + [ Aeson.pair "breadcrumbs" $ breadcrumbs event, + Aeson.pair "contexts" $ contexts event, + Aeson.pair "debug_meta" $ debugMeta event, + Aeson.pair "dist" $ dist event, + Aeson.pair "environment" $ environment event, + Aeson.pair "errors" $ errors event, + Aeson.pair "exception" $ exception event, + Aeson.pair "extra" $ extra event, + Aeson.pair "event_id" $ eventId event, + Aeson.pair "fingerprint" $ fingerprint event, + Aeson.pair "level" $ level event, + Aeson.pair "logentry" $ logentry event, + Aeson.pair "logger" $ logger event, + Aeson.pair "modules" $ modules event, + Aeson.pair "platform" $ platform event, + Aeson.pair "release" $ release event, + Aeson.pair "request" $ request event, + Aeson.pair "sdk" $ sdk event, + Aeson.pair "server_name" $ serverName event, + Aeson.pair "tags" $ tags event, + Aeson.pair "threads" $ threads event, + Aeson.pair "time_spent" $ timeSpent event, + Aeson.pair "timestamp" $ timestamp event, + Aeson.pair "transaction" $ transaction event, + Aeson.pair "transaction_info" $ transactionInfo event, + Aeson.pair "type" $ type_ event, + Aeson.pair "user" $ user event, + Aeson.pair "version" $ version event + ] + +empty :: Event +empty = + Event + { breadcrumbs = Nothing, + contexts = Map.empty, + debugMeta = Nothing, + dist = Text.empty, + environment = Text.empty, + errors = [], + eventId = EventId.empty, + exception = Nothing, + extra = Map.empty, + fingerprint = [], + level = Nothing, + logentry = Nothing, + logger = Text.empty, + modules = Map.empty, + platform = Nothing, + release = Text.empty, + request = Nothing, + sdk = Nothing, + serverName = Text.empty, + tags = Map.empty, + threads = Nothing, + timeSpent = Nothing, + timestamp = Nothing, + transaction = Text.empty, + transactionInfo = Nothing, + type_ = Nothing, + user = Nothing, + version = Text.empty + } + +new :: IO.MonadIO io => io Event +new = do + theEventId <- EventId.random + theTimestamp <- IO.liftIO Time.getCurrentTime + 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 + } + +intoRequest :: Catch.MonadThrow m => Dsn.Dsn -> Event -> m Client.Request +intoRequest dsn event = do + theRequest <- + Client.parseUrlThrow + . Text.unpack + $ mconcat + [ Dsn.protocol dsn, + Text.pack "://", + Dsn.host dsn, + maybe Text.empty (Text.pack . (:) ':' . show) $ Dsn.port dsn, + Dsn.path dsn, + Text.pack "api/", + Dsn.projectId dsn, + Text.pack "/store/" + ] + let oldHeaders = Client.requestHeaders theRequest + authorization = Dsn.intoAuthorization dsn + newHeaders = + [ (Http.hContentType, Constant.applicationJson), + (Http.hUserAgent, Text.encodeUtf8 Constant.userAgent), + (Constant.xSentryAuth, authorization) + ] + pure + theRequest + { Client.method = Http.methodPost, + Client.requestBody = Client.RequestBodyBS . LazyByteString.toStrict $ Aeson.encode event, + Client.requestHeaders = List.insertAll newHeaders oldHeaders + } diff --git a/source/library/Patrol/Type/EventId.hs b/source/library/Patrol/Type/EventId.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/EventId.hs @@ -0,0 +1,61 @@ +module Patrol.Type.EventId where + +import qualified Control.Monad as Monad +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 Data.Text.Read as Text +import qualified Data.Typeable as Typeable +import qualified Data.UUID as Uuid +import qualified Data.UUID.V4 as Uuid +import qualified Patrol.Exception.Problem as Problem +import qualified Text.Printf as Printf + +newtype EventId + = EventId Uuid.UUID + deriving (Eq, Show) + +instance Aeson.FromJSON EventId where + parseJSON = + let name = show $ Typeable.typeRep (Typeable.Proxy :: Typeable.Proxy EventId) + in Aeson.withText name $ maybe (fail $ "invalid " <> name) pure . fromText + +instance Aeson.ToJSON EventId where + toJSON = Aeson.toJSON . intoText + +empty :: EventId +empty = fromUuid Uuid.nil + +fromUuid :: Uuid.UUID -> EventId +fromUuid = EventId + +intoUuid :: EventId -> Uuid.UUID +intoUuid (EventId uuid) = uuid + +random :: IO.MonadIO io => io EventId +random = IO.liftIO $ fmap fromUuid Uuid.nextRandom + +intoText :: EventId -> Text.Text +intoText eventId = + let (lo, hi) = Uuid.toWords64 $ intoUuid eventId + in Text.pack $ Printf.printf "%016x%016x" lo hi + +fromText :: Catch.MonadThrow m => Text.Text -> m EventId +fromText t1 = do + let parse :: (Catch.MonadThrow n, Integral a) => Int -> Text.Text -> n (a, Text.Text) + parse size text = do + let (before, after) = Text.splitAt size text + case Text.compareLength before size of + GT -> Catch.throwM $ Problem.Problem "impossible" + LT -> Catch.throwM $ Problem.Problem "not enough input" + EQ -> case Text.hexadecimal before of + Left _ -> Catch.throwM $ Problem.Problem "invalid hexadecimal" + Right (integral, leftover) -> + if Text.null leftover + then pure (integral, after) + else Catch.throwM $ Problem.Problem "invalid hexadecimal" + (lo, t2) <- parse 16 t1 + (hi, t3) <- parse 16 t2 + Monad.unless (Text.null t3) . Catch.throwM $ Problem.Problem "too much input" + pure . fromUuid $ Uuid.fromWords64 lo hi diff --git a/source/library/Patrol/Type/EventProcessingError.hs b/source/library/Patrol/Type/EventProcessingError.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/EventProcessingError.hs @@ -0,0 +1,30 @@ +module Patrol.Type.EventProcessingError where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.ErrorType as ErrorType + +-- | +data EventProcessingError = EventProcessingError + { name :: Text.Text, + type_ :: ErrorType.ErrorType, + value :: Aeson.Value + } + deriving (Eq, Show) + +instance Aeson.ToJSON EventProcessingError where + toJSON eventProcessingError = + Aeson.intoObject + [ Aeson.pair "name" $ name eventProcessingError, + Aeson.pair "type" $ type_ eventProcessingError, + Aeson.pair "value" $ value eventProcessingError + ] + +empty :: EventProcessingError +empty = + EventProcessingError + { name = Text.empty, + type_ = ErrorType.UnknownError, + value = Aeson.Null + } diff --git a/source/library/Patrol/Type/EventType.hs b/source/library/Patrol/Type/EventType.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/EventType.hs @@ -0,0 +1,24 @@ +module Patrol.Type.EventType where + +import qualified Data.Aeson as Aeson + +-- | +data EventType + = Csp + | Default + | Error + | Expectct + | Expectstaple + | Hpkp + | Transaction + deriving (Eq, Show) + +instance Aeson.ToJSON EventType where + toJSON eventType = Aeson.toJSON $ case eventType of + Csp -> "csp" + Default -> "default" + Error -> "error" + Expectct -> "expectct" + Expectstaple -> "expectstaple" + Hpkp -> "hpkp" + Transaction -> "transaction" diff --git a/source/library/Patrol/Type/Exception.hs b/source/library/Patrol/Type/Exception.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Exception.hs @@ -0,0 +1,49 @@ +module Patrol.Type.Exception where + +import qualified Control.Monad.Catch as Catch +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Data.Typeable as Typeable +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Mechanism as Mechanism +import qualified Patrol.Type.Stacktrace as Stacktrace + +-- | +data Exception = Exception + { mechanism :: Maybe Mechanism.Mechanism, + module_ :: Text.Text, + stacktrace :: Maybe Stacktrace.Stacktrace, + threadId :: Text.Text, + type_ :: Text.Text, + value :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON Exception where + toJSON exception = + Aeson.intoObject + [ Aeson.pair "mechanism" $ mechanism exception, + Aeson.pair "module" $ module_ exception, + Aeson.pair "stacktrace" $ stacktrace exception, + Aeson.pair "thread_id" $ threadId exception, + Aeson.pair "type" $ type_ exception, + Aeson.pair "value" $ value exception + ] + +empty :: Exception +empty = + Exception + { mechanism = Nothing, + module_ = Text.empty, + stacktrace = Nothing, + threadId = Text.empty, + type_ = Text.empty, + value = Text.empty + } + +fromSomeException :: Catch.SomeException -> Exception +fromSomeException (Catch.SomeException e) = + empty + { type_ = Text.pack . show $ Typeable.typeOf e, + value = Text.pack $ Catch.displayException e + } diff --git a/source/library/Patrol/Type/Exceptions.hs b/source/library/Patrol/Type/Exceptions.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Exceptions.hs @@ -0,0 +1,23 @@ +module Patrol.Type.Exceptions where + +import qualified Data.Aeson as Aeson +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Exception as Exception + +-- | +newtype Exceptions = Exceptions + { values :: [Exception.Exception] + } + deriving (Eq, Show) + +instance Aeson.ToJSON Exceptions where + toJSON exceptions = + Aeson.intoObject + [ Aeson.pair "values" $ values exceptions + ] + +empty :: Exceptions +empty = + Exceptions + { values = [] + } diff --git a/source/library/Patrol/Type/Frame.hs b/source/library/Patrol/Type/Frame.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Frame.hs @@ -0,0 +1,90 @@ +module Patrol.Type.Frame where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified GHC.Stack as Stack +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Platform as Platform + +-- | +data Frame = Frame + { absPath :: Text.Text, + addrMode :: Text.Text, + colno :: Maybe Int, + contextLine :: Text.Text, + filename :: Text.Text, + function :: Text.Text, + imageAddr :: Text.Text, + inApp :: Maybe Bool, + instructionAddr :: Text.Text, + lineno :: Maybe Int, + module_ :: Text.Text, + package :: Text.Text, + platform :: Maybe Platform.Platform, + postContext :: [Text.Text], + preContext :: [Text.Text], + rawFunction :: Text.Text, + stackStart :: Maybe Bool, + symbolAddr :: Text.Text, + vars :: Map.Map Text.Text Aeson.Value + } + deriving (Eq, Show) + +instance Aeson.ToJSON Frame where + toJSON frame = + Aeson.intoObject + [ Aeson.pair "abs_path" $ absPath frame, + Aeson.pair "addr_mode" $ addrMode frame, + Aeson.pair "colno" $ colno frame, + Aeson.pair "context_line" $ contextLine frame, + Aeson.pair "filename" $ filename frame, + Aeson.pair "function" $ function frame, + Aeson.pair "image_addr" $ imageAddr frame, + Aeson.pair "in_app" $ inApp frame, + Aeson.pair "instruction_addr" $ instructionAddr frame, + Aeson.pair "lineno" $ lineno frame, + Aeson.pair "module" $ module_ frame, + Aeson.pair "package" $ package frame, + Aeson.pair "platform" $ platform frame, + Aeson.pair "post_context" $ postContext frame, + Aeson.pair "pre_context" $ preContext frame, + Aeson.pair "raw_function" $ rawFunction frame, + Aeson.pair "stack_start" $ stackStart frame, + Aeson.pair "symbol_addr" $ symbolAddr frame, + Aeson.pair "vars" $ vars frame + ] + +empty :: Frame +empty = + Frame + { absPath = Text.empty, + addrMode = Text.empty, + colno = Nothing, + contextLine = Text.empty, + filename = Text.empty, + function = Text.empty, + imageAddr = Text.empty, + inApp = Nothing, + instructionAddr = Text.empty, + lineno = Nothing, + module_ = Text.empty, + package = Text.empty, + platform = Nothing, + postContext = [], + preContext = [], + rawFunction = Text.empty, + stackStart = Nothing, + symbolAddr = Text.empty, + vars = Map.empty + } + +fromSrcLoc :: Stack.SrcLoc -> Frame +fromSrcLoc srcLoc = + empty + { colno = Just $ Stack.srcLocStartCol srcLoc, + filename = Text.pack $ Stack.srcLocFile srcLoc, + lineno = Just $ Stack.srcLocStartLine srcLoc, + module_ = Text.pack $ Stack.srcLocModule srcLoc, + package = Text.pack $ Stack.srcLocPackage srcLoc + } diff --git a/source/library/Patrol/Type/Geo.hs b/source/library/Patrol/Type/Geo.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Geo.hs @@ -0,0 +1,29 @@ +module Patrol.Type.Geo where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data Geo = Geo + { city :: Text.Text, + countryCode :: Text.Text, + region :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON Geo where + toJSON geo = + Aeson.intoObject + [ Aeson.pair "city" $ city geo, + Aeson.pair "country_code" $ countryCode geo, + Aeson.pair "region" $ region geo + ] + +empty :: Geo +empty = + Geo + { city = Text.empty, + countryCode = Text.empty, + region = Text.empty + } diff --git a/source/library/Patrol/Type/GpuContext.hs b/source/library/Patrol/Type/GpuContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/GpuContext.hs @@ -0,0 +1,62 @@ +module Patrol.Type.GpuContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data GpuContext = GpuContext + { apiType :: Text.Text, + graphicsShaderLevel :: Text.Text, + id :: Aeson.Value, + maxTextureSize :: Maybe Int, + memorySize :: Maybe Double, + multiThreadedRendering :: Maybe Bool, + name :: Text.Text, + npotSupport :: Text.Text, + supportsComputeShaders :: Maybe Bool, + supportsGeometryShaders :: Maybe Bool, + supportsRayTracing :: Maybe Bool, + vendorId :: Text.Text, + vendorName :: Text.Text, + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON GpuContext where + toJSON gpuContext = + Aeson.intoObject + [ Aeson.pair "api_type" $ apiType gpuContext, + Aeson.pair "graphics_shader_level" $ graphicsShaderLevel gpuContext, + Aeson.pair "id" $ Patrol.Type.GpuContext.id gpuContext, + Aeson.pair "max_texture_size" $ maxTextureSize gpuContext, + Aeson.pair "memory_size" $ memorySize gpuContext, + Aeson.pair "multi_threaded_rendering" $ multiThreadedRendering gpuContext, + Aeson.pair "name" $ name gpuContext, + Aeson.pair "npot_support" $ npotSupport gpuContext, + Aeson.pair "supports_compute_shaders" $ supportsComputeShaders gpuContext, + Aeson.pair "supports_geometry_shaders" $ supportsGeometryShaders gpuContext, + Aeson.pair "supports_ray_tracing" $ supportsRayTracing gpuContext, + Aeson.pair "vendor_id" $ vendorId gpuContext, + Aeson.pair "vendor_name" $ vendorName gpuContext, + Aeson.pair "version" $ version gpuContext + ] + +empty :: GpuContext +empty = + GpuContext + { apiType = Text.empty, + graphicsShaderLevel = Text.empty, + Patrol.Type.GpuContext.id = Aeson.Null, + maxTextureSize = Nothing, + memorySize = Nothing, + multiThreadedRendering = Nothing, + name = Text.empty, + npotSupport = Text.empty, + supportsComputeShaders = Nothing, + supportsGeometryShaders = Nothing, + supportsRayTracing = Nothing, + vendorId = Text.empty, + vendorName = Text.empty, + version = Text.empty + } diff --git a/source/library/Patrol/Type/Level.hs b/source/library/Patrol/Type/Level.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Level.hs @@ -0,0 +1,20 @@ +module Patrol.Type.Level where + +import qualified Data.Aeson as Aeson + +-- | +data Level + = Debug + | Info + | Warning + | Error + | Fatal + deriving (Eq, Show) + +instance Aeson.ToJSON Level where + toJSON level = Aeson.toJSON $ case level of + Debug -> "debug" + Info -> "info" + Warning -> "warning" + Error -> "error" + Fatal -> "fatal" diff --git a/source/library/Patrol/Type/LogEntry.hs b/source/library/Patrol/Type/LogEntry.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/LogEntry.hs @@ -0,0 +1,29 @@ +module Patrol.Type.LogEntry where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data LogEntry = LogEntry + { formatted :: Text.Text, + message :: Text.Text, + params :: Aeson.Value + } + deriving (Eq, Show) + +instance Aeson.ToJSON LogEntry where + toJSON logEntry = + Aeson.intoObject + [ Aeson.pair "formatted" $ formatted logEntry, + Aeson.pair "message" $ message logEntry, + Aeson.pair "params" $ params logEntry + ] + +empty :: LogEntry +empty = + LogEntry + { formatted = Text.empty, + message = Text.empty, + params = Aeson.Null + } diff --git a/source/library/Patrol/Type/MachException.hs b/source/library/Patrol/Type/MachException.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/MachException.hs @@ -0,0 +1,32 @@ +module Patrol.Type.MachException where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data MachException = MachException + { code :: Maybe Int, + exception :: Maybe Int, + name :: Text.Text, + subcode :: Maybe Int + } + deriving (Eq, Show) + +instance Aeson.ToJSON MachException where + toJSON machException = + Aeson.intoObject + [ Aeson.pair "code" $ code machException, + Aeson.pair "exception" $ exception machException, + Aeson.pair "name" $ name machException, + Aeson.pair "subcode" $ subcode machException + ] + +empty :: MachException +empty = + MachException + { code = Nothing, + exception = Nothing, + name = Text.empty, + subcode = Nothing + } diff --git a/source/library/Patrol/Type/Mechanism.hs b/source/library/Patrol/Type/Mechanism.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Mechanism.hs @@ -0,0 +1,43 @@ +module Patrol.Type.Mechanism where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.MechanismMeta as MechanismMeta + +-- | +data Mechanism = Mechanism + { data_ :: Map.Map Text.Text Aeson.Value, + description :: Text.Text, + handled :: Maybe Bool, + helpLink :: Text.Text, + meta :: Maybe MechanismMeta.MechanismMeta, + synthetic :: Maybe Bool, + type_ :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON Mechanism where + toJSON mechanism = + Aeson.intoObject + [ Aeson.pair "data" $ data_ mechanism, + Aeson.pair "description" $ description mechanism, + Aeson.pair "handled" $ handled mechanism, + Aeson.pair "help_link" $ helpLink mechanism, + Aeson.pair "meta" $ meta mechanism, + Aeson.pair "synthetic" $ synthetic mechanism, + Aeson.pair "type" $ type_ mechanism + ] + +empty :: Mechanism +empty = + Mechanism + { data_ = Map.empty, + description = Text.empty, + handled = Nothing, + helpLink = Text.empty, + meta = Nothing, + synthetic = Nothing, + type_ = Text.empty + } diff --git a/source/library/Patrol/Type/MechanismMeta.hs b/source/library/Patrol/Type/MechanismMeta.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/MechanismMeta.hs @@ -0,0 +1,35 @@ +module Patrol.Type.MechanismMeta where + +import qualified Data.Aeson as Aeson +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.CError as CError +import qualified Patrol.Type.MachException as MachException +import qualified Patrol.Type.NsError as NsError +import qualified Patrol.Type.PosixSignal as PosixSignal + +-- | +data MechanismMeta = MechanismMeta + { errno :: Maybe CError.CError, + machException :: Maybe MachException.MachException, + nsError :: Maybe NsError.NsError, + signal :: Maybe PosixSignal.PosixSignal + } + deriving (Eq, Show) + +instance Aeson.ToJSON MechanismMeta where + toJSON mechanismMeta = + Aeson.intoObject + [ Aeson.pair "errno" $ errno mechanismMeta, + Aeson.pair "mach_exception" $ machException mechanismMeta, + Aeson.pair "ns_error" $ nsError mechanismMeta, + Aeson.pair "signal" $ signal mechanismMeta + ] + +empty :: MechanismMeta +empty = + MechanismMeta + { errno = Nothing, + machException = Nothing, + nsError = Nothing, + signal = Nothing + } diff --git a/source/library/Patrol/Type/NativeDebugImage.hs b/source/library/Patrol/Type/NativeDebugImage.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/NativeDebugImage.hs @@ -0,0 +1,47 @@ +module Patrol.Type.NativeDebugImage where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data NativeDebugImage = NativeDebugImage + { arch :: Text.Text, + codeFile :: Text.Text, + codeId :: Text.Text, + debugFile :: Text.Text, + debugId :: Text.Text, + imageAddr :: Text.Text, + imageSize :: Maybe Int, + imageVmaddr :: Text.Text, + type_ :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON NativeDebugImage where + toJSON nativeDebugImage = + Aeson.intoObject + [ Aeson.pair "arch" $ arch nativeDebugImage, + Aeson.pair "code_file" $ codeFile nativeDebugImage, + Aeson.pair "code_id" $ codeId nativeDebugImage, + Aeson.pair "debug_file" $ debugFile nativeDebugImage, + Aeson.pair "debug_id" $ debugId nativeDebugImage, + Aeson.pair "image_addr" $ imageAddr nativeDebugImage, + Aeson.pair "image_size" $ imageSize nativeDebugImage, + Aeson.pair "image_vmaddr" $ imageVmaddr nativeDebugImage, + Aeson.pair "type" $ type_ nativeDebugImage + ] + +empty :: NativeDebugImage +empty = + NativeDebugImage + { arch = Text.empty, + codeFile = Text.empty, + codeId = Text.empty, + debugFile = Text.empty, + debugId = Text.empty, + imageAddr = Text.empty, + imageSize = Nothing, + imageVmaddr = Text.empty, + type_ = Text.empty + } diff --git a/source/library/Patrol/Type/NsError.hs b/source/library/Patrol/Type/NsError.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/NsError.hs @@ -0,0 +1,26 @@ +module Patrol.Type.NsError where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data NsError = NsError + { code :: Maybe Int, + domain :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON NsError where + toJSON nsError = + Aeson.intoObject + [ Aeson.pair "code" $ code nsError, + Aeson.pair "domain" $ domain nsError + ] + +empty :: NsError +empty = + NsError + { code = Nothing, + domain = Text.empty + } diff --git a/source/library/Patrol/Type/OsContext.hs b/source/library/Patrol/Type/OsContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/OsContext.hs @@ -0,0 +1,38 @@ +module Patrol.Type.OsContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data OsContext = OsContext + { build :: Text.Text, + kernelVersion :: Text.Text, + name :: Text.Text, + rawDescription :: Text.Text, + rooted :: Maybe Bool, + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON OsContext where + toJSON osContext = + Aeson.intoObject + [ Aeson.pair "build" $ build osContext, + Aeson.pair "kernel_version" $ kernelVersion osContext, + Aeson.pair "name" $ name osContext, + Aeson.pair "raw_description" $ rawDescription osContext, + Aeson.pair "rooted" $ rooted osContext, + Aeson.pair "version" $ version osContext + ] + +empty :: OsContext +empty = + OsContext + { build = Text.empty, + kernelVersion = Text.empty, + name = Text.empty, + rawDescription = Text.empty, + rooted = Nothing, + version = Text.empty + } diff --git a/source/library/Patrol/Type/Platform.hs b/source/library/Patrol/Type/Platform.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Platform.hs @@ -0,0 +1,47 @@ +module Patrol.Type.Platform where + +import qualified Data.Aeson as Aeson + +data Platform + = As3 + | C + | Cfml + | Cocoa + | Csharp + | Elixir + | Haskell + | Go + | Groovy + | Java + | Javascript + | Native + | Node + | Objc + | Other + | Perl + | Php + | Python + | Ruby + deriving (Eq, Show) + +instance Aeson.ToJSON Platform where + toJSON platform = Aeson.toJSON $ case platform of + As3 -> "as3" + C -> "c" + Cfml -> "cfml" + Cocoa -> "cocoa" + Csharp -> "csharp" + Elixir -> "elixir" + Haskell -> "haskell" + Go -> "go" + Groovy -> "groovy" + Java -> "java" + Javascript -> "javascript" + Native -> "native" + Node -> "node" + Objc -> "objc" + Other -> "other" + Perl -> "perl" + Php -> "php" + Python -> "python" + Ruby -> "ruby" diff --git a/source/library/Patrol/Type/PosixSignal.hs b/source/library/Patrol/Type/PosixSignal.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/PosixSignal.hs @@ -0,0 +1,32 @@ +module Patrol.Type.PosixSignal where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data PosixSignal = PosixSignal + { code :: Maybe Int, + codeName :: Text.Text, + name :: Text.Text, + number :: Maybe Int + } + deriving (Eq, Show) + +instance Aeson.ToJSON PosixSignal where + toJSON posixSignal = + Aeson.intoObject + [ Aeson.pair "code" $ code posixSignal, + Aeson.pair "code_name" $ codeName posixSignal, + Aeson.pair "name" $ name posixSignal, + Aeson.pair "number" $ number posixSignal + ] + +empty :: PosixSignal +empty = + PosixSignal + { code = Nothing, + codeName = Text.empty, + name = Text.empty, + number = Nothing + } diff --git a/source/library/Patrol/Type/ProguardDebugImage.hs b/source/library/Patrol/Type/ProguardDebugImage.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/ProguardDebugImage.hs @@ -0,0 +1,23 @@ +module Patrol.Type.ProguardDebugImage where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +newtype ProguardDebugImage = ProguardDebugImage + { uuid :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON ProguardDebugImage where + toJSON proguardDebugImage = + Aeson.intoObject + [ Aeson.pair "uuid" $ uuid proguardDebugImage + ] + +empty :: ProguardDebugImage +empty = + ProguardDebugImage + { uuid = Text.empty + } diff --git a/source/library/Patrol/Type/Request.hs b/source/library/Patrol/Type/Request.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Request.hs @@ -0,0 +1,48 @@ +module Patrol.Type.Request where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data Request = Request + { cookies :: Map.Map Text.Text Text.Text, + data_ :: Aeson.Value, + env :: Map.Map Text.Text Aeson.Value, + fragment :: Text.Text, + headers :: Map.Map Text.Text Text.Text, + inferredContentType :: Text.Text, + method :: Text.Text, + queryString :: Map.Map Text.Text Text.Text, + url :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON Request where + toJSON request = + Aeson.intoObject + [ Aeson.pair "cookies" $ cookies request, + Aeson.pair "data" $ data_ request, + Aeson.pair "env" $ env request, + Aeson.pair "fragment" $ fragment request, + Aeson.pair "headers" $ headers request, + Aeson.pair "inferred_content_type" $ inferredContentType request, + Aeson.pair "method" $ method request, + Aeson.pair "query_string" $ queryString request, + Aeson.pair "url" $ url request + ] + +empty :: Request +empty = + Request + { cookies = Map.empty, + data_ = Aeson.Null, + env = Map.empty, + fragment = Text.empty, + headers = Map.empty, + inferredContentType = Text.empty, + method = Text.empty, + queryString = Map.empty, + url = Text.empty + } diff --git a/source/library/Patrol/Type/Response.hs b/source/library/Patrol/Type/Response.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Response.hs @@ -0,0 +1,21 @@ +module Patrol.Type.Response where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Typeable as Typeable +import qualified Patrol.Type.EventId as EventId + +newtype Response = Response + { id :: EventId.EventId + } + deriving (Eq, Show) + +instance Aeson.FromJSON Response where + parseJSON = + let name = show $ Typeable.typeRep (Typeable.Proxy :: Typeable.Proxy Response) + in Aeson.withObject name $ \object -> do + theId <- object Aeson..: Key.fromString "id" + pure + Response + { Patrol.Type.Response.id = theId + } diff --git a/source/library/Patrol/Type/RuntimeContext.hs b/source/library/Patrol/Type/RuntimeContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/RuntimeContext.hs @@ -0,0 +1,32 @@ +module Patrol.Type.RuntimeContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data RuntimeContext = RuntimeContext + { build :: Text.Text, + name :: Text.Text, + rawDescription :: Text.Text, + version :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON RuntimeContext where + toJSON runtimeContext = + Aeson.intoObject + [ Aeson.pair "build" $ build runtimeContext, + Aeson.pair "name" $ name runtimeContext, + Aeson.pair "raw_description" $ rawDescription runtimeContext, + Aeson.pair "version" $ version runtimeContext + ] + +empty :: RuntimeContext +empty = + RuntimeContext + { build = Text.empty, + name = Text.empty, + rawDescription = Text.empty, + version = Text.empty + } diff --git a/source/library/Patrol/Type/SpanStatus.hs b/source/library/Patrol/Type/SpanStatus.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/SpanStatus.hs @@ -0,0 +1,44 @@ +module Patrol.Type.SpanStatus where + +import qualified Data.Aeson as Aeson + +-- | +data SpanStatus + = Aborted + | AlreadyExists + | Cancelled + | DataLoss + | DeadlineExceeded + | FailedPrecondition + | InternalError + | InvalidArgument + | NotFound + | Ok + | OutOfRange + | PermissionDenied + | ResourceExhausted + | Unauthenticated + | Unavailable + | Unimplemented + | Unknown + deriving (Eq, Show) + +instance Aeson.ToJSON SpanStatus where + toJSON spanStatus = Aeson.toJSON $ case spanStatus of + Aborted -> "aborted" + AlreadyExists -> "already_exists" + Cancelled -> "cancelled" + DataLoss -> "data_loss" + DeadlineExceeded -> "deadline_exceeded" + FailedPrecondition -> "failed_precondition" + InternalError -> "internal_error" + InvalidArgument -> "invalid_argument" + NotFound -> "not_found" + Ok -> "ok" + OutOfRange -> "out_of_range" + PermissionDenied -> "permission_denied" + ResourceExhausted -> "resource_exhausted" + Unauthenticated -> "unauthenticated" + Unavailable -> "unavailable" + Unimplemented -> "unimplemented" + Unknown -> "unknown" diff --git a/source/library/Patrol/Type/Stacktrace.hs b/source/library/Patrol/Type/Stacktrace.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Stacktrace.hs @@ -0,0 +1,37 @@ +module Patrol.Type.Stacktrace where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified GHC.Stack as Stack +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Frame as Frame + +-- | +data Stacktrace = Stacktrace + { frames :: [Frame.Frame], + registers :: Map.Map Text.Text Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON Stacktrace where + toJSON stacktrace = + Aeson.intoObject + [ Aeson.pair "frames" $ frames stacktrace, + Aeson.pair "registers" $ registers stacktrace + ] + +empty :: Stacktrace +empty = + Stacktrace + { frames = [], + registers = Map.empty + } + +fromCallStack :: Stack.CallStack -> Stacktrace +fromCallStack = + let intoFrame string srcLoc = + (Frame.fromSrcLoc srcLoc) + { Frame.function = Text.pack string + } + in flip Stacktrace Map.empty . fmap (uncurry intoFrame) . reverse . Stack.getCallStack diff --git a/source/library/Patrol/Type/SystemSdkInfo.hs b/source/library/Patrol/Type/SystemSdkInfo.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/SystemSdkInfo.hs @@ -0,0 +1,32 @@ +module Patrol.Type.SystemSdkInfo where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson + +-- | +data SystemSdkInfo = SystemSdkInfo + { sdkName :: Text.Text, + versionMajor :: Maybe Int, + versionMinor :: Maybe Int, + versionPatchlevel :: Maybe Int + } + deriving (Eq, Show) + +instance Aeson.ToJSON SystemSdkInfo where + toJSON systemSdkInfo = + Aeson.intoObject + [ Aeson.pair "sdk_name" $ sdkName systemSdkInfo, + Aeson.pair "version_major" $ versionMajor systemSdkInfo, + Aeson.pair "version_minor" $ versionMinor systemSdkInfo, + Aeson.pair "version_patchlevel" $ versionPatchlevel systemSdkInfo + ] + +empty :: SystemSdkInfo +empty = + SystemSdkInfo + { sdkName = Text.empty, + versionMajor = Nothing, + versionMinor = Nothing, + versionPatchlevel = Nothing + } diff --git a/source/library/Patrol/Type/Thread.hs b/source/library/Patrol/Type/Thread.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Thread.hs @@ -0,0 +1,36 @@ +module Patrol.Type.Thread where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Stacktrace as Stacktrace + +-- | +data Thread = Thread + { crashed :: Maybe Bool, + current :: Maybe Bool, + id :: Text.Text, + name :: Text.Text, + stacktrace :: Maybe Stacktrace.Stacktrace + } + deriving (Eq, Show) + +instance Aeson.ToJSON Thread where + toJSON thread = + Aeson.intoObject + [ Aeson.pair "crashed" $ crashed thread, + Aeson.pair "current" $ current thread, + Aeson.pair "id" $ Patrol.Type.Thread.id thread, + Aeson.pair "name" $ name thread, + Aeson.pair "stacktrace" $ stacktrace thread + ] + +empty :: Thread +empty = + Thread + { crashed = Nothing, + current = Nothing, + Patrol.Type.Thread.id = Text.empty, + name = Text.empty, + stacktrace = Nothing + } diff --git a/source/library/Patrol/Type/Threads.hs b/source/library/Patrol/Type/Threads.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/Threads.hs @@ -0,0 +1,23 @@ +module Patrol.Type.Threads where + +import qualified Data.Aeson as Aeson +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Thread as Thread + +-- | +newtype Threads = Threads + { values :: [Thread.Thread] + } + deriving (Eq, Show) + +instance Aeson.ToJSON Threads where + toJSON threads = + Aeson.intoObject + [ Aeson.pair "values" $ values threads + ] + +empty :: Threads +empty = + Threads + { values = [] + } diff --git a/source/library/Patrol/Type/TraceContext.hs b/source/library/Patrol/Type/TraceContext.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/TraceContext.hs @@ -0,0 +1,39 @@ +module Patrol.Type.TraceContext where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.SpanStatus as SpanStatus + +-- | +data TraceContext = TraceContext + { exclusiveTime :: Maybe Int, + op :: Text.Text, + parentSpanId :: Text.Text, + spanId :: Text.Text, + status :: Maybe SpanStatus.SpanStatus, + traceId :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON TraceContext where + toJSON traceContext = + Aeson.intoObject + [ Aeson.pair "exclusive_time" $ exclusiveTime traceContext, + Aeson.pair "op" $ op traceContext, + Aeson.pair "parent_span_id" $ parentSpanId traceContext, + Aeson.pair "span_id" $ spanId traceContext, + Aeson.pair "status" $ status traceContext, + Aeson.pair "trace_id" $ traceId traceContext + ] + +empty :: TraceContext +empty = + TraceContext + { exclusiveTime = Nothing, + op = Text.empty, + parentSpanId = Text.empty, + spanId = Text.empty, + status = Nothing, + traceId = Text.empty + } diff --git a/source/library/Patrol/Type/TransactionInfo.hs b/source/library/Patrol/Type/TransactionInfo.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/TransactionInfo.hs @@ -0,0 +1,27 @@ +module Patrol.Type.TransactionInfo where + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.TransactionSource as TransactionSource + +-- | +data TransactionInfo = TransactionInfo + { original :: Text.Text, + source :: Maybe TransactionSource.TransactionSource + } + deriving (Eq, Show) + +instance Aeson.ToJSON TransactionInfo where + toJSON transactionInfo = + Aeson.intoObject + [ Aeson.pair "original" $ original transactionInfo, + Aeson.pair "source" $ source transactionInfo + ] + +empty :: TransactionInfo +empty = + TransactionInfo + { original = Text.empty, + source = Nothing + } diff --git a/source/library/Patrol/Type/TransactionSource.hs b/source/library/Patrol/Type/TransactionSource.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/TransactionSource.hs @@ -0,0 +1,24 @@ +module Patrol.Type.TransactionSource where + +import qualified Data.Aeson as Aeson + +-- | +data TransactionSource + = Component + | Custom + | Route + | Task + | Url + | Unknown + | View + deriving (Eq, Show) + +instance Aeson.ToJSON TransactionSource where + toJSON transactionSource = Aeson.toJSON $ case transactionSource of + Component -> "component" + Custom -> "custom" + Route -> "route" + Task -> "task" + Url -> "url" + Unknown -> "unknown" + View -> "view" diff --git a/source/library/Patrol/Type/User.hs b/source/library/Patrol/Type/User.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Type/User.hs @@ -0,0 +1,46 @@ +module Patrol.Type.User where + +import qualified Data.Aeson as Aeson +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Patrol.Extra.Aeson as Aeson +import qualified Patrol.Type.Geo as Geo + +-- | +data User = User + { data_ :: Map.Map Text.Text Aeson.Value, + email :: Text.Text, + geo :: Maybe Geo.Geo, + id :: Text.Text, + ipAddress :: Text.Text, + name :: Text.Text, + segment :: Text.Text, + username :: Text.Text + } + deriving (Eq, Show) + +instance Aeson.ToJSON User where + toJSON user = + Aeson.intoObject + [ Aeson.pair "data" $ data_ user, + Aeson.pair "email" $ email user, + Aeson.pair "geo" $ geo user, + Aeson.pair "id" $ Patrol.Type.User.id user, + Aeson.pair "ip_address" $ ipAddress user, + Aeson.pair "name" $ name user, + Aeson.pair "segment" $ segment user, + Aeson.pair "username" $ username user + ] + +empty :: User +empty = + User + { data_ = Map.empty, + email = Text.empty, + geo = Nothing, + Patrol.Type.User.id = Text.empty, + ipAddress = Text.empty, + name = Text.empty, + segment = Text.empty, + username = Text.empty + } diff --git a/source/library/Patrol/Version.hs b/source/library/Patrol/Version.hs new file mode 100644 --- /dev/null +++ b/source/library/Patrol/Version.hs @@ -0,0 +1,14 @@ +module Patrol.Version where + +import qualified Data.Text as Text +import qualified Data.Version as Version +import qualified Paths_patrol as Package + +string :: String +string = Version.showVersion version + +text :: Text.Text +text = Text.pack string + +version :: Version.Version +version = Package.version diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Main.hs @@ -0,0 +1,5 @@ +import qualified PatrolSpec +import qualified Test.Hspec as Hspec + +main :: IO () +main = Hspec.hspec $ Hspec.parallel PatrolSpec.spec diff --git a/source/test-suite/Patrol/ClientSpec.hs b/source/test-suite/Patrol/ClientSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/ClientSpec.hs @@ -0,0 +1,8 @@ +module Patrol.ClientSpec where + +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Client" $ do + Hspec.it "needs tests" $ do + Hspec.pending diff --git a/source/test-suite/Patrol/ConstantSpec.hs b/source/test-suite/Patrol/ConstantSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/ConstantSpec.hs @@ -0,0 +1,25 @@ +module Patrol.ConstantSpec where + +import qualified Data.CaseInsensitive as CI +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Patrol.Constant as Constant +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Constant" $ do + Hspec.describe "applicationJson" $ do + Hspec.it "is correct" $ do + Constant.applicationJson `Hspec.shouldBe` Text.encodeUtf8 (Text.pack "application/json") + + Hspec.describe "sentryVersion" $ do + Hspec.it "is correct" $ do + Constant.sentryVersion `Hspec.shouldBe` Text.singleton '7' + + Hspec.describe "userAgent" $ do + Hspec.it "is correct" $ do + Constant.userAgent `Hspec.shouldSatisfy` Text.isPrefixOf (Text.pack "patrol/") + + Hspec.describe "xSentryAuth" $ do + Hspec.it "is correct" $ do + Constant.xSentryAuth `Hspec.shouldBe` CI.mk (Text.encodeUtf8 $ Text.pack "X-Sentry-Auth") diff --git a/source/test-suite/Patrol/Extra/AesonSpec.hs b/source/test-suite/Patrol/Extra/AesonSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Extra/AesonSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Extra.AesonSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Map as Map +import qualified Patrol.Extra.Aeson as Extra +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Extra.Aeson" $ do + Hspec.describe "intoObject" $ do + Hspec.it "works with an empty object" $ do + Extra.intoObject [] `Hspec.shouldBe` [Aeson.aesonQQ| {} |] + + Hspec.it "strips null" $ do + Extra.intoObject [Extra.pair "k" Aeson.Null] `Hspec.shouldBe` [Aeson.aesonQQ| {} |] + + Hspec.it "does not strip false" $ do + Extra.intoObject [Extra.pair "k" False] `Hspec.shouldBe` [Aeson.aesonQQ| { "k": false } |] + + Hspec.it "does not strip zero" $ do + Extra.intoObject [Extra.pair "k" (0 :: Int)] `Hspec.shouldBe` [Aeson.aesonQQ| { "k": 0 } |] + + Hspec.it "strips empty string" $ do + Extra.intoObject [Extra.pair "k" ""] `Hspec.shouldBe` [Aeson.aesonQQ| {} |] + + Hspec.it "strips empty array" $ do + Extra.intoObject [Extra.pair "k" (mempty :: [Int])] `Hspec.shouldBe` [Aeson.aesonQQ| {} |] + + Hspec.it "strips empty object" $ do + Extra.intoObject [Extra.pair "k" (mempty :: Map.Map String Int)] `Hspec.shouldBe` [Aeson.aesonQQ| {} |] + + Hspec.describe "isEmpty" $ do + Hspec.it "is true for null" $ do + Aeson.Null `Hspec.shouldSatisfy` Extra.isEmpty + + Hspec.it "is false for false" $ do + Aeson.Bool False `Hspec.shouldNotSatisfy` Extra.isEmpty + + Hspec.it "is false for zero" $ do + Aeson.Number 0 `Hspec.shouldNotSatisfy` Extra.isEmpty + + Hspec.it "is true for an empty string" $ do + Aeson.String mempty `Hspec.shouldSatisfy` Extra.isEmpty + + Hspec.it "is true for an empty array" $ do + Aeson.Array mempty `Hspec.shouldSatisfy` Extra.isEmpty + + Hspec.it "is true for an empty object" $ do + Aeson.Object mempty `Hspec.shouldSatisfy` Extra.isEmpty + + Hspec.describe "pair" $ do + Hspec.it "works" $ do + Extra.pair "key" False `Hspec.shouldBe` (Key.fromString "key", Aeson.Bool False) diff --git a/source/test-suite/Patrol/Extra/ListSpec.hs b/source/test-suite/Patrol/Extra/ListSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Extra/ListSpec.hs @@ -0,0 +1,59 @@ +module Patrol.Extra.ListSpec where + +import qualified Data.Char as Char +import qualified Data.Function as Function +import qualified Patrol.Extra.List as Extra +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Extra.List" $ do + Hspec.describe "insertAll" $ do + Hspec.it "handles empty lists" $ do + Extra.insertAll [] [] `Hspec.shouldBe` ([] :: [(Char, Bool)]) + + Hspec.it "inserts into an empty list" $ do + Extra.insertAll [('a', False)] [] `Hspec.shouldBe` [('a', False)] + + Hspec.it "handles an empty list of insertions" $ do + Extra.insertAll [] [('a', True)] `Hspec.shouldBe` [('a', True)] + + Hspec.it "prefers the original element" $ do + Extra.insertAll [('a', False)] [('a', True)] `Hspec.shouldBe` [('a', True)] + + Hspec.it "handles duplicate insertions" $ do + Extra.insertAll [('a', False), ('a', True)] [] `Hspec.shouldBe` [('a', True)] + + Hspec.it "inserts into a non-empty list" $ do + Extra.insertAll [('a', False)] [('b', True)] `Hspec.shouldBe` [('b', True), ('a', False)] + + Hspec.it "does not modify the original list" $ do + Extra.insertAll [] [('a', False), ('a', True)] `Hspec.shouldBe` [('a', False), ('a', True)] + + Hspec.describe "insert" $ do + Hspec.it "inserts into an empty list" $ do + Extra.insert ('a', False) [] `Hspec.shouldBe` [('a', False)] + + Hspec.it "prefers the original element" $ do + Extra.insert ('a', False) [('a', True)] `Hspec.shouldBe` [('a', True)] + + Hspec.it "inserts into a non-empty list" $ do + Extra.insert ('a', False) [('b', True)] `Hspec.shouldBe` [('b', True), ('a', False)] + + Hspec.describe "insertBy" $ do + Hspec.it "inserts into an empty list" $ do + Extra.insertBy (==) 'a' "" `Hspec.shouldBe` "a" + + Hspec.it "does not insert a duplicate" $ do + Extra.insertBy (==) 'a' "a" `Hspec.shouldBe` "a" + + Hspec.it "does not insert a duplicate earlier" $ do + Extra.insertBy (==) 'a' "ab" `Hspec.shouldBe` "ab" + + Hspec.it "does not insert a duplicate later" $ do + Extra.insertBy (==) 'a' "ba" `Hspec.shouldBe` "ba" + + Hspec.it "prefers the original element" $ do + Extra.insertBy (Function.on (==) Char.toLower) 'a' "A" `Hspec.shouldBe` "A" + + Hspec.it "inserts into a non-empty list" $ do + Extra.insertBy (==) 'a' "b" `Hspec.shouldBe` "ba" diff --git a/source/test-suite/Patrol/Type/AppContextSpec.hs b/source/test-suite/Patrol/Type/AppContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/AppContextSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.AppContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Patrol.Type.AppContext as AppContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.AppContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let appContext = AppContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with an app build" $ do + let appContext = AppContext.empty {AppContext.appBuild = Text.pack "example-app-build"} + json = [Aeson.aesonQQ| { "app_build": "example-app-build" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with an app identifier" $ do + let appContext = AppContext.empty {AppContext.appIdentifier = Text.pack "example-app-identifier"} + json = [Aeson.aesonQQ| { "app_identifier": "example-app-identifier" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with an app memory" $ do + let appContext = AppContext.empty {AppContext.appMemory = Just 0} + json = [Aeson.aesonQQ| { "app_memory": 0 } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with an app name" $ do + let appContext = AppContext.empty {AppContext.appName = Text.pack "example-app-name"} + json = [Aeson.aesonQQ| { "app_name": "example-app-name" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with an app start time" $ do + let appContext = AppContext.empty {AppContext.appStartTime = Just $ Time.UTCTime (Time.fromGregorian 1970 1 1) 0} + json = [Aeson.aesonQQ| { "app_start_time": "1970-01-01T00:00:00Z" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with an app version" $ do + let appContext = AppContext.empty {AppContext.appVersion = Text.pack "example-app-version"} + json = [Aeson.aesonQQ| { "app_version": "example-app-version" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with a build type" $ do + let appContext = AppContext.empty {AppContext.buildType = Text.pack "example-build-type"} + json = [Aeson.aesonQQ| { "build_type": "example-build-type" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json + + Hspec.it "works with a device app hash" $ do + let appContext = AppContext.empty {AppContext.deviceAppHash = Text.pack "example-device-app-hash"} + json = [Aeson.aesonQQ| { "device_app_hash": "example-device-app-hash" } |] + Aeson.toJSON appContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/AppleDebugImageSpec.hs b/source/test-suite/Patrol/Type/AppleDebugImageSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/AppleDebugImageSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.AppleDebugImageSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.AppleDebugImage as AppleDebugImage +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.AppleDebugImage" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let appleDebugImage = AppleDebugImage.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with an architecture" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.arch = Text.pack "example-arch"} + json = [Aeson.aesonQQ| { "arch": "example-arch" } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a CPU subtype" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.cpuSubtype = Just 0} + json = [Aeson.aesonQQ| { "cpu_subtype": 0 } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a CPU type" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.cpuType = Just 0} + json = [Aeson.aesonQQ| { "cpu_type": 0 } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with an image address" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.imageAddr = Text.pack "example-image-addr"} + json = [Aeson.aesonQQ| { "image_addr": "example-image-addr" } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with an image size" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.imageSize = Just 0} + json = [Aeson.aesonQQ| { "image_size": 0 } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with an image VM address" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.imageVmaddr = Text.pack "example-image-vmaddr"} + json = [Aeson.aesonQQ| { "image_vmaddr": "example-image-vmaddr" } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a UUID" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.uuid = Text.pack "example-uuid"} + json = [Aeson.aesonQQ| { "uuid": "example-uuid" } |] + Aeson.toJSON appleDebugImage `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/BreadcrumbSpec.hs b/source/test-suite/Patrol/Type/BreadcrumbSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/BreadcrumbSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.BreadcrumbSpec where + +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 Data.Time as Time +import qualified Patrol.Type.Breadcrumb as Breadcrumb +import qualified Patrol.Type.BreadcrumbType as BreadcrumbType +import qualified Patrol.Type.EventId as EventId +import qualified Patrol.Type.Level as Level +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Breadcrumb" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let breadcrumb = Breadcrumb.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with a category" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.category = Text.pack "example-category"} + json = [Aeson.aesonQQ| { "category": "example-category" } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with some data" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.data_ = Map.singleton (Text.pack "example-data") (Aeson.Bool True)} + json = [Aeson.aesonQQ| { "data": { "example-data": true } } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with an event ID" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.eventId = Just EventId.empty} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000" } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with a level" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.level = Just Level.Debug} + json = [Aeson.aesonQQ| { "level": "debug" } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with a message" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.message = Text.pack "example-message"} + json = [Aeson.aesonQQ| { "message": "example-message" } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with a timestamp" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.timestamp = Just $ Time.UTCTime (Time.fromGregorian 1970 1 1) 0} + json = [Aeson.aesonQQ| { "timestamp": "1970-01-01T00:00:00Z" } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json + + Hspec.it "works with a type" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.type_ = Just BreadcrumbType.Default} + json = [Aeson.aesonQQ| { "type": "default" } |] + Aeson.toJSON breadcrumb `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs b/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/BreadcrumbTypeSpec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.BreadcrumbTypeSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.BreadcrumbType as BreadcrumbType +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.BreadcrumbType" $ do + Hspec.describe "ToJSON" $ do + 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 Navigation" $ do + Aeson.toJSON BreadcrumbType.Navigation `Hspec.shouldBe` [Aeson.aesonQQ| "navigation" |] diff --git a/source/test-suite/Patrol/Type/BreadcrumbsSpec.hs b/source/test-suite/Patrol/Type/BreadcrumbsSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/BreadcrumbsSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.BreadcrumbsSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.Breadcrumb as Breadcrumb +import qualified Patrol.Type.Breadcrumbs as Breadcrumbs +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Breadcrumbs" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let breadcrumbs = Breadcrumbs.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON breadcrumbs `Hspec.shouldBe` json + + Hspec.it "works with a value" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.category = Text.pack "example-category"} + breadcrumbs = Breadcrumbs.empty {Breadcrumbs.values = [breadcrumb]} + json = [Aeson.aesonQQ| { "values": [ { "category": "example-category" } ] } |] + Aeson.toJSON breadcrumbs `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/BrowserContextSpec.hs b/source/test-suite/Patrol/Type/BrowserContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/BrowserContextSpec.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.BrowserContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.BrowserContext as BrowserContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.BrowserContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let browserContext = BrowserContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON browserContext `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let browserContext = BrowserContext.empty {BrowserContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON browserContext `Hspec.shouldBe` json + + Hspec.it "works with a version" $ do + let browserContext = BrowserContext.empty {BrowserContext.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "version": "example-version" } |] + Aeson.toJSON browserContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/CErrorSpec.hs b/source/test-suite/Patrol/Type/CErrorSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/CErrorSpec.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.CErrorSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.CError as CError +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.CError" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let cError = CError.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON cError `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let cError = CError.empty {CError.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON cError `Hspec.shouldBe` json + + Hspec.it "works with a number" $ do + let cError = CError.empty {CError.number = Just 0} + json = [Aeson.aesonQQ| { "number": 0 } |] + Aeson.toJSON cError `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ClientSdkInfoSpec.hs b/source/test-suite/Patrol/Type/ClientSdkInfoSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ClientSdkInfoSpec.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ClientSdkInfoSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo +import qualified Patrol.Type.ClientSdkPackage as ClientSdkPackage +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.ClientSdkInfo" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let clientSdkInfo = ClientSdkInfo.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON clientSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with an integration" $ do + let clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.integrations = [Text.pack "example-integration"]} + json = [Aeson.aesonQQ| { "integrations": [ "example-integration" ] } |] + Aeson.toJSON clientSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON clientSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with a package" $ do + let clientSdkPackage = ClientSdkPackage.empty {ClientSdkPackage.name = Text.pack "example-name"} + clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.packages = [clientSdkPackage]} + json = [Aeson.aesonQQ| { "packages": [ { "name": "example-name" } ] } |] + Aeson.toJSON clientSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with a version" $ do + let clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "version": "example-version" } |] + Aeson.toJSON clientSdkInfo `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ClientSdkPackageSpec.hs b/source/test-suite/Patrol/Type/ClientSdkPackageSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ClientSdkPackageSpec.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ClientSdkPackageSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.ClientSdkPackage as ClientSdkPackage +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.ClientSdkPackage" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let clientSdkPackage = ClientSdkPackage.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON clientSdkPackage `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let clientSdkPackage = ClientSdkPackage.empty {ClientSdkPackage.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON clientSdkPackage `Hspec.shouldBe` json + + Hspec.it "works with a version" $ do + let clientSdkPackage = ClientSdkPackage.empty {ClientSdkPackage.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "version": "example-version" } |] + Aeson.toJSON clientSdkPackage `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ContextSpec.hs b/source/test-suite/Patrol/Type/ContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ContextSpec.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ContextSpec where + +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 Patrol.Type.AppContext as AppContext +import qualified Patrol.Type.BrowserContext as BrowserContext +import qualified Patrol.Type.Context as Context +import qualified Patrol.Type.DeviceContext as DeviceContext +import qualified Patrol.Type.GpuContext as GpuContext +import qualified Patrol.Type.OsContext as OsContext +import qualified Patrol.Type.RuntimeContext as RuntimeContext +import qualified Patrol.Type.TraceContext as TraceContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Context" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works with app" $ do + let context = Context.App AppContext.empty {AppContext.appBuild = Text.pack "example-app-build"} + json = [Aeson.aesonQQ| { "app_build": "example-app-build" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with browser" $ do + let context = Context.Browser BrowserContext.empty {BrowserContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with device" $ do + let context = Context.Device DeviceContext.empty {DeviceContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with gpu" $ do + let context = Context.Gpu GpuContext.empty {GpuContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with os" $ do + let context = Context.Os OsContext.empty {OsContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with runtime" $ do + let context = Context.Runtime RuntimeContext.empty {RuntimeContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with trace" $ do + let context = Context.Trace TraceContext.empty {TraceContext.op = Text.pack "example-op"} + json = [Aeson.aesonQQ| { "op": "example-op" } |] + Aeson.toJSON context `Hspec.shouldBe` json + + Hspec.it "works with other" $ do + let context = Context.Other . Map.singleton (Text.pack "example-key") $ Aeson.Bool True + json = [Aeson.aesonQQ| { "example-key": true } |] + Aeson.toJSON context `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/DebugImageSpec.hs b/source/test-suite/Patrol/Type/DebugImageSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/DebugImageSpec.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.DebugImageSpec where + +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 Patrol.Type.AppleDebugImage as AppleDebugImage +import qualified Patrol.Type.DebugImage as DebugImage +import qualified Patrol.Type.NativeDebugImage as NativeDebugImage +import qualified Patrol.Type.ProguardDebugImage as ProguardDebugImage +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.DebugImage" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works with apple" $ do + let appleDebugImage = AppleDebugImage.empty {AppleDebugImage.arch = Text.pack "example-arch"} + debugImage = DebugImage.Apple appleDebugImage + json = [Aeson.aesonQQ| { "arch": "example-arch" } |] + Aeson.toJSON debugImage `Hspec.shouldBe` json + + Hspec.it "works with native" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.arch = Text.pack "example-arch"} + debugImage = DebugImage.Native nativeDebugImage + json = [Aeson.aesonQQ| { "arch": "example-arch" } |] + Aeson.toJSON debugImage `Hspec.shouldBe` json + + Hspec.it "works with proguard" $ do + let proguardDebugImage = ProguardDebugImage.empty {ProguardDebugImage.uuid = Text.pack "example-uuid"} + debugImage = DebugImage.Proguard proguardDebugImage + json = [Aeson.aesonQQ| { "uuid": "example-uuid" } |] + Aeson.toJSON debugImage `Hspec.shouldBe` json + + Hspec.it "works with other" $ do + let debugImage = DebugImage.Other . Map.singleton (Text.pack "example-key") $ Aeson.Bool True + json = [Aeson.aesonQQ| { "example-key": true } |] + Aeson.toJSON debugImage `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/DebugMetaSpec.hs b/source/test-suite/Patrol/Type/DebugMetaSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/DebugMetaSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.DebugMetaSpec where + +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 Patrol.Type.DebugImage as DebugImage +import qualified Patrol.Type.DebugMeta as DebugMeta +import qualified Patrol.Type.SystemSdkInfo as SystemSdkInfo +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.DebugMeta" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let debugMeta = DebugMeta.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON debugMeta `Hspec.shouldBe` json + + Hspec.it "works with an image" $ do + let image = DebugImage.Other . Map.singleton (Text.pack "example-image") $ Aeson.Bool True + debugMeta = DebugMeta.empty {DebugMeta.images = [image]} + json = [Aeson.aesonQQ| { "images": [ { "example-image": true } ] } |] + Aeson.toJSON debugMeta `Hspec.shouldBe` json + + Hspec.it "works with some SDK info" $ do + let systemSdkInfo = SystemSdkInfo.empty {SystemSdkInfo.versionMajor = Just 0} + debugMeta = DebugMeta.empty {DebugMeta.sdkInfo = Just systemSdkInfo} + json = [Aeson.aesonQQ| { "sdk_info": { "version_major": 0 } } |] + Aeson.toJSON debugMeta `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/DeviceContextSpec.hs b/source/test-suite/Patrol/Type/DeviceContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/DeviceContextSpec.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.DeviceContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Patrol.Type.DeviceContext as DeviceContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.DeviceContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let deviceContext = DeviceContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with arch" $ do + let deviceContext = DeviceContext.empty {DeviceContext.arch = Text.pack "example-arch"} + json = [Aeson.aesonQQ| { "arch": "example-arch" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with batteryLevel" $ do + let deviceContext = DeviceContext.empty {DeviceContext.batteryLevel = Just 0.1} + json = [Aeson.aesonQQ| { "battery_level": 0.1 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with batteryStatus" $ do + let deviceContext = DeviceContext.empty {DeviceContext.batteryStatus = Text.pack "example-batteryStatus"} + json = [Aeson.aesonQQ| { "battery_status": "example-batteryStatus" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with bootTime" $ do + let deviceContext = DeviceContext.empty {DeviceContext.bootTime = Just $ Time.UTCTime (Time.fromGregorian 1970 1 1) 0} + json = [Aeson.aesonQQ| { "boot_time": "1970-01-01T00:00:00Z" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with brand" $ do + let deviceContext = DeviceContext.empty {DeviceContext.brand = Text.pack "example-brand"} + json = [Aeson.aesonQQ| { "brand": "example-brand" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with charging" $ do + let deviceContext = DeviceContext.empty {DeviceContext.charging = Just True} + json = [Aeson.aesonQQ| { "charging": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with cpuDescription" $ do + let deviceContext = DeviceContext.empty {DeviceContext.cpuDescription = Text.pack "example-cpuDescription"} + json = [Aeson.aesonQQ| { "cpu_description": "example-cpuDescription" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with deviceType" $ do + let deviceContext = DeviceContext.empty {DeviceContext.deviceType = Text.pack "example-deviceType"} + json = [Aeson.aesonQQ| { "device_type": "example-deviceType" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with deviceUniqueIdentifier" $ do + let deviceContext = DeviceContext.empty {DeviceContext.deviceUniqueIdentifier = Text.pack "example-deviceUniqueIdentifier"} + json = [Aeson.aesonQQ| { "device_unique_identifier": "example-deviceUniqueIdentifier" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with externalFreeStorage" $ do + let deviceContext = DeviceContext.empty {DeviceContext.externalFreeStorage = Just 0} + json = [Aeson.aesonQQ| { "external_free_storage": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with externalStorageSize" $ do + let deviceContext = DeviceContext.empty {DeviceContext.externalStorageSize = Just 0} + json = [Aeson.aesonQQ| { "external_storage_size": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with family" $ do + let deviceContext = DeviceContext.empty {DeviceContext.family = Text.pack "example-family"} + json = [Aeson.aesonQQ| { "family": "example-family" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with freeMemory" $ do + let deviceContext = DeviceContext.empty {DeviceContext.freeMemory = Just 0} + json = [Aeson.aesonQQ| { "free_memory": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with freeStorage" $ do + let deviceContext = DeviceContext.empty {DeviceContext.freeStorage = Just 0} + json = [Aeson.aesonQQ| { "free_storage": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with lowMemory" $ do + let deviceContext = DeviceContext.empty {DeviceContext.lowMemory = Just True} + json = [Aeson.aesonQQ| { "low_memory": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with manufacturer" $ do + let deviceContext = DeviceContext.empty {DeviceContext.manufacturer = Text.pack "example-manufacturer"} + json = [Aeson.aesonQQ| { "manufacturer": "example-manufacturer" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with memorySize" $ do + let deviceContext = DeviceContext.empty {DeviceContext.memorySize = Just 0} + json = [Aeson.aesonQQ| { "memory_size": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with model" $ do + let deviceContext = DeviceContext.empty {DeviceContext.model = Text.pack "example-model"} + json = [Aeson.aesonQQ| { "model": "example-model" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with modelId" $ do + let deviceContext = DeviceContext.empty {DeviceContext.modelId = Text.pack "example-modelId"} + json = [Aeson.aesonQQ| { "model_id": "example-modelId" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with name" $ do + let deviceContext = DeviceContext.empty {DeviceContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with online" $ do + let deviceContext = DeviceContext.empty {DeviceContext.online = Just True} + json = [Aeson.aesonQQ| { "online": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with orientation" $ do + let deviceContext = DeviceContext.empty {DeviceContext.orientation = Text.pack "example-orientation"} + json = [Aeson.aesonQQ| { "orientation": "example-orientation" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with processorCount" $ do + let deviceContext = DeviceContext.empty {DeviceContext.processorCount = Just 0} + json = [Aeson.aesonQQ| { "processor_count": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with processorFrequency" $ do + let deviceContext = DeviceContext.empty {DeviceContext.processorFrequency = Just 0.1} + json = [Aeson.aesonQQ| { "processor_frequency": 0.1 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with screenDensity" $ do + let deviceContext = DeviceContext.empty {DeviceContext.screenDensity = Just 0.1} + json = [Aeson.aesonQQ| { "screen_density": 0.1 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with screenDpi" $ do + let deviceContext = DeviceContext.empty {DeviceContext.screenDpi = Just 0.1} + json = [Aeson.aesonQQ| { "screen_dpi": 0.1 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with screenResolution" $ do + let deviceContext = DeviceContext.empty {DeviceContext.screenResolution = Text.pack "example-screenResolution"} + json = [Aeson.aesonQQ| { "screen_resolution": "example-screenResolution" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with simulator" $ do + let deviceContext = DeviceContext.empty {DeviceContext.simulator = Just True} + json = [Aeson.aesonQQ| { "simulator": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with storageSize" $ do + let deviceContext = DeviceContext.empty {DeviceContext.storageSize = Just 0} + json = [Aeson.aesonQQ| { "storage_size": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with supportsAccelerometer" $ do + let deviceContext = DeviceContext.empty {DeviceContext.supportsAccelerometer = Just True} + json = [Aeson.aesonQQ| { "supports_accelerometer": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with supportsAudio" $ do + let deviceContext = DeviceContext.empty {DeviceContext.supportsAudio = Just True} + json = [Aeson.aesonQQ| { "supports_audio": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with supportsGyroscope" $ do + let deviceContext = DeviceContext.empty {DeviceContext.supportsGyroscope = Just True} + json = [Aeson.aesonQQ| { "supports_gyroscope": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with supportsLocationService" $ do + let deviceContext = DeviceContext.empty {DeviceContext.supportsLocationService = Just True} + json = [Aeson.aesonQQ| { "supports_location_service": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with supportsVibration" $ do + let deviceContext = DeviceContext.empty {DeviceContext.supportsVibration = Just True} + json = [Aeson.aesonQQ| { "supports_vibration": true } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with timezone" $ do + let deviceContext = DeviceContext.empty {DeviceContext.timezone = Text.pack "example-timezone"} + json = [Aeson.aesonQQ| { "timezone": "example-timezone" } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json + + Hspec.it "works with usableMemory" $ do + let deviceContext = DeviceContext.empty {DeviceContext.usableMemory = Just 0} + json = [Aeson.aesonQQ| { "usable_memory": 0 } |] + Aeson.toJSON deviceContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/DsnSpec.hs b/source/test-suite/Patrol/Type/DsnSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/DsnSpec.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.DsnSpec where + +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Network.URI.Static as Uri +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 "fromUri" $ do + Hspec.it "fails with an invalid DSN" $ do + Dsn.fromUri [Uri.uri|a:|] `Hspec.shouldBe` Nothing + + Hspec.it "succeeds with a minimal DSN" $ do + let dsn = + 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' + } + Dsn.fromUri [Uri.uri|a://b@c/d|] `Hspec.shouldBe` Just dsn + + Hspec.it "succeeds with a maximal DSN" $ do + let dsn = + 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' + } + Dsn.fromUri [Uri.uri|a://b:c@d:5/f/g|] `Hspec.shouldBe` Just dsn + + Hspec.it "fails with a query" $ do + Dsn.fromUri [Uri.uri|a://b@c/d?|] `Hspec.shouldBe` Nothing + + Hspec.it "fails with a fragment" $ 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 = + 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' + } + Dsn.intoUri dsn `Hspec.shouldBe` [Uri.uri|a://b@c/d|] + + Hspec.it "converts a maximal DSN into URI" $ do + let dsn = + 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' + } + Dsn.intoUri dsn `Hspec.shouldBe` [Uri.uri|a://b:c@d:5/f/g|] + + Hspec.describe "intoAuthorization" $ do + Hspec.it "works without a secret key" $ do + dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|a://b@c/d|] + let byteString = Text.encodeUtf8 . Text.pack $ "Sentry sentry_version=7,sentry_client=patrol/" <> Version.string <> ",sentry_key=b" + Dsn.intoAuthorization dsn `Hspec.shouldBe` byteString + + Hspec.it "works with a secret key" $ do + dsn <- maybe (fail "invalid DSN") pure $ Dsn.fromUri [Uri.uri|a://b:c@d/e|] + let byteString = Text.encodeUtf8 . Text.pack $ "Sentry sentry_version=7,sentry_client=patrol/" <> Version.string <> ",sentry_key=b,sentry_secret=c" + Dsn.intoAuthorization dsn `Hspec.shouldBe` byteString diff --git a/source/test-suite/Patrol/Type/ErrorTypeSpec.hs b/source/test-suite/Patrol/Type/ErrorTypeSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ErrorTypeSpec.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ErrorTypeSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.ErrorType as ErrorType +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.ErrorType" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works for ClockDrift" $ do + Aeson.toJSON ErrorType.ClockDrift `Hspec.shouldBe` [Aeson.aesonQQ| "clock_drift" |] + + Hspec.it "works for FetchGenericError" $ do + Aeson.toJSON ErrorType.FetchGenericError `Hspec.shouldBe` [Aeson.aesonQQ| "fetch_generic_error" |] + + Hspec.it "works for FetchInvalidEncoding" $ do + Aeson.toJSON ErrorType.FetchInvalidEncoding `Hspec.shouldBe` [Aeson.aesonQQ| "fetch_invalid_source_encoding" |] + + Hspec.it "works for FetchInvalidHttpCode" $ do + Aeson.toJSON ErrorType.FetchInvalidHttpCode `Hspec.shouldBe` [Aeson.aesonQQ| "fetch_invalid_http_code" |] + + Hspec.it "works for FetchTimeout" $ do + Aeson.toJSON ErrorType.FetchTimeout `Hspec.shouldBe` [Aeson.aesonQQ| "fetch_timeout" |] + + Hspec.it "works for FetchTooLarge" $ do + Aeson.toJSON ErrorType.FetchTooLarge `Hspec.shouldBe` [Aeson.aesonQQ| "fetch_too_large" |] + + Hspec.it "works for FutureTimestamp" $ do + Aeson.toJSON ErrorType.FutureTimestamp `Hspec.shouldBe` [Aeson.aesonQQ| "future_timestamp" |] + + Hspec.it "works for InvalidAttribute" $ do + Aeson.toJSON ErrorType.InvalidAttribute `Hspec.shouldBe` [Aeson.aesonQQ| "invalid_attribute" |] + + Hspec.it "works for InvalidData" $ do + Aeson.toJSON ErrorType.InvalidData `Hspec.shouldBe` [Aeson.aesonQQ| "invalid_data" |] + + Hspec.it "works for InvalidEnvironment" $ do + Aeson.toJSON ErrorType.InvalidEnvironment `Hspec.shouldBe` [Aeson.aesonQQ| "invalid_environment" |] + + Hspec.it "works for JsFetchTimeout" $ do + Aeson.toJSON ErrorType.JsFetchTimeout `Hspec.shouldBe` [Aeson.aesonQQ| "js_fetch_timeout" |] + + Hspec.it "works for JsGenericFetchError" $ do + Aeson.toJSON ErrorType.JsGenericFetchError `Hspec.shouldBe` [Aeson.aesonQQ| "js_generic_fetch_error" |] + + Hspec.it "works for JsInvalidContent" $ do + Aeson.toJSON ErrorType.JsInvalidContent `Hspec.shouldBe` [Aeson.aesonQQ| "js_invalid_content" |] + + Hspec.it "works for JsInvalidHttpCode" $ do + Aeson.toJSON ErrorType.JsInvalidHttpCode `Hspec.shouldBe` [Aeson.aesonQQ| "js_invalid_http_code" |] + + Hspec.it "works for JsInvalidSourceEncoding" $ do + Aeson.toJSON ErrorType.JsInvalidSourceEncoding `Hspec.shouldBe` [Aeson.aesonQQ| "js_invalid_source_encoding" |] + + Hspec.it "works for JsInvalidSourcemap" $ do + Aeson.toJSON ErrorType.JsInvalidSourcemap `Hspec.shouldBe` [Aeson.aesonQQ| "js_invalid_source" |] + + Hspec.it "works for JsInvalidSourcemapLocation" $ do + Aeson.toJSON ErrorType.JsInvalidSourcemapLocation `Hspec.shouldBe` [Aeson.aesonQQ| "js_invalid_sourcemap_location" |] + + Hspec.it "works for JsMissingSource" $ do + Aeson.toJSON ErrorType.JsMissingSource `Hspec.shouldBe` [Aeson.aesonQQ| "js_no_source" |] + + Hspec.it "works for JsNoColumn" $ do + Aeson.toJSON ErrorType.JsNoColumn `Hspec.shouldBe` [Aeson.aesonQQ| "js_no_column" |] + + Hspec.it "works for JsTooLarge" $ do + Aeson.toJSON ErrorType.JsTooLarge `Hspec.shouldBe` [Aeson.aesonQQ| "js_too_large" |] + + Hspec.it "works for JsTooManyRemoteSources" $ do + Aeson.toJSON ErrorType.JsTooManyRemoteSources `Hspec.shouldBe` [Aeson.aesonQQ| "js_too_many_sources" |] + + Hspec.it "works for MissingAttribute" $ do + Aeson.toJSON ErrorType.MissingAttribute `Hspec.shouldBe` [Aeson.aesonQQ| "missing_attribute" |] + + Hspec.it "works for NativeBadDsym" $ do + Aeson.toJSON ErrorType.NativeBadDsym `Hspec.shouldBe` [Aeson.aesonQQ| "native_bad_dsym" |] + + Hspec.it "works for NativeInternalFailure" $ do + Aeson.toJSON ErrorType.NativeInternalFailure `Hspec.shouldBe` [Aeson.aesonQQ| "native_internal_failure" |] + + Hspec.it "works for NativeMissingDsym" $ do + Aeson.toJSON ErrorType.NativeMissingDsym `Hspec.shouldBe` [Aeson.aesonQQ| "native_missing_dsym" |] + + Hspec.it "works for NativeMissingOptionallyBundledDsym" $ do + Aeson.toJSON ErrorType.NativeMissingOptionallyBundledDsym `Hspec.shouldBe` [Aeson.aesonQQ| "native_optionally_bundled_dsym" |] + + Hspec.it "works for NativeMissingSymbol" $ do + Aeson.toJSON ErrorType.NativeMissingSymbol `Hspec.shouldBe` [Aeson.aesonQQ| "native_missing_symbol" |] + + Hspec.it "works for NativeMissingSystemDsym" $ do + Aeson.toJSON ErrorType.NativeMissingSystemDsym `Hspec.shouldBe` [Aeson.aesonQQ| "native_missing_system_dsym" |] + + Hspec.it "works for NativeNoCrashedThread" $ do + Aeson.toJSON ErrorType.NativeNoCrashedThread `Hspec.shouldBe` [Aeson.aesonQQ| "native_no_crashed_thread" |] + + Hspec.it "works for NativeSimulatorFrame" $ do + Aeson.toJSON ErrorType.NativeSimulatorFrame `Hspec.shouldBe` [Aeson.aesonQQ| "native_simulator_frame" |] + + Hspec.it "works for NativeSymbolicatorFailed" $ do + Aeson.toJSON ErrorType.NativeSymbolicatorFailed `Hspec.shouldBe` [Aeson.aesonQQ| "native_symbolicator_failed" |] + + Hspec.it "works for NativeUnknownImage" $ do + Aeson.toJSON ErrorType.NativeUnknownImage `Hspec.shouldBe` [Aeson.aesonQQ| "native_unknown_image" |] + + Hspec.it "works for PastTimestamp" $ do + Aeson.toJSON ErrorType.PastTimestamp `Hspec.shouldBe` [Aeson.aesonQQ| "past_timestamp" |] + + Hspec.it "works for ProguardMissingLineno" $ do + Aeson.toJSON ErrorType.ProguardMissingLineno `Hspec.shouldBe` [Aeson.aesonQQ| "proguard_missing_lineno" |] + + Hspec.it "works for ProguardMissingMapping" $ do + Aeson.toJSON ErrorType.ProguardMissingMapping `Hspec.shouldBe` [Aeson.aesonQQ| "proguard_missing_mapping" |] + + Hspec.it "works for RestrictedIp" $ do + Aeson.toJSON ErrorType.RestrictedIp `Hspec.shouldBe` [Aeson.aesonQQ| "restricted_ip" |] + + Hspec.it "works for SecurityViolation" $ do + Aeson.toJSON ErrorType.SecurityViolation `Hspec.shouldBe` [Aeson.aesonQQ| "security_violation" |] + + Hspec.it "works for TooLargeForCache" $ do + Aeson.toJSON ErrorType.TooLargeForCache `Hspec.shouldBe` [Aeson.aesonQQ| "too_large_for_cache" |] + + Hspec.it "works for UnknownError" $ do + Aeson.toJSON ErrorType.UnknownError `Hspec.shouldBe` [Aeson.aesonQQ| "unknown_error" |] + + Hspec.it "works for ValueTooLong" $ do + Aeson.toJSON ErrorType.ValueTooLong `Hspec.shouldBe` [Aeson.aesonQQ| "value_too_long" |] diff --git a/source/test-suite/Patrol/Type/EventIdSpec.hs b/source/test-suite/Patrol/Type/EventIdSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/EventIdSpec.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + +module Patrol.Type.EventIdSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Data.UUID as Uuid +import qualified Data.UUID.V4 as Uuid +import qualified Patrol.Type.EventId as EventId +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.EventId" $ do + Hspec.describe "fromUuid" $ do + Hspec.it "converts from UUID" $ do + uuid <- Uuid.nextRandom + EventId.fromUuid uuid `Hspec.shouldBe` EventId.EventId uuid + + Hspec.describe "intoUuid" $ do + Hspec.it "converts into UUID" $ do + uuid <- Uuid.nextRandom + EventId.intoUuid (EventId.fromUuid uuid) `Hspec.shouldBe` uuid + + Hspec.describe "random" $ do + Hspec.it "generates a non-nil UUID" $ do + eventId <- EventId.random + eventId `Hspec.shouldNotBe` EventId.empty + + Hspec.describe "intoText" $ do + Hspec.it "converts into text" $ do + let eventId = EventId.fromUuid $ Uuid.fromWords64 0x0011223344556677 0x8899aabbccddeeff + EventId.intoText eventId `Hspec.shouldBe` Text.pack "00112233445566778899aabbccddeeff" + + Hspec.describe "fromText" $ do + Hspec.it "converts from text" $ do + let eventId = EventId.fromUuid $ Uuid.fromWords64 0x0011223344556677 0x8899aabbccddeeff + EventId.fromText (Text.pack "00112233445566778899aabbccddeeff") `Hspec.shouldBe` Just eventId + + Hspec.it "succeeds with uppercase digits" $ do + let eventId = EventId.fromUuid $ Uuid.fromWords64 0x0011223344556677 0x8899aabbccddeeff + EventId.fromText (Text.pack "00112233445566778899AABBCCDDEEFF") `Hspec.shouldBe` Just eventId + + Hspec.it "fails with not enough digits" $ do + EventId.fromText (Text.pack "0123456789abcdef0123456789abcde") `Hspec.shouldBe` Nothing + + Hspec.it "fails with too many digits" $ do + EventId.fromText (Text.pack "0123456789abcdef0123456789abcdef0") `Hspec.shouldBe` Nothing + + Hspec.it "fails with invalid hexadecimal" $ do + EventId.fromText (Text.pack "Z123456789abcdef0123456789abcdef") `Hspec.shouldBe` Nothing + EventId.fromText (Text.pack "0123456789Zbcdef0123456789abcdef") `Hspec.shouldBe` Nothing + EventId.fromText (Text.pack "0123456789abcdef0123456789Zbcdef") `Hspec.shouldBe` Nothing + + Hspec.describe "FromJSON" $ do + Hspec.it "works" $ do + let json = [Aeson.aesonQQ| "00112233445566778899aabbccddeeff" |] + eventId = EventId.fromUuid $ Uuid.fromWords64 0x0011223344556677 0x8899aabbccddeeff + Aeson.fromJSON json `Hspec.shouldBe` Aeson.Success eventId + + Hspec.it "fails with not enough digits" $ do + let json = [Aeson.aesonQQ| "" |] + Aeson.fromJSON @EventId.EventId json `Hspec.shouldBe` Aeson.Error "invalid EventId" + + Hspec.it "fails with the wrong type" $ do + let json = [Aeson.aesonQQ| null |] + Aeson.fromJSON @EventId.EventId json `Hspec.shouldBe` Aeson.Error "parsing EventId failed, expected String, but encountered Null" + + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let eventId = EventId.fromUuid $ Uuid.fromWords64 0x0011223344556677 0x8899aabbccddeeff + json = [Aeson.aesonQQ| "00112233445566778899aabbccddeeff" |] + Aeson.toJSON eventId `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/EventProcessingErrorSpec.hs b/source/test-suite/Patrol/Type/EventProcessingErrorSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/EventProcessingErrorSpec.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.EventProcessingErrorSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.EventProcessingError as EventProcessingError +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.EventProcessingError" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let eventProcessingError = EventProcessingError.empty + json = [Aeson.aesonQQ| { "type": "unknown_error" } |] + Aeson.toJSON eventProcessingError `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let eventProcessingError = EventProcessingError.empty {EventProcessingError.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "type": "unknown_error", "name": "example-name" } |] + Aeson.toJSON eventProcessingError `Hspec.shouldBe` json + + Hspec.it "works with a value" $ do + let eventProcessingError = EventProcessingError.empty {EventProcessingError.value = Aeson.Bool True} + json = [Aeson.aesonQQ| { "type": "unknown_error", "value": true } |] + Aeson.toJSON eventProcessingError `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/EventSpec.hs b/source/test-suite/Patrol/Type/EventSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/EventSpec.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.EventSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Map as Map +import qualified Data.Maybe as Maybe +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +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 +import qualified Patrol.Type.ClientSdkInfo as ClientSdkInfo +import qualified Patrol.Type.Context as Context +import qualified Patrol.Type.DebugImage as DebugImage +import qualified Patrol.Type.DebugMeta as DebugMeta +import qualified Patrol.Type.Dsn as Dsn +import qualified Patrol.Type.Event as Event +import qualified Patrol.Type.EventId as EventId +import qualified Patrol.Type.EventProcessingError as EventProcessingError +import qualified Patrol.Type.EventType as EventType +import qualified Patrol.Type.Exception as Exception +import qualified Patrol.Type.Exceptions as Exceptions +import qualified Patrol.Type.Level as Level +import qualified Patrol.Type.LogEntry as LogEntry +import qualified Patrol.Type.Platform as Platform +import qualified Patrol.Type.Request as Request +import qualified Patrol.Type.TransactionInfo as TransactionInfo +import qualified Patrol.Type.User as User +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Event" $ do + Hspec.describe "new" $ do + Hspec.it "generates an ID" $ do + event <- Event.new + Event.eventId event `Hspec.shouldNotBe` EventId.empty + + Hspec.it "sets the timestamp" $ do + event <- Event.new + Event.timestamp event `Hspec.shouldSatisfy` Maybe.isJust + + Hspec.it "sets the platform" $ do + event <- Event.new + Event.platform event `Hspec.shouldBe` Just Platform.Haskell + + Hspec.it "sets the level" $ do + event <- Event.new + Event.level event `Hspec.shouldBe` Just Level.Error + + Hspec.it "sets the environment" $ do + event <- Event.new + Event.environment event `Hspec.shouldBe` Text.pack "production" + + Hspec.it "sets the version" $ do + event <- Event.new + Event.version event `Hspec.shouldBe` Constant.sentryVersion + + Hspec.it "sets the type" $ do + event <- Event.new + Event.type_ event `Hspec.shouldBe` Just EventType.Default + + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let event = Event.empty + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a breadcrumb" $ do + let breadcrumb = Breadcrumb.empty {Breadcrumb.category = Text.pack "example-category"} + breadcrumbs = Breadcrumbs.empty {Breadcrumbs.values = [breadcrumb]} + event = Event.empty {Event.breadcrumbs = Just breadcrumbs} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "breadcrumbs": { "values": [ { "category": "example-category" } ] } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a context" $ do + let context = Context.Other . Map.singleton (Text.pack "example-key") $ Aeson.Bool True + contexts = Map.singleton (Text.pack "example-context") context + event = Event.empty {Event.contexts = contexts} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "contexts": { "example-context": { "example-key": true } } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with some debug meta" $ do + let image = DebugImage.Other . Map.singleton (Text.pack "example-image") $ Aeson.Bool True + debugMeta = DebugMeta.empty {DebugMeta.images = [image]} + event = Event.empty {Event.debugMeta = Just debugMeta} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "debug_meta": { "images": [ { "example-image": true } ] } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a dist" $ do + let event = Event.empty {Event.dist = Text.pack "example-dist"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "dist": "example-dist" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with an environment" $ do + let event = Event.empty {Event.environment = Text.pack "example-environment"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "environment": "example-environment" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with an event processing error" $ do + let eventProcessingError = EventProcessingError.empty + event = Event.empty {Event.errors = [eventProcessingError]} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "errors": [ { "type": "unknown_error" } ] } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with an exception" $ do + let exception = Exception.empty {Exception.type_ = Text.pack "example-type"} + exceptions = Exceptions.empty {Exceptions.values = [exception]} + event = Event.empty {Event.exception = Just exceptions} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "exception": { "values": [ { "type": "example-type" } ] } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with some extra" $ do + let event = Event.empty {Event.extra = Map.singleton (Text.pack "example-extra") (Aeson.Bool True)} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "extra": { "example-extra": true } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a fingerprint" $ do + let event = Event.empty {Event.fingerprint = [Text.pack "example-fingerprint"]} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "fingerprint": ["example-fingerprint"] } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a level" $ do + let event = Event.empty {Event.level = Just Level.Error} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "level": "error" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a log entry" $ do + let logEntry = LogEntry.empty {LogEntry.message = Text.pack "example-message"} + event = Event.empty {Event.logentry = Just logEntry} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "logentry": { "message": "example-message" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a logger" $ do + let event = Event.empty {Event.logger = Text.pack "example-logger"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "logger": "example-logger" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with some modules" $ do + let event = Event.empty {Event.modules = Map.fromList [(Text.pack "module-name", Text.pack "module-version")]} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "modules": { "module-name": "module-version" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a platform" $ do + let event = Event.empty {Event.platform = Just Platform.Haskell} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "platform": "haskell" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a release" $ do + let event = Event.empty {Event.release = Text.pack "example-release"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "release": "example-release" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a request" $ do + let request = Request.empty {Request.fragment = Text.pack "example-fragment"} + event = Event.empty {Event.request = Just request} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "request": { "fragment": "example-fragment" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with an SDK" $ do + let clientSdkInfo = ClientSdkInfo.empty {ClientSdkInfo.name = Text.pack "example-name"} + event = Event.empty {Event.sdk = Just clientSdkInfo} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "sdk": { "name": "example-name" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a server name" $ do + let event = Event.empty {Event.serverName = Text.pack "example-server-name"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "server_name": "example-server-name" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with some tags" $ do + let event = Event.empty {Event.tags = Map.fromList [(Text.pack "tag-key", Text.pack "tag-value")]} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "tags": { "tag-key": "tag-value" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a time spent" $ do + let event = Event.empty {Event.timeSpent = Just 1.2} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "time_spent": 1.2 } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a timestamp" $ do + let event = Event.empty {Event.timestamp = Just $ Time.UTCTime (Time.fromGregorian 1970 1 1) 0} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "timestamp": "1970-01-01T00:00:00Z" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a transaction" $ do + let event = Event.empty {Event.transaction = Text.pack "example-transaction"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "transaction": "example-transaction" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with some transaction info" $ do + let transactionInfo = TransactionInfo.empty {TransactionInfo.original = Text.pack "example-original"} + event = Event.empty {Event.transactionInfo = Just transactionInfo} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "transaction_info": { "original": "example-original" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a type" $ do + let event = Event.empty {Event.type_ = Just EventType.Default} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "type": "default" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a user" $ do + let user = User.empty {User.email = Text.pack "example-email"} + event = Event.empty {Event.user = Just user} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "user": { "email": "example-email" } } |] + Aeson.toJSON event `Hspec.shouldBe` json + + Hspec.it "works with a version" $ do + let event = Event.empty {Event.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "event_id": "00000000000000000000000000000000", "version": "example-version" } |] + Aeson.toJSON event `Hspec.shouldBe` json + + 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|] + 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|] + 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|] + 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|] + 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|] + 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|] + event <- Event.new + request <- Event.intoRequest dsn event + case Client.requestBody request of + Client.RequestBodyBS byteString -> byteString `Hspec.shouldBe` LazyByteString.toStrict (Aeson.encode event) + _ -> 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|] + 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|] + 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|] + event <- Event.new + request <- Event.intoRequest dsn event + lookup Constant.xSentryAuth (Client.requestHeaders request) `Hspec.shouldSatisfy` Maybe.isJust diff --git a/source/test-suite/Patrol/Type/EventTypeSpec.hs b/source/test-suite/Patrol/Type/EventTypeSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/EventTypeSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.EventTypeSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.EventType as EventType +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.EventType" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works for Csp" $ do + Aeson.toJSON EventType.Csp `Hspec.shouldBe` [Aeson.aesonQQ| "csp" |] + + Hspec.it "works for Default" $ do + Aeson.toJSON EventType.Default `Hspec.shouldBe` [Aeson.aesonQQ| "default" |] + + Hspec.it "works for Error" $ do + Aeson.toJSON EventType.Error `Hspec.shouldBe` [Aeson.aesonQQ| "error" |] + + Hspec.it "works for Expectct" $ do + Aeson.toJSON EventType.Expectct `Hspec.shouldBe` [Aeson.aesonQQ| "expectct" |] + + Hspec.it "works for Expectstaple" $ do + Aeson.toJSON EventType.Expectstaple `Hspec.shouldBe` [Aeson.aesonQQ| "expectstaple" |] + + Hspec.it "works for Hpkp" $ do + Aeson.toJSON EventType.Hpkp `Hspec.shouldBe` [Aeson.aesonQQ| "hpkp" |] + + Hspec.it "works for Transaction" $ do + Aeson.toJSON EventType.Transaction `Hspec.shouldBe` [Aeson.aesonQQ| "transaction" |] diff --git a/source/test-suite/Patrol/Type/ExceptionSpec.hs b/source/test-suite/Patrol/Type/ExceptionSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ExceptionSpec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE QuasiQuotes #-} + +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 Patrol.Type.Exception as Exception +import qualified Patrol.Type.Mechanism as Mechanism +import qualified Patrol.Type.Stacktrace as Stacktrace +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Exception" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let exception = Exception.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON exception `Hspec.shouldBe` json + + Hspec.it "works with a mechanism" $ do + let mechanism = Mechanism.empty {Mechanism.type_ = Text.pack "example-mechanism"} + exception = Exception.empty {Exception.mechanism = Just mechanism} + json = [Aeson.aesonQQ| { "mechanism": { "type": "example-mechanism" } } |] + Aeson.toJSON exception `Hspec.shouldBe` json + + Hspec.it "works with a module" $ do + let exception = Exception.empty {Exception.module_ = Text.pack "example-module"} + json = [Aeson.aesonQQ| { "module": "example-module" } |] + Aeson.toJSON exception `Hspec.shouldBe` json + + Hspec.it "works with a stack trace" $ do + let stacktrace = Stacktrace.empty {Stacktrace.registers = Map.singleton (Text.pack "example-key") $ Text.pack "example-value"} + exception = Exception.empty {Exception.stacktrace = Just stacktrace} + json = [Aeson.aesonQQ| { "stacktrace": { "registers": { "example-key": "example-value" } } } |] + Aeson.toJSON exception `Hspec.shouldBe` json + + Hspec.it "works with a thread ID" $ do + let exception = Exception.empty {Exception.threadId = Text.pack "example-thread-id"} + json = [Aeson.aesonQQ| { "thread_id": "example-thread-id" } |] + Aeson.toJSON exception `Hspec.shouldBe` json + + Hspec.it "works with a type" $ do + let exception = Exception.empty {Exception.type_ = Text.pack "example-type"} + json = [Aeson.aesonQQ| { "type": "example-type" } |] + Aeson.toJSON exception `Hspec.shouldBe` json + + Hspec.it "works with a value" $ do + let exception = Exception.empty {Exception.value = Text.pack "example-value"} + 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.it "sets the type" $ do + Exception.type_ exception `Hspec.shouldBe` Text.pack "IOException" + + Hspec.it "sets the value" $ do + Exception.value exception `Hspec.shouldBe` Text.pack "user error (example-exception-value)" diff --git a/source/test-suite/Patrol/Type/ExceptionsSpec.hs b/source/test-suite/Patrol/Type/ExceptionsSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ExceptionsSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ExceptionsSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.Exception as Exception +import qualified Patrol.Type.Exceptions as Exceptions +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Exceptions" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let exceptions = Exceptions.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON exceptions `Hspec.shouldBe` json + + Hspec.it "works with a value" $ do + let exception = Exception.empty {Exception.type_ = Text.pack "example-type"} + exceptions = Exceptions.empty {Exceptions.values = [exception]} + json = [Aeson.aesonQQ| { "values": [ { "type": "example-type" } ] } |] + Aeson.toJSON exceptions `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/FrameSpec.hs b/source/test-suite/Patrol/Type/FrameSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/FrameSpec.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.FrameSpec where + +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.Frame as Frame +import qualified Patrol.Type.Platform as Platform +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Frame" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let frame = Frame.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with an abs path" $ do + let frame = Frame.empty {Frame.absPath = Text.pack "example-abs-path"} + json = [Aeson.aesonQQ| { "abs_path": "example-abs-path" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with an addr mode" $ do + let frame = Frame.empty {Frame.addrMode = Text.pack "example-addr-mode"} + json = [Aeson.aesonQQ| { "addr_mode": "example-addr-mode" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a colno" $ do + let frame = Frame.empty {Frame.colno = Just 0} + json = [Aeson.aesonQQ| { "colno": 0 } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a context line" $ do + let frame = Frame.empty {Frame.contextLine = Text.pack "example-context-line"} + json = [Aeson.aesonQQ| { "context_line": "example-context-line" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a filename" $ do + let frame = Frame.empty {Frame.filename = Text.pack "example-filename"} + json = [Aeson.aesonQQ| { "filename": "example-filename" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a function" $ do + let frame = Frame.empty {Frame.function = Text.pack "example-function"} + json = [Aeson.aesonQQ| { "function": "example-function" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with an image addr" $ do + let frame = Frame.empty {Frame.imageAddr = Text.pack "example-image-addr"} + json = [Aeson.aesonQQ| { "image_addr": "example-image-addr" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with an in app flag" $ do + let frame = Frame.empty {Frame.inApp = Just True} + json = [Aeson.aesonQQ| { "in_app": true } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with an instruction addr" $ do + let frame = Frame.empty {Frame.instructionAddr = Text.pack "example-instruction-addr"} + json = [Aeson.aesonQQ| { "instruction_addr": "example-instruction-addr" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a lineno" $ do + let frame = Frame.empty {Frame.lineno = Just 0} + json = [Aeson.aesonQQ| { "lineno": 0 } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a module" $ do + let frame = Frame.empty {Frame.module_ = Text.pack "example-module"} + json = [Aeson.aesonQQ| { "module": "example-module" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a package" $ do + let frame = Frame.empty {Frame.package = Text.pack "example-package"} + json = [Aeson.aesonQQ| { "package": "example-package" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a platform" $ do + let frame = Frame.empty {Frame.platform = Just Platform.Other} + json = [Aeson.aesonQQ| { "platform": "other" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with some post context" $ do + let frame = Frame.empty {Frame.postContext = [Text.pack "example-post-context"]} + json = [Aeson.aesonQQ| { "post_context": [ "example-post-context" ] } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with some pre context" $ do + let frame = Frame.empty {Frame.preContext = [Text.pack "example-pre-context"]} + json = [Aeson.aesonQQ| { "pre_context": [ "example-pre-context" ] } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a raw function" $ do + let frame = Frame.empty {Frame.rawFunction = Text.pack "example-raw-function"} + json = [Aeson.aesonQQ| { "raw_function": "example-raw-function" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a stack start flag" $ do + let frame = Frame.empty {Frame.stackStart = Just True} + json = [Aeson.aesonQQ| { "stack_start": true } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with a symbol addr" $ do + let frame = Frame.empty {Frame.symbolAddr = Text.pack "example-symbol-addr"} + json = [Aeson.aesonQQ| { "symbol_addr": "example-symbol-addr" } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.it "works with some vars" $ do + let frame = Frame.empty {Frame.vars = Map.singleton (Text.pack "example-var") Aeson.Null} + json = [Aeson.aesonQQ| { "vars": { "example-var": null } } |] + Aeson.toJSON frame `Hspec.shouldBe` json + + Hspec.describe "fromSrcLoc" $ do + Hspec.it "works" $ do + let srcLoc = + Stack.SrcLoc + { Stack.srcLocEndCol = 3, + Stack.srcLocEndLine = 4, + Stack.srcLocFile = "example-file", + Stack.srcLocModule = "example-module", + Stack.srcLocPackage = "example-package", + Stack.srcLocStartCol = 1, + Stack.srcLocStartLine = 2 + } + frame = + Frame.empty + { Frame.colno = Just 1, + Frame.filename = Text.pack "example-file", + Frame.lineno = Just 2, + Frame.module_ = Text.pack "example-module", + Frame.package = Text.pack "example-package" + } + Frame.fromSrcLoc srcLoc `Hspec.shouldBe` frame diff --git a/source/test-suite/Patrol/Type/GeoSpec.hs b/source/test-suite/Patrol/Type/GeoSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/GeoSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.GeoSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.Geo as Geo +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Geo" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let geo = Geo.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON geo `Hspec.shouldBe` json + + Hspec.it "works with a city" $ do + let geo = Geo.empty {Geo.city = Text.pack "example-city"} + json = [Aeson.aesonQQ| { "city": "example-city" } |] + Aeson.toJSON geo `Hspec.shouldBe` json + + Hspec.it "works with a country code" $ do + let geo = Geo.empty {Geo.countryCode = Text.pack "example-country-code"} + json = [Aeson.aesonQQ| { "country_code": "example-country-code" } |] + Aeson.toJSON geo `Hspec.shouldBe` json + + Hspec.it "works with a region" $ do + let geo = Geo.empty {Geo.region = Text.pack "example-region"} + json = [Aeson.aesonQQ| { "region": "example-region" } |] + Aeson.toJSON geo `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/GpuContextSpec.hs b/source/test-suite/Patrol/Type/GpuContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/GpuContextSpec.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.GpuContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.GpuContext as GpuContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.GpuContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let gpuContext = GpuContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with apiType" $ do + let gpuContext = GpuContext.empty {GpuContext.apiType = Text.pack "example-apiType"} + json = [Aeson.aesonQQ| { "api_type": "example-apiType" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with graphicsShaderLevel" $ do + let gpuContext = GpuContext.empty {GpuContext.graphicsShaderLevel = Text.pack "example-graphicsShaderLevel"} + json = [Aeson.aesonQQ| { "graphics_shader_level": "example-graphicsShaderLevel" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with id" $ do + let gpuContext = GpuContext.empty {GpuContext.id = Aeson.Bool True} + json = [Aeson.aesonQQ| { "id": true } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with maxTextureSize" $ do + let gpuContext = GpuContext.empty {GpuContext.maxTextureSize = Just 0} + json = [Aeson.aesonQQ| { "max_texture_size": 0 } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with memorySize" $ do + let gpuContext = GpuContext.empty {GpuContext.memorySize = Just 0.1} + json = [Aeson.aesonQQ| { "memory_size": 0.1 } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with multiThreadedRendering" $ do + let gpuContext = GpuContext.empty {GpuContext.multiThreadedRendering = Just True} + json = [Aeson.aesonQQ| { "multi_threaded_rendering": true } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with name" $ do + let gpuContext = GpuContext.empty {GpuContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with npotSupport" $ do + let gpuContext = GpuContext.empty {GpuContext.npotSupport = Text.pack "example-npotSupport"} + json = [Aeson.aesonQQ| { "npot_support": "example-npotSupport" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with supportsComputeShaders" $ do + let gpuContext = GpuContext.empty {GpuContext.supportsComputeShaders = Just True} + json = [Aeson.aesonQQ| { "supports_compute_shaders": true } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with supportsGeometryShaders" $ do + let gpuContext = GpuContext.empty {GpuContext.supportsGeometryShaders = Just True} + json = [Aeson.aesonQQ| { "supports_geometry_shaders": true } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with supportsRayTracing" $ do + let gpuContext = GpuContext.empty {GpuContext.supportsRayTracing = Just True} + json = [Aeson.aesonQQ| { "supports_ray_tracing": true } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with vendorId" $ do + let gpuContext = GpuContext.empty {GpuContext.vendorId = Text.pack "example-vendorId"} + json = [Aeson.aesonQQ| { "vendor_id": "example-vendorId" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with vendorName" $ do + let gpuContext = GpuContext.empty {GpuContext.vendorName = Text.pack "example-vendorName"} + json = [Aeson.aesonQQ| { "vendor_name": "example-vendorName" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json + + Hspec.it "works with version" $ do + let gpuContext = GpuContext.empty {GpuContext.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "version": "example-version" } |] + Aeson.toJSON gpuContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/LevelSpec.hs b/source/test-suite/Patrol/Type/LevelSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/LevelSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.LevelSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.Level as Level +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Level" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works for Debug" $ do + Aeson.toJSON Level.Debug `Hspec.shouldBe` [Aeson.aesonQQ| "debug" |] + + Hspec.it "works for Info" $ do + Aeson.toJSON Level.Info `Hspec.shouldBe` [Aeson.aesonQQ| "info" |] + + Hspec.it "works for Warning" $ do + Aeson.toJSON Level.Warning `Hspec.shouldBe` [Aeson.aesonQQ| "warning" |] + + Hspec.it "works for Error" $ do + Aeson.toJSON Level.Error `Hspec.shouldBe` [Aeson.aesonQQ| "error" |] + + Hspec.it "works for Fatal" $ do + Aeson.toJSON Level.Fatal `Hspec.shouldBe` [Aeson.aesonQQ| "fatal" |] diff --git a/source/test-suite/Patrol/Type/LogEntrySpec.hs b/source/test-suite/Patrol/Type/LogEntrySpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/LogEntrySpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.LogEntrySpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.LogEntry as LogEntry +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.LogEntry" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let logEntry = LogEntry.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON logEntry `Hspec.shouldBe` json + + Hspec.it "works with a formatted string" $ do + let logEntry = LogEntry.empty {LogEntry.formatted = Text.pack "example-formatted"} + json = [Aeson.aesonQQ| { "formatted": "example-formatted" } |] + Aeson.toJSON logEntry `Hspec.shouldBe` json + + Hspec.it "works with a message" $ do + let logEntry = LogEntry.empty {LogEntry.message = Text.pack "example-message"} + json = [Aeson.aesonQQ| { "message": "example-message" } |] + Aeson.toJSON logEntry `Hspec.shouldBe` json + + Hspec.it "works with some params" $ do + let logEntry = LogEntry.empty {LogEntry.params = Aeson.Bool True} + json = [Aeson.aesonQQ| { "params": true } |] + Aeson.toJSON logEntry `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/MachExceptionSpec.hs b/source/test-suite/Patrol/Type/MachExceptionSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/MachExceptionSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.MachExceptionSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.MachException as MachException +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.MachException" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let machException = MachException.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON machException `Hspec.shouldBe` json + + Hspec.it "works with a code" $ do + let machException = MachException.empty {MachException.code = Just 0} + json = [Aeson.aesonQQ| { "code": 0 } |] + Aeson.toJSON machException `Hspec.shouldBe` json + + Hspec.it "works with an exception" $ do + let machException = MachException.empty {MachException.exception = Just 0} + json = [Aeson.aesonQQ| { "exception": 0 } |] + Aeson.toJSON machException `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let machException = MachException.empty {MachException.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON machException `Hspec.shouldBe` json + + Hspec.it "works with a subcode" $ do + let machException = MachException.empty {MachException.subcode = Just 0} + json = [Aeson.aesonQQ| { "subcode": 0 } |] + Aeson.toJSON machException `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/MechanismMetaSpec.hs b/source/test-suite/Patrol/Type/MechanismMetaSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/MechanismMetaSpec.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.MechanismMetaSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.CError as CError +import qualified Patrol.Type.MachException as MachException +import qualified Patrol.Type.MechanismMeta as MechanismMeta +import qualified Patrol.Type.NsError as NsError +import qualified Patrol.Type.PosixSignal as PosixSignal +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.MechanismMeta" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let mechanismMeta = MechanismMeta.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON mechanismMeta `Hspec.shouldBe` json + + Hspec.it "works with a C error" $ do + let cError = CError.empty {CError.number = Just 0} + mechanismMeta = MechanismMeta.empty {MechanismMeta.errno = Just cError} + json = [Aeson.aesonQQ| { "errno": { "number": 0 } } |] + Aeson.toJSON mechanismMeta `Hspec.shouldBe` json + + Hspec.it "works with a mach exception" $ do + let machException = + MachException.empty + { MachException.code = Just 0 + } + mechanismMeta = MechanismMeta.empty {MechanismMeta.machException = Just machException} + json = [Aeson.aesonQQ| { "mach_exception": { "code": 0 } } |] + Aeson.toJSON mechanismMeta `Hspec.shouldBe` json + + Hspec.it "works with an NS error" $ do + let nsError = NsError.empty {NsError.code = Just 0} + mechanismMeta = MechanismMeta.empty {MechanismMeta.nsError = Just nsError} + json = [Aeson.aesonQQ| { "ns_error": { "code": 0 } } |] + Aeson.toJSON mechanismMeta `Hspec.shouldBe` json + + Hspec.it "works with a signal" $ do + let posixSignal = PosixSignal.empty {PosixSignal.code = Just 0} + mechanismMeta = MechanismMeta.empty {MechanismMeta.signal = Just posixSignal} + json = [Aeson.aesonQQ| { "signal": { "code": 0 } } |] + Aeson.toJSON mechanismMeta `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/MechanismSpec.hs b/source/test-suite/Patrol/Type/MechanismSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/MechanismSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.MechanismSpec where + +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 Patrol.Type.CError as CError +import qualified Patrol.Type.Mechanism as Mechanism +import qualified Patrol.Type.MechanismMeta as MechanismMeta +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Mechanism" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let mechanism = Mechanism.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with some data" $ do + let mechanism = Mechanism.empty {Mechanism.data_ = Map.singleton (Text.pack "example-data") Aeson.Null} + json = [Aeson.aesonQQ| { "data": { "example-data": null } } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with a description" $ do + let mechanism = Mechanism.empty {Mechanism.description = Text.pack "example-description"} + json = [Aeson.aesonQQ| { "description": "example-description" } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with a handled flag" $ do + let mechanism = Mechanism.empty {Mechanism.handled = Just True} + json = [Aeson.aesonQQ| { "handled": true } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with a help link" $ do + let mechanism = Mechanism.empty {Mechanism.helpLink = Text.pack "example-help-link"} + json = [Aeson.aesonQQ| { "help_link": "example-help-link" } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with some meta" $ do + let cError = CError.empty {CError.number = Just 0} + mechanismMeta = MechanismMeta.empty {MechanismMeta.errno = Just cError} + mechanism = Mechanism.empty {Mechanism.meta = Just mechanismMeta} + json = [Aeson.aesonQQ| { "meta": { "errno": { "number": 0 } } } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with a synthetic flag" $ do + let mechanism = Mechanism.empty {Mechanism.synthetic = Just True} + json = [Aeson.aesonQQ| { "synthetic": true } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json + + Hspec.it "works with a type" $ do + let mechanism = Mechanism.empty {Mechanism.type_ = Text.pack "example-type"} + json = [Aeson.aesonQQ| { "type": "example-type" } |] + Aeson.toJSON mechanism `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/NativeDebugImageSpec.hs b/source/test-suite/Patrol/Type/NativeDebugImageSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/NativeDebugImageSpec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.NativeDebugImageSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.NativeDebugImage as NativeDebugImage +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.NativeDebugImage" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let nativeDebugImage = NativeDebugImage.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with an arch" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.arch = Text.pack "example-arch"} + json = [Aeson.aesonQQ| { "arch": "example-arch" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a code file" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.codeFile = Text.pack "example-code-file"} + json = [Aeson.aesonQQ| { "code_file": "example-code-file" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a code id" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.codeId = Text.pack "example-code-id"} + json = [Aeson.aesonQQ| { "code_id": "example-code-id" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a debug file" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.debugFile = Text.pack "example-debug-file"} + json = [Aeson.aesonQQ| { "debug_file": "example-debug-file" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a debug id" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.debugId = Text.pack "example-debug-id"} + json = [Aeson.aesonQQ| { "debug_id": "example-debug-id" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a image addr" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.imageAddr = Text.pack "example-image-addr"} + json = [Aeson.aesonQQ| { "image_addr": "example-image-addr" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a image size" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.imageSize = Just 0} + json = [Aeson.aesonQQ| { "image_size": 0 } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a image vmaddr" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.imageVmaddr = Text.pack "example-image-vmaddr"} + json = [Aeson.aesonQQ| { "image_vmaddr": "example-image-vmaddr" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a type" $ do + let nativeDebugImage = NativeDebugImage.empty {NativeDebugImage.type_ = Text.pack "example-type"} + json = [Aeson.aesonQQ| { "type": "example-type" } |] + Aeson.toJSON nativeDebugImage `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/NsErrorSpec.hs b/source/test-suite/Patrol/Type/NsErrorSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/NsErrorSpec.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.NsErrorSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.NsError as NsError +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.NsError" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let nsError = NsError.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON nsError `Hspec.shouldBe` json + + Hspec.it "works with a code" $ do + let nsError = NsError.empty {NsError.code = Just 0} + json = [Aeson.aesonQQ| { "code": 0 } |] + Aeson.toJSON nsError `Hspec.shouldBe` json + + Hspec.it "works with a domain" $ do + let nsError = NsError.empty {NsError.domain = Text.pack "example-domain"} + json = [Aeson.aesonQQ| { "domain": "example-domain" } |] + Aeson.toJSON nsError `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/OsContextSpec.hs b/source/test-suite/Patrol/Type/OsContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/OsContextSpec.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.OsContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.OsContext as OsContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.OsContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let osContext = OsContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON osContext `Hspec.shouldBe` json + + Hspec.it "works with build" $ do + let osContext = OsContext.empty {OsContext.build = Text.pack "example-build"} + json = [Aeson.aesonQQ| { "build": "example-build" } |] + Aeson.toJSON osContext `Hspec.shouldBe` json + + Hspec.it "works with kernelVersion" $ do + let osContext = OsContext.empty {OsContext.kernelVersion = Text.pack "example-kernelVersion"} + json = [Aeson.aesonQQ| { "kernel_version": "example-kernelVersion" } |] + Aeson.toJSON osContext `Hspec.shouldBe` json + + Hspec.it "works with name" $ do + let osContext = OsContext.empty {OsContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON osContext `Hspec.shouldBe` json + + Hspec.it "works with rawDescription" $ do + let osContext = OsContext.empty {OsContext.rawDescription = Text.pack "example-rawDescription"} + json = [Aeson.aesonQQ| { "raw_description": "example-rawDescription" } |] + Aeson.toJSON osContext `Hspec.shouldBe` json + + Hspec.it "works with rooted" $ do + let osContext = OsContext.empty {OsContext.rooted = Just True} + json = [Aeson.aesonQQ| { "rooted": true } |] + Aeson.toJSON osContext `Hspec.shouldBe` json + + Hspec.it "works with version" $ do + let osContext = OsContext.empty {OsContext.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "version": "example-version" } |] + Aeson.toJSON osContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/PlatformSpec.hs b/source/test-suite/Patrol/Type/PlatformSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/PlatformSpec.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.PlatformSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.Platform as Platform +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Platform" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works for As3" $ do + Aeson.toJSON Platform.As3 `Hspec.shouldBe` [Aeson.aesonQQ| "as3" |] + + Hspec.it "works for C" $ do + Aeson.toJSON Platform.C `Hspec.shouldBe` [Aeson.aesonQQ| "c" |] + + Hspec.it "works for Cfml" $ do + Aeson.toJSON Platform.Cfml `Hspec.shouldBe` [Aeson.aesonQQ| "cfml" |] + + Hspec.it "works for Cocoa" $ do + Aeson.toJSON Platform.Cocoa `Hspec.shouldBe` [Aeson.aesonQQ| "cocoa" |] + + Hspec.it "works for Csharp" $ do + Aeson.toJSON Platform.Csharp `Hspec.shouldBe` [Aeson.aesonQQ| "csharp" |] + + Hspec.it "works for Elixir" $ do + Aeson.toJSON Platform.Elixir `Hspec.shouldBe` [Aeson.aesonQQ| "elixir" |] + + Hspec.it "works for Haskell" $ do + Aeson.toJSON Platform.Haskell `Hspec.shouldBe` [Aeson.aesonQQ| "haskell" |] + + Hspec.it "works for Go" $ do + Aeson.toJSON Platform.Go `Hspec.shouldBe` [Aeson.aesonQQ| "go" |] + + Hspec.it "works for Groovy" $ do + Aeson.toJSON Platform.Groovy `Hspec.shouldBe` [Aeson.aesonQQ| "groovy" |] + + Hspec.it "works for Java" $ do + Aeson.toJSON Platform.Java `Hspec.shouldBe` [Aeson.aesonQQ| "java" |] + + Hspec.it "works for Javascript" $ do + Aeson.toJSON Platform.Javascript `Hspec.shouldBe` [Aeson.aesonQQ| "javascript" |] + + Hspec.it "works for Native" $ do + Aeson.toJSON Platform.Native `Hspec.shouldBe` [Aeson.aesonQQ| "native" |] + + Hspec.it "works for Node" $ do + Aeson.toJSON Platform.Node `Hspec.shouldBe` [Aeson.aesonQQ| "node" |] + + Hspec.it "works for Objc" $ do + Aeson.toJSON Platform.Objc `Hspec.shouldBe` [Aeson.aesonQQ| "objc" |] + + Hspec.it "works for Other" $ do + Aeson.toJSON Platform.Other `Hspec.shouldBe` [Aeson.aesonQQ| "other" |] + + Hspec.it "works for Perl" $ do + Aeson.toJSON Platform.Perl `Hspec.shouldBe` [Aeson.aesonQQ| "perl" |] + + Hspec.it "works for Php" $ do + Aeson.toJSON Platform.Php `Hspec.shouldBe` [Aeson.aesonQQ| "php" |] + + Hspec.it "works for Python" $ do + Aeson.toJSON Platform.Python `Hspec.shouldBe` [Aeson.aesonQQ| "python" |] + + Hspec.it "works for Ruby" $ do + Aeson.toJSON Platform.Ruby `Hspec.shouldBe` [Aeson.aesonQQ| "ruby" |] diff --git a/source/test-suite/Patrol/Type/PosixSignalSpec.hs b/source/test-suite/Patrol/Type/PosixSignalSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/PosixSignalSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.PosixSignalSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.PosixSignal as PosixSignal +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.PosixSignal" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let posixSignal = PosixSignal.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON posixSignal `Hspec.shouldBe` json + + Hspec.it "works with a code" $ do + let posixSignal = PosixSignal.empty {PosixSignal.code = Just 0} + json = [Aeson.aesonQQ| { "code": 0 } |] + Aeson.toJSON posixSignal `Hspec.shouldBe` json + + Hspec.it "works with a code name" $ do + let posixSignal = PosixSignal.empty {PosixSignal.codeName = Text.pack "example-code-name"} + json = [Aeson.aesonQQ| { "code_name": "example-code-name" } |] + Aeson.toJSON posixSignal `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let posixSignal = PosixSignal.empty {PosixSignal.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON posixSignal `Hspec.shouldBe` json + + Hspec.it "works with a number" $ do + let posixSignal = PosixSignal.empty {PosixSignal.number = Just 0} + json = [Aeson.aesonQQ| { "number": 0 } |] + Aeson.toJSON posixSignal `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ProguardDebugImageSpec.hs b/source/test-suite/Patrol/Type/ProguardDebugImageSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ProguardDebugImageSpec.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ProguardDebugImageSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.ProguardDebugImage as ProguardDebugImage +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.ProguardDebugImage" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let proguardDebugImage = ProguardDebugImage.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON proguardDebugImage `Hspec.shouldBe` json + + Hspec.it "works with a UUID" $ do + let proguardDebugImage = ProguardDebugImage.empty {ProguardDebugImage.uuid = Text.pack "example-uuid"} + json = [Aeson.aesonQQ| { "uuid": "example-uuid" } |] + Aeson.toJSON proguardDebugImage `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/RequestSpec.hs b/source/test-suite/Patrol/Type/RequestSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/RequestSpec.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.RequestSpec where + +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 Patrol.Type.Request as Request +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Request" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let request = Request.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with a cookie" $ do + let request = Request.empty {Request.cookies = Map.singleton (Text.pack "example-key") $ Text.pack "example-value"} + json = [Aeson.aesonQQ| { "cookies": { "example-key": "example-value" } } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with some data" $ do + let request = Request.empty {Request.data_ = Aeson.Bool True} + json = [Aeson.aesonQQ| { "data": true } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with an env" $ do + let request = Request.empty {Request.env = Map.singleton (Text.pack "example-key") $ Aeson.Bool True} + json = [Aeson.aesonQQ| { "env": { "example-key": true } } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with a fragment" $ do + let request = Request.empty {Request.fragment = Text.pack "example-fragment"} + json = [Aeson.aesonQQ| { "fragment": "example-fragment" } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with a header" $ do + let request = Request.empty {Request.headers = Map.singleton (Text.pack "example-key") $ Text.pack "example-value"} + json = [Aeson.aesonQQ| { "headers": { "example-key": "example-value" } } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with an inferred content type" $ do + let request = Request.empty {Request.inferredContentType = Text.pack "example-inferred-content-type"} + json = [Aeson.aesonQQ| { "inferred_content_type": "example-inferred-content-type" } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with a method" $ do + let request = Request.empty {Request.method = Text.pack "example-method"} + json = [Aeson.aesonQQ| { "method": "example-method" } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with a query string" $ do + let request = Request.empty {Request.queryString = Map.singleton (Text.pack "example-key") $ Text.pack "example-value"} + json = [Aeson.aesonQQ| { "query_string": { "example-key": "example-value" } } |] + Aeson.toJSON request `Hspec.shouldBe` json + + Hspec.it "works with a URL" $ do + let request = Request.empty {Request.url = Text.pack "example-url"} + json = [Aeson.aesonQQ| { "url": "example-url" } |] + Aeson.toJSON request `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ResponseSpec.hs b/source/test-suite/Patrol/Type/ResponseSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ResponseSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + +module Patrol.Type.ResponseSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.UUID as Uuid +import qualified Patrol.Type.EventId as EventId +import qualified Patrol.Type.Response as Response +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Response" $ do + Hspec.describe "FromJSON" $ do + Hspec.it "works" $ do + let json = [Aeson.aesonQQ| { "id": "00112233445566778899aabbccddeeff" } |] + eventId = EventId.fromUuid $ Uuid.fromWords64 0x0011223344556677 0x8899aabbccddeeff + response = Response.Response {Response.id = eventId} + Aeson.fromJSON json `Hspec.shouldBe` Aeson.Success response + + Hspec.it "fails with the wrong type" $ do + let json = [Aeson.aesonQQ| null |] + Aeson.fromJSON @Response.Response json `Hspec.shouldBe` Aeson.Error "parsing Response failed, expected Object, but encountered Null" diff --git a/source/test-suite/Patrol/Type/RuntimeContextSpec.hs b/source/test-suite/Patrol/Type/RuntimeContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/RuntimeContextSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.RuntimeContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.RuntimeContext as RuntimeContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.RuntimeContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let runtimeContext = RuntimeContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON runtimeContext `Hspec.shouldBe` json + + Hspec.it "works with build" $ do + let runtimeContext = RuntimeContext.empty {RuntimeContext.build = Text.pack "example-build"} + json = [Aeson.aesonQQ| { "build": "example-build" } |] + Aeson.toJSON runtimeContext `Hspec.shouldBe` json + + Hspec.it "works with name" $ do + let runtimeContext = RuntimeContext.empty {RuntimeContext.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON runtimeContext `Hspec.shouldBe` json + + Hspec.it "works with rawDescription" $ do + let runtimeContext = RuntimeContext.empty {RuntimeContext.rawDescription = Text.pack "example-rawDescription"} + json = [Aeson.aesonQQ| { "raw_description": "example-rawDescription" } |] + Aeson.toJSON runtimeContext `Hspec.shouldBe` json + + Hspec.it "works with version" $ do + let runtimeContext = RuntimeContext.empty {RuntimeContext.version = Text.pack "example-version"} + json = [Aeson.aesonQQ| { "version": "example-version" } |] + Aeson.toJSON runtimeContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/SpanStatusSpec.hs b/source/test-suite/Patrol/Type/SpanStatusSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/SpanStatusSpec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.SpanStatusSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.SpanStatus as SpanStatus +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.SpanStatus" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works for Aborted" $ do + Aeson.toJSON SpanStatus.Aborted `Hspec.shouldBe` [Aeson.aesonQQ| "aborted" |] + + Hspec.it "works for AlreadyExists" $ do + Aeson.toJSON SpanStatus.AlreadyExists `Hspec.shouldBe` [Aeson.aesonQQ| "already_exists" |] + + Hspec.it "works for Cancelled" $ do + Aeson.toJSON SpanStatus.Cancelled `Hspec.shouldBe` [Aeson.aesonQQ| "cancelled" |] + + Hspec.it "works for DataLoss" $ do + Aeson.toJSON SpanStatus.DataLoss `Hspec.shouldBe` [Aeson.aesonQQ| "data_loss" |] + + Hspec.it "works for DeadlineExceeded" $ do + Aeson.toJSON SpanStatus.DeadlineExceeded `Hspec.shouldBe` [Aeson.aesonQQ| "deadline_exceeded" |] + + Hspec.it "works for FailedPrecondition" $ do + Aeson.toJSON SpanStatus.FailedPrecondition `Hspec.shouldBe` [Aeson.aesonQQ| "failed_precondition" |] + + Hspec.it "works for InternalError" $ do + Aeson.toJSON SpanStatus.InternalError `Hspec.shouldBe` [Aeson.aesonQQ| "internal_error" |] + + Hspec.it "works for InvalidArgument" $ do + Aeson.toJSON SpanStatus.InvalidArgument `Hspec.shouldBe` [Aeson.aesonQQ| "invalid_argument" |] + + Hspec.it "works for NotFound" $ do + Aeson.toJSON SpanStatus.NotFound `Hspec.shouldBe` [Aeson.aesonQQ| "not_found" |] + + Hspec.it "works for Ok" $ do + Aeson.toJSON SpanStatus.Ok `Hspec.shouldBe` [Aeson.aesonQQ| "ok" |] + + Hspec.it "works for OutOfRange" $ do + Aeson.toJSON SpanStatus.OutOfRange `Hspec.shouldBe` [Aeson.aesonQQ| "out_of_range" |] + + Hspec.it "works for PermissionDenied" $ do + Aeson.toJSON SpanStatus.PermissionDenied `Hspec.shouldBe` [Aeson.aesonQQ| "permission_denied" |] + + Hspec.it "works for ResourceExhausted" $ do + Aeson.toJSON SpanStatus.ResourceExhausted `Hspec.shouldBe` [Aeson.aesonQQ| "resource_exhausted" |] + + Hspec.it "works for Unauthenticated" $ do + Aeson.toJSON SpanStatus.Unauthenticated `Hspec.shouldBe` [Aeson.aesonQQ| "unauthenticated" |] + + Hspec.it "works for Unavailable" $ do + Aeson.toJSON SpanStatus.Unavailable `Hspec.shouldBe` [Aeson.aesonQQ| "unavailable" |] + + Hspec.it "works for Unimplemented" $ do + Aeson.toJSON SpanStatus.Unimplemented `Hspec.shouldBe` [Aeson.aesonQQ| "unimplemented" |] + + Hspec.it "works for Unknown" $ do + Aeson.toJSON SpanStatus.Unknown `Hspec.shouldBe` [Aeson.aesonQQ| "unknown" |] diff --git a/source/test-suite/Patrol/Type/StacktraceSpec.hs b/source/test-suite/Patrol/Type/StacktraceSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/StacktraceSpec.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.StacktraceSpec where + +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.Frame as Frame +import qualified Patrol.Type.Stacktrace as Stacktrace +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Stacktrace" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let stacktrace = Stacktrace.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON stacktrace `Hspec.shouldBe` json + + Hspec.it "works with a frame" $ do + let frame = Frame.empty + stacktrace = Stacktrace.empty {Stacktrace.frames = [frame]} + json = [Aeson.aesonQQ| { "frames": [ {} ] } |] + Aeson.toJSON stacktrace `Hspec.shouldBe` json + + Hspec.it "works with some registers" $ do + let stacktrace = Stacktrace.empty {Stacktrace.registers = Map.singleton (Text.pack "example-key") $ Text.pack "example-value"} + json = [Aeson.aesonQQ| { "registers": { "example-key": "example-value" } } |] + Aeson.toJSON stacktrace `Hspec.shouldBe` json + + Hspec.describe "fromCallStack" $ do + Hspec.it "works with an empty call stack" $ do + let callStack = Stack.emptyCallStack + stacktrace = Stacktrace.empty + Stacktrace.fromCallStack callStack `Hspec.shouldBe` stacktrace + + Hspec.it "works with a single call site" $ do + let emptySrcLoc = + Stack.SrcLoc + { Stack.srcLocEndCol = 0, + Stack.srcLocEndLine = 0, + Stack.srcLocFile = "", + Stack.srcLocModule = "", + Stack.srcLocPackage = "", + Stack.srcLocStartCol = 0, + Stack.srcLocStartLine = 0 + } + callStack = + Stack.fromCallSiteList + [ ("example-function", emptySrcLoc) + ] + frame = + (Frame.fromSrcLoc emptySrcLoc) + { Frame.function = Text.pack "example-function" + } + stacktrace = + Stacktrace.empty + { Stacktrace.frames = [frame] + } + Stacktrace.fromCallStack callStack `Hspec.shouldBe` stacktrace + + Hspec.it "works with two call sites" $ do + let srcLoc1 = + Stack.SrcLoc + { Stack.srcLocEndCol = 1, + Stack.srcLocEndLine = 1, + Stack.srcLocFile = "example-file-1", + Stack.srcLocModule = "example-module-1", + Stack.srcLocPackage = "example-package-1", + Stack.srcLocStartCol = 1, + Stack.srcLocStartLine = 1 + } + srcLoc2 = + Stack.SrcLoc + { Stack.srcLocEndCol = 2, + Stack.srcLocEndLine = 2, + Stack.srcLocFile = "example-file-2", + Stack.srcLocModule = "example-module-2", + Stack.srcLocPackage = "example-package-2", + Stack.srcLocStartCol = 2, + Stack.srcLocStartLine = 2 + } + callStack = + Stack.fromCallSiteList + [ ("example-function-1", srcLoc1), + ("example-function-2", srcLoc2) + ] + frame1 = + (Frame.fromSrcLoc srcLoc1) + { Frame.function = Text.pack "example-function-1" + } + frame2 = + (Frame.fromSrcLoc srcLoc2) + { Frame.function = Text.pack "example-function-2" + } + stacktrace = + Stacktrace.empty + { Stacktrace.frames = [frame2, frame1] + } + Stacktrace.fromCallStack callStack `Hspec.shouldBe` stacktrace diff --git a/source/test-suite/Patrol/Type/SystemSdkInfoSpec.hs b/source/test-suite/Patrol/Type/SystemSdkInfoSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/SystemSdkInfoSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.SystemSdkInfoSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.SystemSdkInfo as SystemSdkInfo +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.SystemSdkInfo" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let systemSdkInfo = SystemSdkInfo.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON systemSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with an SDK name" $ do + let systemSdkInfo = SystemSdkInfo.empty {SystemSdkInfo.sdkName = Text.pack "example-sdk-name"} + json = [Aeson.aesonQQ| { "sdk_name": "example-sdk-name" } |] + Aeson.toJSON systemSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with a major version number" $ do + let systemSdkInfo = SystemSdkInfo.empty {SystemSdkInfo.versionMajor = Just 0} + json = [Aeson.aesonQQ| { "version_major": 0 } |] + Aeson.toJSON systemSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with a minor version number" $ do + let systemSdkInfo = SystemSdkInfo.empty {SystemSdkInfo.versionMinor = Just 0} + json = [Aeson.aesonQQ| { "version_minor": 0 } |] + Aeson.toJSON systemSdkInfo `Hspec.shouldBe` json + + Hspec.it "works with a patch version number" $ do + let systemSdkInfo = SystemSdkInfo.empty {SystemSdkInfo.versionPatchlevel = Just 0} + json = [Aeson.aesonQQ| { "version_patchlevel": 0 } |] + Aeson.toJSON systemSdkInfo `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ThreadSpec.hs b/source/test-suite/Patrol/Type/ThreadSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ThreadSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ThreadSpec where + +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 Patrol.Type.Stacktrace as Stacktrace +import qualified Patrol.Type.Thread as Thread +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Thread" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let thread = Thread.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON thread `Hspec.shouldBe` json + + Hspec.it "works with a crashed flag" $ do + let thread = Thread.empty {Thread.crashed = Just True} + json = [Aeson.aesonQQ| { "crashed": true } |] + Aeson.toJSON thread `Hspec.shouldBe` json + + Hspec.it "works with a current flag" $ do + let thread = Thread.empty {Thread.current = Just True} + json = [Aeson.aesonQQ| { "current": true } |] + Aeson.toJSON thread `Hspec.shouldBe` json + + Hspec.it "works with an ID" $ do + let thread = Thread.empty {Thread.id = Text.pack "example-id"} + json = [Aeson.aesonQQ| { "id": "example-id" } |] + Aeson.toJSON thread `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let thread = Thread.empty {Thread.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON thread `Hspec.shouldBe` json + + Hspec.it "works with a stack trace" $ do + let stacktrace = Stacktrace.empty {Stacktrace.registers = Map.singleton (Text.pack "example-key") $ Text.pack "example-value"} + thread = Thread.empty {Thread.stacktrace = Just stacktrace} + json = [Aeson.aesonQQ| { "stacktrace": { "registers": { "example-key": "example-value" } } } |] + Aeson.toJSON thread `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/ThreadsSpec.hs b/source/test-suite/Patrol/Type/ThreadsSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/ThreadsSpec.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.ThreadsSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.Thread as Thread +import qualified Patrol.Type.Threads as Threads +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.Threads" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let threads = Threads.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON threads `Hspec.shouldBe` json + + Hspec.it "works with a value" $ do + let thread = Thread.empty {Thread.crashed = Just True} + threads = Threads.empty {Threads.values = [thread]} + json = [Aeson.aesonQQ| { "values": [ { "crashed": true } ] } |] + Aeson.toJSON threads `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/TraceContextSpec.hs b/source/test-suite/Patrol/Type/TraceContextSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/TraceContextSpec.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.TraceContextSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.SpanStatus as SpanStatus +import qualified Patrol.Type.TraceContext as TraceContext +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.TraceContext" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let traceContext = TraceContext.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON traceContext `Hspec.shouldBe` json + + Hspec.it "works with exclusiveTime" $ do + let traceContext = TraceContext.empty {TraceContext.exclusiveTime = Just 0} + json = [Aeson.aesonQQ| { "exclusive_time": 0 } |] + Aeson.toJSON traceContext `Hspec.shouldBe` json + + Hspec.it "works with op" $ do + let traceContext = TraceContext.empty {TraceContext.op = Text.pack "example-op"} + json = [Aeson.aesonQQ| { "op": "example-op" } |] + Aeson.toJSON traceContext `Hspec.shouldBe` json + + Hspec.it "works with parentSpanId" $ do + let traceContext = TraceContext.empty {TraceContext.parentSpanId = Text.pack "example-parentSpanId"} + json = [Aeson.aesonQQ| { "parent_span_id": "example-parentSpanId" } |] + Aeson.toJSON traceContext `Hspec.shouldBe` json + + Hspec.it "works with spanId" $ do + let traceContext = TraceContext.empty {TraceContext.spanId = Text.pack "example-spanId"} + json = [Aeson.aesonQQ| { "span_id": "example-spanId" } |] + Aeson.toJSON traceContext `Hspec.shouldBe` json + + Hspec.it "works with status" $ do + let traceContext = TraceContext.empty {TraceContext.status = Just SpanStatus.Unknown} + json = [Aeson.aesonQQ| { "status": "unknown" } |] + Aeson.toJSON traceContext `Hspec.shouldBe` json + + Hspec.it "works with traceId" $ do + let traceContext = TraceContext.empty {TraceContext.traceId = Text.pack "example-traceId"} + json = [Aeson.aesonQQ| { "trace_id": "example-traceId" } |] + Aeson.toJSON traceContext `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/TransactionInfoSpec.hs b/source/test-suite/Patrol/Type/TransactionInfoSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/TransactionInfoSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.TransactionInfoSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Data.Text as Text +import qualified Patrol.Type.TransactionInfo as TransactionInfo +import qualified Patrol.Type.TransactionSource as TransactionSource +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.TransactionInfo" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let transactionInfo = TransactionInfo.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON transactionInfo `Hspec.shouldBe` json + + Hspec.it "works with an original" $ do + let transactionInfo = TransactionInfo.empty {TransactionInfo.original = Text.pack "example-original"} + json = [Aeson.aesonQQ| { "original": "example-original" } |] + Aeson.toJSON transactionInfo `Hspec.shouldBe` json + + Hspec.it "works with a source" $ do + let transactionInfo = TransactionInfo.empty {TransactionInfo.source = Just TransactionSource.Unknown} + json = [Aeson.aesonQQ| { "source": "unknown" } |] + Aeson.toJSON transactionInfo `Hspec.shouldBe` json diff --git a/source/test-suite/Patrol/Type/TransactionSourceSpec.hs b/source/test-suite/Patrol/Type/TransactionSourceSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/TransactionSourceSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.TransactionSourceSpec where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.QQ.Simple as Aeson +import qualified Patrol.Type.TransactionSource as TransactionSource +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.TransactionSource" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works for Component" $ do + Aeson.toJSON TransactionSource.Component `Hspec.shouldBe` [Aeson.aesonQQ| "component" |] + + Hspec.it "works for Custom" $ do + Aeson.toJSON TransactionSource.Custom `Hspec.shouldBe` [Aeson.aesonQQ| "custom" |] + + Hspec.it "works for Route" $ do + Aeson.toJSON TransactionSource.Route `Hspec.shouldBe` [Aeson.aesonQQ| "route" |] + + Hspec.it "works for Task" $ do + Aeson.toJSON TransactionSource.Task `Hspec.shouldBe` [Aeson.aesonQQ| "task" |] + + Hspec.it "works for Url" $ do + Aeson.toJSON TransactionSource.Url `Hspec.shouldBe` [Aeson.aesonQQ| "url" |] + + Hspec.it "works for Unknown" $ do + Aeson.toJSON TransactionSource.Unknown `Hspec.shouldBe` [Aeson.aesonQQ| "unknown" |] + + Hspec.it "works for View" $ do + Aeson.toJSON TransactionSource.View `Hspec.shouldBe` [Aeson.aesonQQ| "view" |] diff --git a/source/test-suite/Patrol/Type/UserSpec.hs b/source/test-suite/Patrol/Type/UserSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/Patrol/Type/UserSpec.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Patrol.Type.UserSpec where + +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 Patrol.Type.Geo as Geo +import qualified Patrol.Type.User as User +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = Hspec.describe "Patrol.Type.User" $ do + Hspec.describe "ToJSON" $ do + Hspec.it "works" $ do + let user = User.empty + json = [Aeson.aesonQQ| {} |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with some data" $ do + let user = User.empty {User.data_ = Map.singleton (Text.pack "example-data") (Aeson.Bool True)} + json = [Aeson.aesonQQ| { "data": { "example-data": true } } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with an email" $ do + let user = User.empty {User.email = Text.pack "example-email"} + json = [Aeson.aesonQQ| { "email": "example-email" } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with a geo" $ do + let geo = Geo.empty {Geo.city = Text.pack "example-city"} + user = User.empty {User.geo = Just geo} + json = [Aeson.aesonQQ| { "geo": { "city": "example-city" } } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with an id" $ do + let user = User.empty {User.id = Text.pack "example-id"} + json = [Aeson.aesonQQ| { "id": "example-id" } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with an IP address" $ do + let user = User.empty {User.ipAddress = Text.pack "example-ip-address"} + json = [Aeson.aesonQQ| { "ip_address": "example-ip-address" } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with a name" $ do + let user = User.empty {User.name = Text.pack "example-name"} + json = [Aeson.aesonQQ| { "name": "example-name" } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with a segment" $ do + let user = User.empty {User.segment = Text.pack "example-segment"} + json = [Aeson.aesonQQ| { "segment": "example-segment" } |] + Aeson.toJSON user `Hspec.shouldBe` json + + Hspec.it "works with a username" $ do + let user = User.empty {User.username = Text.pack "example-username"} + json = [Aeson.aesonQQ| { "username": "example-username" } |] + Aeson.toJSON user `Hspec.shouldBe` json diff --git a/source/test-suite/PatrolSpec.hs b/source/test-suite/PatrolSpec.hs new file mode 100644 --- /dev/null +++ b/source/test-suite/PatrolSpec.hs @@ -0,0 +1,108 @@ +module PatrolSpec where + +import qualified Patrol.ClientSpec +import qualified Patrol.ConstantSpec +import qualified Patrol.Extra.AesonSpec +import qualified Patrol.Extra.ListSpec +import qualified Patrol.Type.AppContextSpec +import qualified Patrol.Type.AppleDebugImageSpec +import qualified Patrol.Type.BreadcrumbSpec +import qualified Patrol.Type.BreadcrumbTypeSpec +import qualified Patrol.Type.BreadcrumbsSpec +import qualified Patrol.Type.BrowserContextSpec +import qualified Patrol.Type.CErrorSpec +import qualified Patrol.Type.ClientSdkInfoSpec +import qualified Patrol.Type.ClientSdkPackageSpec +import qualified Patrol.Type.ContextSpec +import qualified Patrol.Type.DebugImageSpec +import qualified Patrol.Type.DebugMetaSpec +import qualified Patrol.Type.DeviceContextSpec +import qualified Patrol.Type.DsnSpec +import qualified Patrol.Type.ErrorTypeSpec +import qualified Patrol.Type.EventIdSpec +import qualified Patrol.Type.EventProcessingErrorSpec +import qualified Patrol.Type.EventSpec +import qualified Patrol.Type.EventTypeSpec +import qualified Patrol.Type.ExceptionSpec +import qualified Patrol.Type.ExceptionsSpec +import qualified Patrol.Type.FrameSpec +import qualified Patrol.Type.GeoSpec +import qualified Patrol.Type.GpuContextSpec +import qualified Patrol.Type.LevelSpec +import qualified Patrol.Type.LogEntrySpec +import qualified Patrol.Type.MachExceptionSpec +import qualified Patrol.Type.MechanismMetaSpec +import qualified Patrol.Type.MechanismSpec +import qualified Patrol.Type.NativeDebugImageSpec +import qualified Patrol.Type.NsErrorSpec +import qualified Patrol.Type.OsContextSpec +import qualified Patrol.Type.PlatformSpec +import qualified Patrol.Type.PosixSignalSpec +import qualified Patrol.Type.ProguardDebugImageSpec +import qualified Patrol.Type.RequestSpec +import qualified Patrol.Type.ResponseSpec +import qualified Patrol.Type.RuntimeContextSpec +import qualified Patrol.Type.SpanStatusSpec +import qualified Patrol.Type.StacktraceSpec +import qualified Patrol.Type.SystemSdkInfoSpec +import qualified Patrol.Type.ThreadSpec +import qualified Patrol.Type.ThreadsSpec +import qualified Patrol.Type.TraceContextSpec +import qualified Patrol.Type.TransactionInfoSpec +import qualified Patrol.Type.TransactionSourceSpec +import qualified Patrol.Type.UserSpec +import qualified Test.Hspec as Hspec + +spec :: Hspec.Spec +spec = do + Patrol.ClientSpec.spec + Patrol.ConstantSpec.spec + Patrol.Extra.AesonSpec.spec + Patrol.Extra.ListSpec.spec + Patrol.Type.AppContextSpec.spec + Patrol.Type.AppleDebugImageSpec.spec + Patrol.Type.BreadcrumbSpec.spec + Patrol.Type.BreadcrumbsSpec.spec + Patrol.Type.BreadcrumbTypeSpec.spec + Patrol.Type.BrowserContextSpec.spec + Patrol.Type.CErrorSpec.spec + Patrol.Type.ClientSdkInfoSpec.spec + Patrol.Type.ClientSdkPackageSpec.spec + Patrol.Type.ContextSpec.spec + Patrol.Type.DebugImageSpec.spec + Patrol.Type.DebugMetaSpec.spec + Patrol.Type.DeviceContextSpec.spec + Patrol.Type.DsnSpec.spec + Patrol.Type.ErrorTypeSpec.spec + Patrol.Type.EventIdSpec.spec + Patrol.Type.EventProcessingErrorSpec.spec + Patrol.Type.EventSpec.spec + Patrol.Type.EventTypeSpec.spec + Patrol.Type.ExceptionSpec.spec + Patrol.Type.ExceptionsSpec.spec + Patrol.Type.FrameSpec.spec + Patrol.Type.GeoSpec.spec + Patrol.Type.GpuContextSpec.spec + Patrol.Type.LevelSpec.spec + Patrol.Type.LogEntrySpec.spec + Patrol.Type.MachExceptionSpec.spec + Patrol.Type.MechanismMetaSpec.spec + Patrol.Type.MechanismSpec.spec + Patrol.Type.NativeDebugImageSpec.spec + Patrol.Type.NsErrorSpec.spec + Patrol.Type.OsContextSpec.spec + Patrol.Type.PlatformSpec.spec + Patrol.Type.PosixSignalSpec.spec + Patrol.Type.ProguardDebugImageSpec.spec + Patrol.Type.RequestSpec.spec + Patrol.Type.ResponseSpec.spec + Patrol.Type.RuntimeContextSpec.spec + Patrol.Type.SpanStatusSpec.spec + Patrol.Type.StacktraceSpec.spec + Patrol.Type.SystemSdkInfoSpec.spec + Patrol.Type.ThreadSpec.spec + Patrol.Type.ThreadsSpec.spec + Patrol.Type.TraceContextSpec.spec + Patrol.Type.TransactionInfoSpec.spec + Patrol.Type.TransactionSourceSpec.spec + Patrol.Type.UserSpec.spec diff --git a/src/lib/Patrol.hs b/src/lib/Patrol.hs deleted file mode 100644 --- a/src/lib/Patrol.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | -module Patrol - ( Dsn.Dsn - , Event.Event - , EventId.EventId - , Exception.Exception - , Frame.Frame - , Level.Level - , Platform.Platform - , Request.Request - , Response.Response - , StackTrace.StackTrace - , Timestamp.Timestamp - , User.User - ) where - -import qualified Patrol.Type.Dsn as Dsn -import qualified Patrol.Type.Event as Event -import qualified Patrol.Type.EventId as EventId -import qualified Patrol.Type.Exception as Exception -import qualified Patrol.Type.Frame as Frame -import qualified Patrol.Type.Level as Level -import qualified Patrol.Type.Platform as Platform -import qualified Patrol.Type.Request as Request -import qualified Patrol.Type.Response as Response -import qualified Patrol.Type.StackTrace as StackTrace -import qualified Patrol.Type.Timestamp as Timestamp -import qualified Patrol.Type.User as User diff --git a/src/lib/Patrol/Client.hs b/src/lib/Patrol/Client.hs deleted file mode 100644 --- a/src/lib/Patrol/Client.hs +++ /dev/null @@ -1,63 +0,0 @@ -module Patrol.Client - ( store - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.ByteString as ByteString -import qualified Data.CaseInsensitive as CI -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Time as Time -import qualified Data.Version as Version -import qualified Network.HTTP.Client as Client -import qualified Network.HTTP.Types as Http -import qualified Paths_patrol as Package -import qualified Patrol.Type.Dsn as Dsn -import qualified Patrol.Type.Event as Event -import qualified Patrol.Type.EventId as EventId -import qualified Patrol.Type.Response as Response - --- | -store :: Client.Manager -> Dsn.Dsn -> Event.Event -> IO EventId.EventId -store manager dsn event = do - now <- Time.getCurrentTime - request <- Client.parseUrlThrow $ makeUrl dsn - -- TODO: Compress request body. - response <- Client.httpLbs request - { Client.requestBody = Client.RequestBodyLBS $ Aeson.encode event - , Client.requestHeaders = - [ (Http.hContentType, utf8 "application/json") - , (Http.hUserAgent, utf8 userAgent) - , (ci $ utf8 "X-Sentry-Auth", Text.encodeUtf8 . Text.intercalate (Text.singleton ',') $ Maybe.catMaybes - [ Just $ Text.pack "Sentry sentry_version=7" - , Just . Text.pack $ "sentry_client=" <> userAgent - , Just . Text.pack $ "sentry_timestamp=" <> Time.formatTime Time.defaultTimeLocale "%s" now - , Just $ Text.pack "sentry_key=" <> Dsn.publicKey dsn - , (\ x -> Text.pack "sentry_secret=" <> x) <$> Dsn.secretKey dsn - ]) - ] - , Client.method = Http.methodPost - } manager - -- TODO: Handle 429 response codes. - either fail (pure . Response.id_) . Aeson.eitherDecode $ Client.responseBody response - -makeUrl :: Dsn.Dsn -> String -makeUrl dsn = - Text.unpack (Dsn.protocol dsn) - <> "://" - <> Text.unpack (Dsn.host dsn) - <> maybe "" (\ x -> ":" <> Text.unpack x) (Dsn.port dsn) - <> Text.unpack (Dsn.path dsn) - <> "api/" - <> Text.unpack (Dsn.projectId dsn) - <> "/store/" - -utf8 :: String -> ByteString.ByteString -utf8 = Text.encodeUtf8 . Text.pack - -ci :: CI.FoldCase a => a -> CI.CI a -ci = CI.mk - -userAgent :: String -userAgent = "patrol/" <> Version.showVersion Package.version diff --git a/src/lib/Patrol/Type/Dsn.hs b/src/lib/Patrol/Type/Dsn.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Dsn.hs +++ /dev/null @@ -1,75 +0,0 @@ -module Patrol.Type.Dsn - ( Dsn(..) - , fromUri - , fromString - , toUri - , toString - ) where - -import qualified Data.Text as Text -import qualified Network.URI as Uri -import qualified Patrol.Utility.Maybe as Maybe - --- | -data Dsn = Dsn - { protocol :: Text.Text - , publicKey :: Text.Text - , secretKey :: Maybe Text.Text - , host :: Text.Text - , port :: Maybe Text.Text - , path :: Text.Text - , projectId :: Text.Text - } deriving (Eq, Show) - -fromUri :: Uri.URI -> Either String Dsn -fromUri uri = do - protocol <- Maybe.note "invalid protocol" - . Text.stripSuffix (Text.singleton ':') - . Text.pack - $ Uri.uriScheme uri - authority <- Maybe.note "missing authority" $ Uri.uriAuthority uri - userInfo <- Maybe.note "invalid user info" - . Text.stripSuffix (Text.singleton '@') - . Text.pack - $ Uri.uriUserInfo authority - let - (publicKey, secretKey) = Text.drop 1 - <$> Text.breakOn (Text.singleton ':') userInfo - (host, port) = fmap (Text.drop 1) . Text.breakOn (Text.singleton ':') - . Text.pack - $ Uri.uriRegName authority <> Uri.uriPort authority - (path, projectId) = Text.breakOnEnd (Text.singleton '/') - . Text.pack - $ Uri.uriPath uri - Right Dsn - { protocol - , publicKey - , secretKey = if Text.null secretKey then Nothing else Just secretKey - , host - , port = if Text.null port then Nothing else Just port - , path - , projectId - } - -fromString :: String -> Either String Dsn -fromString string = do - uri <- Maybe.note "invalid URI" $ Uri.parseURI string - fromUri uri - -toUri :: Dsn -> Uri.URI -toUri dsn = Uri.URI - { Uri.uriScheme = Text.unpack (protocol dsn) <> ":" - , Uri.uriAuthority = Just Uri.URIAuth - { Uri.uriUserInfo = Text.unpack (publicKey dsn) - <> maybe "" (\ x -> ":" <> Text.unpack x) (secretKey dsn) <> "@" - , Uri.uriRegName = Text.unpack (host dsn) - <> maybe "" (\ x -> ":" <> Text.unpack x) (port dsn) - , Uri.uriPort = "" - } - , Uri.uriPath = Text.unpack (path dsn) <> Text.unpack (projectId dsn) - , Uri.uriQuery = "" - , Uri.uriFragment = "" - } - -toString :: Dsn -> String -toString dsn = Uri.uriToString id (toUri dsn) "" diff --git a/src/lib/Patrol/Type/Event.hs b/src/lib/Patrol/Type/Event.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Event.hs +++ /dev/null @@ -1,86 +0,0 @@ -module Patrol.Type.Event - ( Event(..) - , new - ) where - -import qualified Control.Monad.IO.Class as IO -import qualified Data.Aeson as Aeson -import qualified Data.Map as Map -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified Data.Time as Time -import qualified Data.UUID.V4 as Uuid -import qualified Patrol.Type.EventId as EventId -import qualified Patrol.Type.Exception as Exception -import qualified Patrol.Type.Level as Level -import qualified Patrol.Type.Platform as Platform -import qualified Patrol.Type.Request as Request -import qualified Patrol.Type.Timestamp as Timestamp -import qualified Patrol.Type.User as User -import qualified Patrol.Utility.Json as Json - --- | -data Event = Event - { dist :: Maybe Text.Text - , environment :: Maybe Text.Text - , eventId :: EventId.EventId - , exception :: Maybe [Exception.Exception] - , extra :: Maybe Aeson.Object - , fingerprint :: Maybe [Text.Text] - , level :: Maybe Level.Level - , logger :: Maybe Text.Text - , modules :: Maybe (Map.Map Text.Text Text.Text) - , platform :: Platform.Platform - , release :: Maybe Text.Text - , request :: Maybe Request.Request - , serverName :: Maybe Text.Text - , tags :: Maybe (Map.Map Text.Text Text.Text) - , timestamp :: Timestamp.Timestamp - , transaction :: Maybe Text.Text - , user :: Maybe User.User - } deriving (Eq, Show) - -instance Aeson.ToJSON Event where - toJSON event = Aeson.object $ Maybe.catMaybes - [ Json.pair "dist" <$> dist event - , Json.pair "environment" <$> environment event - , Just . Json.pair "event_id" $ eventId event - , Json.pair "extra" <$> extra event - , Json.pair "exception" . Aeson.object . pure . Json.pair "values" <$> exception event - , Json.pair "fingerprint" <$> fingerprint event - , Json.pair "level" <$> level event - , Json.pair "logger" <$> logger event - , Json.pair "modules" <$> modules event - , Just . Json.pair "platform" $ platform event - , Json.pair "release" <$> release event - , Json.pair "request" <$> request event - , Json.pair "server_name" <$> serverName event - , Json.pair "tags" <$> tags event - , Just . Json.pair "timestamp" $ timestamp event - , Json.pair "transaction" <$> transaction event - , Json.pair "user" <$> user event - ] - -new :: IO.MonadIO io => io Event -new = IO.liftIO $ do - eventId <- EventId.fromUuid <$> Uuid.nextRandom - timestamp <- Timestamp.fromUtcTime <$> Time.getCurrentTime - pure Event - { dist = Nothing - , environment = Nothing - , eventId - , exception = Nothing - , extra = Nothing - , fingerprint = Nothing - , level = Nothing - , logger = Nothing - , modules = Nothing - , platform = Platform.Haskell - , release = Nothing - , request = Nothing - , serverName = Nothing - , tags = Nothing - , timestamp - , transaction = Nothing - , user = Nothing - } diff --git a/src/lib/Patrol/Type/EventId.hs b/src/lib/Patrol/Type/EventId.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/EventId.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Patrol.Type.EventId - ( EventId - , fromUuid - , toUuid - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.Text as Text -import qualified Data.UUID as Uuid - --- | -newtype EventId - = EventId Uuid.UUID - deriving (Eq, Show) - -instance Aeson.FromJSON EventId where - parseJSON = Aeson.withText "EventId" $ \ text -> case Text.chunksOf 4 text of - [a, b, c, d, e, f, g, h] -> maybe (fail "invalid EventId") (pure . fromUuid) - . Uuid.fromText - $ Text.intercalate (Text.singleton '-') [a <> b, c, d, e, f <> g <> h] - _ -> fail "invalid EventId" - -instance Aeson.ToJSON EventId where - toJSON = Aeson.toJSON . Text.filter (/= '-') . Uuid.toText . toUuid - -fromUuid :: Uuid.UUID -> EventId -fromUuid = EventId - -toUuid :: EventId -> Uuid.UUID -toUuid (EventId x) = x diff --git a/src/lib/Patrol/Type/Exception.hs b/src/lib/Patrol/Type/Exception.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Exception.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Patrol.Type.Exception - ( Exception(..) - , fromSomeException - ) where - -import qualified Control.Exception as Exception -import qualified Data.Aeson as Aeson -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified Data.Typeable as Typeable -import qualified Patrol.Type.StackTrace as StackTrace -import qualified Patrol.Utility.Json as Json - --- | -data Exception = Exception - { module_ :: Maybe Text.Text - , stackTrace :: Maybe StackTrace.StackTrace - , type_ :: Text.Text - , value :: Text.Text - } deriving (Eq, Show) - -instance Aeson.ToJSON Exception where - toJSON exception = Aeson.object $ Maybe.catMaybes - [ Json.pair "module" <$> module_ exception - , Json.pair "stacktrace" <$> stackTrace exception - , Just . Json.pair "type" $ type_ exception - , Just . Json.pair "value" $ value exception - ] - -fromSomeException :: Exception.SomeException -> Exception -fromSomeException (Exception.SomeException x) = - let tyCon = Typeable.typeRepTyCon $ Typeable.typeOf x - in Exception - { module_ = Just . Text.pack $ Typeable.tyConPackage tyCon <> ":" <> Typeable.tyConModule tyCon - , stackTrace = Nothing - , type_ = Text.pack $ Typeable.tyConName tyCon - , value = Text.pack $ Exception.displayException x - } diff --git a/src/lib/Patrol/Type/Frame.hs b/src/lib/Patrol/Type/Frame.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Frame.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Patrol.Type.Frame - ( Frame(..) - , fromSrcLoc - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified GHC.Stack as Stack -import qualified Patrol.Utility.Json as Json - --- | -data Frame = Frame - { colno :: Maybe Int - , filename :: Maybe Text.Text - , function :: Text.Text - , lineno :: Maybe Int - , module_ :: Maybe Text.Text - , package :: Maybe Text.Text - } deriving (Eq, Show) - -instance Aeson.ToJSON Frame where - toJSON frame = Aeson.object $ Maybe.catMaybes - [ Json.pair "colno" <$> colno frame - , Json.pair "filename" <$> filename frame - , Just . Json.pair "function" $ function frame - , Json.pair "lineno" <$> lineno frame - , Json.pair "module" <$> module_ frame - , Json.pair "package" <$> package frame - ] - -fromSrcLoc :: String -> Stack.SrcLoc -> Frame -fromSrcLoc function srcLoc = Frame - { colno = Just $ Stack.srcLocStartCol srcLoc - , filename = Just . Text.pack $ Stack.srcLocFile srcLoc - , function = Text.pack function - , lineno = Just $ Stack.srcLocStartLine srcLoc - , module_ = Just . Text.pack $ Stack.srcLocModule srcLoc - , package = Just . Text.pack $ Stack.srcLocPackage srcLoc - } diff --git a/src/lib/Patrol/Type/Level.hs b/src/lib/Patrol/Type/Level.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Level.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Patrol.Type.Level - ( Level(..) - ) where - -import qualified Data.Aeson as Aeson - --- | -data Level - = Fatal - | Error - | Warning - | Info - | Debug - deriving (Eq, Show) - -instance Aeson.ToJSON Level where - toJSON level = Aeson.toJSON $ case level of - Fatal -> "fatal" - Error -> "error" - Warning -> "warning" - Info -> "info" - Debug -> "debug" diff --git a/src/lib/Patrol/Type/Platform.hs b/src/lib/Patrol/Type/Platform.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Platform.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Patrol.Type.Platform - ( Platform(..) - ) where - -import qualified Data.Aeson as Aeson - --- | -data Platform - = As3 - | C - | Cfml - | Cocoa - | Csharp - | Elixir - | Go - | Groovy - | Haskell - | Java - | Javascript - | Native - | Node - | Objc - | Other - | Perl - | Php - | Python - | Ruby - deriving (Eq, Show) - -instance Aeson.ToJSON Platform where - toJSON platform = Aeson.toJSON $ case platform of - As3 -> "as3" - C -> "c" - Cfml -> "cfml" - Cocoa -> "cocoa" - Csharp -> "csharp" - Elixir -> "elixir" - Go -> "go" - Groovy -> "groovy" - Haskell -> "haskell" - Java -> "java" - Javascript -> "javascript" - Native -> "native" - Node -> "node" - Objc -> "objc" - Other -> "other" - Perl -> "perl" - Php -> "php" - Python -> "python" - Ruby -> "ruby" diff --git a/src/lib/Patrol/Type/Request.hs b/src/lib/Patrol/Type/Request.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Request.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Patrol.Type.Request - ( Request(..) - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.Map as Map -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified Patrol.Utility.Json as Json - -data Request = Request - { cookies :: Maybe (Map.Map Text.Text Text.Text) - , data_ :: Maybe Aeson.Value - , env :: Maybe (Map.Map Text.Text Text.Text) - , headers :: Maybe (Map.Map Text.Text Text.Text) - , method :: Maybe Text.Text - , queryString :: Maybe (Map.Map Text.Text Text.Text) - , url :: Maybe Text.Text - } deriving (Eq, Show) - -instance Aeson.ToJSON Request where - toJSON request = Aeson.object $ Maybe.catMaybes - [ Json.pair "cookies" <$> cookies request - , Json.pair "env" <$> env request - , Json.pair "headers" <$> headers request - , Json.pair "data" <$> data_ request - , Json.pair "method" <$> method request - , Json.pair "query_string" <$> queryString request - , Json.pair "url" <$> url request - ] diff --git a/src/lib/Patrol/Type/Response.hs b/src/lib/Patrol/Type/Response.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Response.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Patrol.Type.Response - ( Response(..) - ) where - -import qualified Data.Aeson as Aeson -import qualified Patrol.Type.EventId as EventId -import qualified Patrol.Utility.Json as Json - --- | -newtype Response = Response - { id_ :: EventId.EventId - } deriving (Eq, Show) - -instance Aeson.FromJSON Response where - parseJSON = Aeson.withObject "Response" $ \ object -> do - id_ <- Json.required object "id" - pure Response { id_ } diff --git a/src/lib/Patrol/Type/StackTrace.hs b/src/lib/Patrol/Type/StackTrace.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/StackTrace.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Patrol.Type.StackTrace - ( StackTrace(..) - , fromCallStack - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.List.NonEmpty as NonEmpty -import qualified GHC.Stack as Stack -import qualified Patrol.Type.Frame as Frame -import qualified Patrol.Utility.Json as Json - --- | -newtype StackTrace = StackTrace - { frames :: NonEmpty.NonEmpty Frame.Frame - } deriving (Eq, Show) - -instance Aeson.ToJSON StackTrace where - toJSON stackTrace = Aeson.object - [ Json.pair "frames" $ frames stackTrace - ] - -fromCallStack :: Stack.CallStack -> Maybe StackTrace -fromCallStack callStack = do - frames <- NonEmpty.nonEmpty . fmap (uncurry Frame.fromSrcLoc) $ Stack.getCallStack callStack - pure StackTrace { frames } diff --git a/src/lib/Patrol/Type/Timestamp.hs b/src/lib/Patrol/Type/Timestamp.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/Timestamp.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Patrol.Type.Timestamp - ( Timestamp - , fromUtcTime - , toUtcTime - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.Time as Time - --- | -newtype Timestamp - = Timestamp Time.UTCTime - deriving (Eq, Show) - -instance Aeson.ToJSON Timestamp where - toJSON = Aeson.toJSON . Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" . toUtcTime - -fromUtcTime :: Time.UTCTime -> Timestamp -fromUtcTime = Timestamp - -toUtcTime :: Timestamp -> Time.UTCTime -toUtcTime (Timestamp x) = x diff --git a/src/lib/Patrol/Type/User.hs b/src/lib/Patrol/Type/User.hs deleted file mode 100644 --- a/src/lib/Patrol/Type/User.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Patrol.Type.User - ( User(..) - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified Patrol.Utility.Json as Json - -data User = User - { email :: Maybe Text.Text - , id_ :: Maybe Text.Text - , ipAddress :: Maybe Text.Text - , username :: Maybe Text.Text - } deriving (Eq, Show) - -instance Aeson.ToJSON User where - toJSON request = Aeson.object $ Maybe.catMaybes - [ Json.pair "email" <$> email request - , Json.pair "id" <$> id_ request - , Json.pair "ipAddress" <$> ipAddress request - , Json.pair "username" <$> username request - ] diff --git a/src/lib/Patrol/Utility/Json.hs b/src/lib/Patrol/Utility/Json.hs deleted file mode 100644 --- a/src/lib/Patrol/Utility/Json.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Patrol.Utility.Json - ( pair - , required - ) where - -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as Aeson -import qualified Data.String as String - -pair :: (Aeson.ToJSON value, Aeson.KeyValue pair) => String -> value -> pair -pair key value = String.fromString key Aeson..= value - -required :: Aeson.FromJSON value => Aeson.Object -> String -> Aeson.Parser value -required object key = object Aeson..: String.fromString key diff --git a/src/lib/Patrol/Utility/Maybe.hs b/src/lib/Patrol/Utility/Maybe.hs deleted file mode 100644 --- a/src/lib/Patrol/Utility/Maybe.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Patrol.Utility.Maybe - ( note - ) where - -note :: e -> Maybe a -> Either e a -note e = maybe (Left e) Right