test: make the live Rollbar API specs conditional on ROLLBAR_TOKEN

.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 }}

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)

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 }

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
+  }