simple-logging 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+52/−158 lines, 4 filesdep −MonadRandomdep −unordered-containersdep −uuiddep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies removed: MonadRandom, unordered-containers, uuid, wreq

Dependency ranges changed: aeson, base, bytestring, exceptions, iso8601-time, lens, mtl, simple-effects, string-conv, text, time, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +2/−0
• simple-logging.cabal +50/−55
• src/Control/Effects/Logging/Sentry.hs +0/−102
• src/Interlude.hs +0/−1

@@ -0,0 +1,2 @@+# 0.2.0.0
+Removed sentry support to reduce dependencies

@@ -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

@@ -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

@@ -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