YesodSpec.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

module Rollbar.YesodSpec
  ( spec
  ) where

import qualified Network.Wai as W

import Data.IORef
import Data.Maybe
import Rollbar.Client
import Rollbar.Yesod
import Test.Hspec
import Yesod.Core
import Yesod.Test

data App = App
  { appRollbarSettings :: Settings
  , appRequestRef :: IORef (Maybe W.Request)
  }

mkYesod "App" [parseRoutes|
  /error ErrorR GET
  /success SuccessR GET
|]

instance HasSettings Handler where
  getSettings = getsYesod appRollbarSettings

instance Yesod App where
  yesodMiddleware handler = do
    requestRef <- getsYesod appRequestRef
    rollbarYesodMiddlewareWith (writeRequest requestRef) $
      defaultYesodMiddleware handler
    where
      writeRequest requestRef _ wrequest _ =
        liftIO $ writeIORef requestRef $ Just wrequest

getErrorR :: Handler ()
getErrorR = error "Boom"

getSuccessR :: Handler ()
getSuccessR = return ()

spec :: Spec
spec = withApp $
  describe "rollbarYesodMiddlewareWith" $ do
    context "when there is an error" $
      it "triggers a call to Rollbar" $ do
        get ErrorR
        statusIs 500
        requestRef <- appRequestRef <$> getTestYesod
        liftIO $ do
          wrequest <- readIORef requestRef
          wrequest `shouldSatisfy` isJust

    context "when there is no error" $
      it "does not trigger a call to Rollbar" $ do
        get SuccessR
        statusIs 200
        requestRef <- appRequestRef <$> getTestYesod
        liftIO $ do
          wrequest <- readIORef requestRef
          wrequest `shouldSatisfy` isNothing


withApp :: SpecWith (TestApp App) -> Spec
withApp = before $ do
  app <- getApp
  return (app, id)
  where
    getApp =
      App <$> readSettings "rollbar.yaml"
          <*> newIORef Nothing