rollbar-wai (empty) → 0.1.0

raw patch · 9 files changed

+354/−0 lines, 9 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, case-insensitive, hspec, http-types, mtl, process, req, rollbar-client, rollbar-wai, text, unordered-containers, wai, wai-extra, warp

Files

• ChangeLog.md +3/−0
• LICENSE +19/−0
• README.md +13/−0
• Setup.hs +2/−0
• example/Main.hs +18/−0
• rollbar-wai.cabal +102/−0
• src/Rollbar/Wai.hs +103/−0
• test/Rollbar/WaiSpec.hs +93/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,3 @@+# Changelog for rollbar-wai++## Unreleased changes

@@ -0,0 +1,19 @@+Copyright 2020 Stack Builders Inc.++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.

@@ -0,0 +1,13 @@+# Rollbar WAI++Provides error reporting capabilities to+[WAI](http://hackage.haskell.org/package/wai) based applications through+[Rollbar API](https://explorer.docs.rollbar.com/).++## Getting Started++Read the instructions [here](../README.md).++## Example++For a complete example check the link [here](example/Main.hs).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,18 @@+module Main+  ( main+  ) where++import Network.Wai+import Network.Wai.Handler.Warp+import Rollbar.Client (readSettings)+import Rollbar.Wai++main :: IO ()+main = do+  settings <- readSettings "rollbar.yaml"+  runSettings+    (setOnException (rollbarOnException settings) defaultSettings)+    app++app :: Application+app _ _ = error "Boom"

@@ -0,0 +1,102 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 36882de3e15bbc25fa5b54c1ee7d9dbe96436e87f4502b002a3a388508677741++name:           rollbar-wai+version:        0.1.0+synopsis:       Provides error reporting capabilities to WAI based applications through Rollbar API.++description:    Please see the README on GitHub at+                <https://github.com/stackbuilders/rollbar-haskell/tree/master/rollbar-wai>+homepage:       https://github.com/stackbuilders/rollbar-haskell#readme+bug-reports:    https://github.com/stackbuilders/rollbar-haskell/issues+author:         Stack Builders Inc.+maintainer:     Sebastián Estrella <sestrella@stackbuilders.com>+copyright:      2020 Stack Builders Inc.+license:        MIT+license-file:   LICENSE+tested-with:    GHC ==8.6.5, GHC ==8.8.4, GHC ==8.10.2+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/stackbuilders/rollbar-haskell++flag example+  description: Build the example+  manual: False+  default: False++library+  exposed-modules:+      Rollbar.Wai+  other-modules:+      Paths_rollbar_wai+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      aeson >=1.4 && <2+    , base >=4.12 && <5+    , bytestring >=0.10 && <1+    , case-insensitive >=1.2 && <2+    , http-types >=0.12 && <1+    , rollbar-client >=0.1 && <1+    , text >=1.2 && <2+    , unordered-containers >=0.2 && <1+    , wai >=3.2 && <4+    , wai-extra >=3.0 && <4+  default-language: Haskell2010++executable wai-example+  main-is: Main.hs+  other-modules:+      Paths_rollbar_wai+  hs-source-dirs:+      example+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , rollbar-client+    , rollbar-wai+    , wai+    , warp+  if flag(example)+    buildable: True+  else+    buildable: False+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Rollbar.WaiSpec+      Paths_rollbar_wai+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      hspec-discover:hspec-discover >=2.7 && <3+  build-depends:+      aeson+    , base >=4.12 && <5+    , hspec >=2.7 && <3+    , http-types+    , mtl >=2.2 && <3+    , process >=1.6 && <2+    , req >=2.1 && <4+    , rollbar-client+    , rollbar-wai+    , text+    , unordered-containers+    , wai+    , warp >=3.3 && <4+  default-language: Haskell2010

