diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index e491939..21c6e90 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -30,7 +30,7 @@ jobs: with: cabal-file: rollbar-client/rollbar-client.cabal ubuntu-version: latest - macos-version: 13 + macos-version: latest version: 0.1.7.0 build: name: GHC ${{ matrix.ghc }} on ${{ matrix.os }} @@ -77,4 +77,7 @@ jobs: - name: Run tests run: cabal test all env: + # When this secret is missing or empty, the specs that talk to the + # real Rollbar API are skipped; setting a valid token re-enables + # them without any workflow changes. ROLLBAR_TOKEN: ${{ secrets.ROLLBAR_TOKEN }} diff --git a/rollbar-client/test/Rollbar/ClientSpec.hs b/rollbar-client/test/Rollbar/ClientSpec.hs index d45b5ad..8fba5f0 100644 --- a/rollbar-client/test/Rollbar/ClientSpec.hs +++ b/rollbar-client/test/Rollbar/ClientSpec.hs @@ -16,6 +16,7 @@ import Data.Text.Encoding import Data.Text as T import Data.Yaml.Config import Rollbar.Client +import System.Environment (lookupEnv) import Test.Hspec data Package = Package @@ -94,57 +95,12 @@ spec = do , notifierVersion = packageVersion } - before (readSettings "rollbar.yaml") $ do - describe "ping" $ - it "returns Pong" $ \settings -> - runRollbar settings ping `shouldReturn` Pong - - describe "createItem" $ do - context "PayloadTrace" $ - it "returns ItemId" $ \settings -> do - itemId <- runRollbar settings $ do - item <- mkItem $ PayloadTrace $ Trace [] $ Exception - { exceptionClass = "NameError" - , exceptionMessage = Just "global name 'foo' is not defined" - , exceptionDescription = Just "Something went wrong while trying to save the user object" - } - createItem item - - itemId `shouldSatisfy` const True - - context "PayloadTraceChain" $ - it "returns ItemId" $ \settings -> do - itemId <- runRollbar settings $ do - item <- mkItem $ PayloadTraceChain $ pure $ Trace [] $ Exception - { exceptionClass = "NameError" - , exceptionMessage = Just "global name 'foo' is not defined" - , exceptionDescription = Just "Something went wrong while trying to save the user object" - } - createItem item - - itemId `shouldSatisfy` const True - - context "PayloadMessage" $ - it "returns ItemId" $ \settings -> do - itemId <- runRollbar settings $ do - item <- mkItem $ PayloadMessage $ Message - { messageBody = "Request over threshold of 10 seconds" - , messageMetadata = KM.fromList - [ ("route", "home#index") - , ("time_elapsed", Number 15.23) - ] - } - createItem item - - itemId `shouldSatisfy` const True - - describe "reportDeploy" $ - it "returns DeployId" $ \settings -> do - deployId <- runRollbar settings $ do - deploy <- getRevision >>= mkDeploy - reportDeploy deploy - - deployId `shouldSatisfy` (> 0) + mtoken <- runIO $ lookupEnv "ROLLBAR_TOKEN" + if mtoken == Nothing || mtoken == Just "" + then describe "live API specs" $ + it "run only when ROLLBAR_TOKEN is set" $ + pendingWith "ROLLBAR_TOKEN is not set" + else liveApiSpecs describe "ToJSON Item" $ do context "when serializing to JSON" $ do @@ -170,3 +126,58 @@ spec = do it "includes fields if they are Just values" $ T.unpack jsonItem `shouldContain` "\"platform\":\"haskell\"" + +-- | Specs that talk to the real Rollbar API; they run only when +-- ROLLBAR_TOKEN is set. +liveApiSpecs :: Spec +liveApiSpecs = before (readSettings "rollbar.yaml") $ do + describe "ping" $ + it "returns Pong" $ \settings -> + runRollbar settings ping `shouldReturn` Pong + + describe "createItem" $ do + context "PayloadTrace" $ + it "returns ItemId" $ \settings -> do + itemId <- runRollbar settings $ do + item <- mkItem $ PayloadTrace $ Trace [] $ Exception + { exceptionClass = "NameError" + , exceptionMessage = Just "global name 'foo' is not defined" + , exceptionDescription = Just "Something went wrong while trying to save the user object" + } + createItem item + + itemId `shouldSatisfy` const True + + context "PayloadTraceChain" $ + it "returns ItemId" $ \settings -> do + itemId <- runRollbar settings $ do + item <- mkItem $ PayloadTraceChain $ pure $ Trace [] $ Exception + { exceptionClass = "NameError" + , exceptionMessage = Just "global name 'foo' is not defined" + , exceptionDescription = Just "Something went wrong while trying to save the user object" + } + createItem item + + itemId `shouldSatisfy` const True + + context "PayloadMessage" $ + it "returns ItemId" $ \settings -> do + itemId <- runRollbar settings $ do + item <- mkItem $ PayloadMessage $ Message + { messageBody = "Request over threshold of 10 seconds" + , messageMetadata = KM.fromList + [ ("route", "home#index") + , ("time_elapsed", Number 15.23) + ] + } + createItem item + + itemId `shouldSatisfy` const True + + describe "reportDeploy" $ + it "returns DeployId" $ \settings -> do + deployId <- runRollbar settings $ do + deploy <- getRevision >>= mkDeploy + reportDeploy deploy + + deployId `shouldSatisfy` (> 0) diff --git a/rollbar-wai/test/Rollbar/WaiSpec.hs b/rollbar-wai/test/Rollbar/WaiSpec.hs index 8dd8edc..d1681ee 100644 --- a/rollbar-wai/test/Rollbar/WaiSpec.hs +++ b/rollbar-wai/test/Rollbar/WaiSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} module Rollbar.WaiSpec @@ -11,42 +12,43 @@ import qualified Network.Wai as W import qualified Network.Wai.Handler.Warp as W import Control.Concurrent (threadDelay) -import Control.Monad (join) +import Control.Concurrent.MVar +import Control.Monad (void) 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 System.Timeout (timeout) import Test.Hspec spec :: Spec -spec = before getSettingsAndItemRef $ +spec = before getSettingsAndItemVar $ describe "rollbarOnExceptionWith" $ do context "when the response status code is 200" $ it "does not trigger a call to Rollbar" $ - withApp $ \itemRef warpPort -> do + withApp $ \itemVar 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 + threadDelay 100_000 + tryReadMVar itemVar `shouldReturn` Nothing context "when the response status code is not 200" $ it "triggers a call to Rollbar" $ - withApp $ \itemRef warpPort -> do + withApp $ \itemVar 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 + item <- timeout 5_000_000 $ readMVar itemVar let portAsText = T.pack $ show warpPort - join . fmap itemRequest <$> readIORef itemRef `shouldReturn` Just + (item >>= itemRequest) `shouldBe` Just ( Request { requestUrl = "http://localhost:" <> portAsText <> "/error" , requestMethod = "GET" @@ -64,20 +66,29 @@ spec = before getSettingsAndItemRef $ ) -getSettingsAndItemRef :: IO (Settings, IORef (Maybe Item)) -getSettingsAndItemRef = - (,) <$> readSettings "rollbar.yaml" - <*> newIORef Nothing +getSettingsAndItemVar :: IO (Settings, MVar Item) +getSettingsAndItemVar = + (,) <$> pure testSettings + <*> newEmptyMVar + +-- | These specs never call the Rollbar API, so any token works. +testSettings :: Settings +testSettings = Settings + { settingsToken = Token "invalid-token" + , settingsEnvironment = Environment "test" + , settingsRevision = Nothing + , settingsRequestModifiers = defaultRequestModifiers + } withApp - :: (IORef (Maybe Item) -> W.Port -> IO a) - -> (Settings, IORef (Maybe Item)) + :: (MVar Item -> W.Port -> IO a) + -> (Settings, MVar Item) -> IO a -withApp f (settings, itemRef) = do +withApp f (settings, itemVar) = do let waiSettings = W.setOnException - (rollbarOnExceptionWith (createItemFake itemRef) settings) + (rollbarOnExceptionWith (createItemFake itemVar) settings) W.defaultSettings - W.withApplicationSettings waiSettings (return app) $ f itemRef + W.withApplicationSettings waiSettings (return app) $ f itemVar app :: W.Application app wrequest respond = @@ -86,8 +97,11 @@ app wrequest respond = "/success" -> respond $ W.responseLBS status200 [] "OK" _ -> respond $ W.responseLBS status404 [] "Not Found" -createItemFake :: IORef (Maybe Item) -> Item -> Rollbar () -createItemFake itemRef item = do +-- | Hands the first reported 'Item' to the test instead of calling the API; +-- warp may report more than one exception per connection, so later ones are +-- ignored rather than overwriting it. +createItemFake :: MVar Item -> Item -> Rollbar () +createItemFake itemVar item = do requestModifier <- getRequestModifier - liftIO $ writeIORef itemRef $ Just $ + void $ liftIO $ tryPutMVar itemVar $ item { itemRequest = requestModifier <$> itemRequest item } diff --git a/rollbar-yesod/test/Rollbar/YesodSpec.hs b/rollbar-yesod/test/Rollbar/YesodSpec.hs index 4f6bcab..3812555 100644 --- a/rollbar-yesod/test/Rollbar/YesodSpec.hs +++ b/rollbar-yesod/test/Rollbar/YesodSpec.hs @@ -76,5 +76,13 @@ withApp = before $ do return (app, id) where getApp = - App <$> readSettings "rollbar.yaml" - <*> newIORef Nothing + App testSettings <$> newIORef Nothing + +-- | These specs never call the Rollbar API, so any token works. +testSettings :: Settings +testSettings = Settings + { settingsToken = Token "invalid-token" + , settingsEnvironment = Environment "test" + , settingsRevision = Nothing + , settingsRequestModifiers = defaultRequestModifiers + }