diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +# 0.2.0.0 +Removed sentry support to reduce dependencies diff --git a/simple-logging.cabal b/simple-logging.cabal --- a/simple-logging.cabal +++ b/simple-logging.cabal @@ -1,59 +1,54 @@ -name: simple-logging -version: 0.1.0.0 -cabal-version: >=1.10 -build-type: Simple -license: MIT -license-file: LICENSE -copyright: 2017 Luka Horvat -maintainer: luka.horvat9@gmail.com -homepage: https://gitlab.com/haskell-hr/logging -synopsis: Logging effect to plug into the simple-effects framework -category: Logging -author: Luka Horvat - -source-repository head - type: git - location: https://gitlab.com/haskell-hr/logging.git +name: simple-logging +version: 0.2.0.0 +synopsis: Logging effect to plug into the simple-effects framework +homepage: https://gitlab.com/haskell-hr/logging +license: MIT +license-file: LICENSE +author: Luka Horvat +maintainer: luka.horvat9@gmail.com +copyright: 2017 Luka Horvat +category: Logging +build-type: Simple +extra-source-files: CHANGELOG.md +cabal-version: >=1.10 library - exposed-modules: - Control.Effects.Logging - Control.Effects.Logging.Sentry - build-depends: - base >=4.7 && <5, - aeson >=1.0.2.1, - unordered-containers >=0.2.8.0, - vector >=0.11.0.0, - wreq >=0.5.0.1, - time >=1.6.0.1, - uuid >=1.3.13, - bytestring >=0.10.8.1, - iso8601-time >=0.1.4, - text >=1.2.2.1, - simple-effects >=0.9.0.0, - exceptions >=0.8.3, - mtl >=2.2.1, - string-conv >=0.1.2, - MonadRandom >=0.5.1, - lens >=4.15.1 - default-language: Haskell2010 - default-extensions: NoImplicitPrelude OverloadedStrings - hs-source-dirs: src - other-modules: - Interlude - ghc-options: -Wall + hs-source-dirs: src + exposed-modules: Control.Effects.Logging + other-modules: Interlude + build-depends: base >= 4.7 && < 5 + , aeson + , vector + , time + , bytestring + , iso8601-time + , text + , simple-effects + , exceptions + , mtl + , string-conv + , lens + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: NoImplicitPrelude + OverloadedStrings test-suite logging-test - type: exitcode-stdio-1.0 - main-is: Spec.hs - build-depends: - base >=4.9.1.0, - logging -any, - simple-effects >=0.9.0.0 - default-language: Haskell2010 - default-extensions: MultiParamTypeClasses TypeFamilies - NoMonomorphismRestriction FlexibleContexts NoImplicitPrelude - hs-source-dirs: test - other-modules: - Module1 - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Module1 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , logging + , simple-effects >= 0.9.0.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + default-extensions: MultiParamTypeClasses + TypeFamilies + NoMonomorphismRestriction + FlexibleContexts + NoImplicitPrelude + +source-repository head + type: git + location: https://gitlab.com/haskell-hr/logging.git diff --git a/src/Control/Effects/Logging/Sentry.hs b/src/Control/Effects/Logging/Sentry.hs deleted file mode 100644 --- a/src/Control/Effects/Logging/Sentry.hs +++ /dev/null @@ -1,102 +0,0 @@ -{-# LANGUAGE TupleSections, OverloadedLists, ScopedTypeVariables, RecordWildCards #-} -module Control.Effects.Logging.Sentry where - -import Prelude (String) -import Interlude -import qualified Data.Vector as Vector -import qualified Data.HashMap.Strict as Map -import Text.ParserCombinators.ReadP -import Data.UUID -import Control.Lens hiding ((.=), Level, Context) - -import Data.Aeson.Types (Value(..)) -import Data.Aeson (toJSON, object, (.=)) -import Network.Wreq - -import Data.Time.ISO8601 -import Data.Time (getCurrentTime) - -import Control.Effects.Logging - --- import Control.Effects - -tagToPair :: Tag -> (String, String) -tagToPair (Tag t) = (toS t, "") - -levelToSentry :: Level -> Text -levelToSentry Fatal = "fatal" -levelToSentry Error = "error" -levelToSentry Warning = "warning" -levelToSentry Info = "info" -levelToSentry Debug = "debug" - -data SentryService = SentryService { serviceEndpoint :: Text - , servicePublicKey :: Text - , serviceSecretKey :: Text } - deriving (Eq, Ord, Read, Show) - -alphaNum :: ReadP Char -alphaNum = satisfy isAlphaNum - -sentryServiceFromDSN :: Text -> SentryService -sentryServiceFromDSN txt = fst $ fromMaybe (error "Failed to parse DSN") - (listToMaybe (readP_to_S parser (toS txt))) - where parser = do - protocol <- many1 alphaNum - void $ string "://" - public <- many1 alphaNum - void $ char ':' - secret <- many1 alphaNum - void $ char '@' - host <- many1 (satisfy (const True)) - void $ char '/' - projId <- many1 (satisfy isDigit) - eof - return (SentryService (toS $ protocol <> "://" <> host <> "/api/" <> projId <> "/store/") - (toS public) - (toS secret)) - -contextToFrame :: Context -> Value -contextToFrame (Context ctx) = object ["module" .= String ctx] - -contextToFrames :: [Context] -> Value -contextToFrames ctxs = object - ["frames" .= Array (Vector.fromList (reverse (top : fmap contextToFrame ctxs)))] - where top = object ["module" .= String "top layer"] - -currentWreqOptions :: Text -> Text -> Text -> Network.Wreq.Options -currentWreqOptions stamp public secret = - defaults & header "X-Sentry-Auth" .~ [ - "Sentry sentry_version=7,\ - \sentry_client=0.1,\ - \sentry_timestamp=" <> pshow stamp <> ",\ - \sentry_key=" <> toS public <> ",\ - \sentry_secret=" <> toS secret] - & header "Content-Type" .~ ["application/json"] - -addInterface :: ToJSON a => Text -> Maybe a -> [(Text, Value)] -> [(Text, Value)] -addInterface _ Nothing is = is -addInterface name (Just a) is = (name, toJSON a) : is - -logToSentry :: (MonadIO m, MonadRandom m) => SentryService -> EffectHandler Logging m a -> m a -logToSentry svc = handleLogging $ \Log{..} -> do - uuid :: UUID <- getRandom - time <- liftIO getCurrentTime - let stamp = toS $ formatISO8601 time - let opts = currentWreqOptions stamp (servicePublicKey svc) (serviceSecretKey svc) - let evId = filter (/= '-') (pshow uuid :: String) - let frames = contextToFrames logContext - let crumbs = Array (Vector.fromList (fmap toJSON logCrumbs)) - let message = Object (Map.fromList ( - [ ("event_id", String (toS evId)) - , ("message", String logMessage) - , ("timestamp", String stamp) - , ("level", String (levelToSentry logLevel)) - , ("logger", String "logger") - , ("platform", String "haskell") - , ("fingerprint", Array [String stamp]) - , ("extra", object [("data", String (toS logData))]) - , ("sentry.interfaces.Breadcrumbs", crumbs) - , ("sentry.interfaces.Stacktrace", frames) ] - & addInterface "sentry.interfaces.User" logUser)) - void $ liftIO $ forkIO $ void $ postWith opts (toS $ serviceEndpoint svc) message diff --git a/src/Interlude.hs b/src/Interlude.hs --- a/src/Interlude.hs +++ b/src/Interlude.hs @@ -15,7 +15,6 @@ import Data.Maybe as X import Data.Text as X (Text) import Data.Aeson as X hiding (Error) -import Control.Monad.Random as X import Data.Char as X import Control.Concurrent as X