@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Rollbar.Wai+-- Copyright: (c) 2020 Stack Builders Inc.+-- License: MIT+-- Maintainer: Sebastián Estrella <sestrella@stackbuilders.com>+--+-- For a fully working example check the following link:+--+-- <https://github.com/stackbuilders/rollbar-haskell/blob/master/rollbar-wai/example/Main.hs>+module Rollbar.Wai+  ( rollbarOnException+  , rollbarOnExceptionWith+  , mkRequest+  ) where++import qualified Data.CaseInsensitive as CI+import qualified Data.HashMap.Strict as HM+import qualified Data.Text.Encoding as T+import qualified Network.Wai as W+import qualified Network.Wai.Parse as W+import qualified Network.Wai.Request as W++import Control.Concurrent (forkIO)+import Control.Exception+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Aeson+import Network.HTTP.Types (renderQuery)+import Rollbar.Client++-- | Sends the captured 'SomeException' to Rollbar API using the given+-- 'Settings'. Under the hood, this function uses 'createItem' function from+-- rollbar-client.+--+-- __Example__+--+-- > settings <- readSettings "rollbar.yaml"+-- > runSettings+-- >   (setOnException (rollbarOnException settings) defaultSettings)+-- >   app+--+-- @since 0.1.0+rollbarOnException+  :: MonadIO m+  => Settings+  -> Maybe W.Request+  -> SomeException+  -> m ()+rollbarOnException = rollbarOnExceptionWith (void . createItem)++-- | Similar to 'rollbarOnExceptionWith', but it allows customize the function+-- used to send the 'Item' to Rollbar.+--+-- @since 0.1.0+rollbarOnExceptionWith+  :: MonadIO m+  => (Item -> Rollbar ())+  -> Settings+  -> Maybe W.Request+  -> SomeException+  -> m ()+rollbarOnExceptionWith f settings waiRequest ex =+  void $ liftIO $ forkIO $ runRollbar settings $ do+    item <- mkItem $ PayloadTrace $ Trace [] $ mkException ex+    request <- mapM mkRequest waiRequest+    f item+      { itemFramework = Just "wai"+      , itemRequest = request+      }++-- | Transforms a Wai 'W.Request' into a Rollbar 'Request'.+--+-- @since 0.1.0+mkRequest :: MonadIO m => W.Request -> m Request+mkRequest req = liftIO $ do+  (params, _) <- W.parseRequestBody ignoreFiles req+  return Request+    { requestUrl = T.decodeUtf8 $ mconcat+        [ W.guessApproot req+        , W.rawPathInfo req+        , W.rawQueryString req+        ]+    , requestMethod = T.decodeUtf8 $ W.requestMethod req+    , requestHeaders = HM.fromList $ toHeader <$> W.requestHeaders req+    , requestParams = mempty+    , requestGet = HM.fromList $ toQuery <$> W.queryString req+    , requestQueryStrings = T.decodeUtf8 $ renderQuery False $ W.queryString req+    , requestPost = HM.fromList $ fmap toParam params+    , requestBody = ""+    , requestUserIp = ""+    }+  where+    toHeader (key, value) =+      (T.decodeUtf8 $ CI.original key, toJSON $ T.decodeUtf8 value)+    toQuery (key, value) =+      (T.decodeUtf8 key, toJSON $ T.decodeUtf8 <$> value)+    toParam (key, value) =+      (T.decodeUtf8 key, toJSON $ T.decodeUtf8 value)++ignoreFiles :: W.BackEnd ()+ignoreFiles _ _ _ = pure ()

@@ -0,0 +1,93 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Rollbar.WaiSpec+  ( spec+  ) where++import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import qualified Network.Wai as W+import qualified Network.Wai.Handler.Warp as W++import Control.Concurrent (threadDelay)+import Control.Monad (join)+import Control.Monad.IO.Class+import Data.Aeson+import Data.IORef+import Network.HTTP.Req+import Network.HTTP.Types (status200, status404)+import Rollbar.Client+import Rollbar.Wai (rollbarOnExceptionWith)+import Test.Hspec++spec :: Spec+spec = before getSettingsAndItemRef $+  describe "rollbarOnExceptionWith" $ do+    context "when the response status code is 200" $+      it "does not trigger a call to Rollbar" $+        withApp $ \itemRef warpPort -> do+          let url = http "localhost" /: "success"+          response <- runReq+            defaultHttpConfig+            (req GET url NoReqBody bsResponse $ port warpPort)+          responseStatusCode response `shouldBe` 200+          responseBody response `shouldBe` "OK"+          threadDelay 500+          readIORef itemRef `shouldReturn` Nothing++    context "when the response status code is not 200" $+      it "triggers a call to Rollbar" $+        withApp $ \itemRef warpPort -> do+          let url = http "localhost" /: "error"+          response <- fmap responseBody $ runReq+            (defaultHttpConfig { httpConfigCheckResponse = \_ _ _ -> Nothing })+            (req GET url NoReqBody bsResponse $ port warpPort)+          response `shouldBe` "Something went wrong"+          threadDelay 500+          let portAsText = T.pack $ show warpPort+          join . fmap itemRequest <$> readIORef itemRef `shouldReturn` Just+            ( Request+                { requestUrl = "http://localhost:" <> portAsText <> "/error"+                , requestMethod = "GET"+                , requestHeaders = HM.fromList+                    [ ("Accept-Encoding", "gzip")+                    , ("Host", String $ "localhost:" <> portAsText)+                    ]+                , requestParams = mempty+                , requestGet = mempty+                , requestQueryStrings = ""+                , requestPost = mempty+                , requestBody = ""+                , requestUserIp = ""+                }+            )+++getSettingsAndItemRef :: IO (Settings, IORef (Maybe Item))+getSettingsAndItemRef =+  (,) <$> readSettings "rollbar.yaml"+      <*> newIORef Nothing++withApp+  :: (IORef (Maybe Item) -> W.Port -> IO a)+  -> (Settings, IORef (Maybe Item))+  -> IO a+withApp f (settings, itemRef) = do+  let waiSettings = W.setOnException+        (rollbarOnExceptionWith (createItemFake itemRef) settings)+        W.defaultSettings+  W.withApplicationSettings waiSettings (return app) $ f itemRef++app :: W.Application+app wrequest respond =+  case W.rawPathInfo wrequest of+    "/error" -> error "Boom"+    "/success" -> respond $ W.responseLBS status200 [] "OK"+    _ -> respond $ W.responseLBS status404 [] "Not Found"++createItemFake :: IORef (Maybe Item) -> Item -> Rollbar ()+createItemFake itemRef item = do+  requestModifier <- getRequestModifier+  liftIO $ writeIORef itemRef $ Just $+    item { itemRequest = requestModifier <$> itemRequest item }

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}