Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Sends Happstack exceptions to Honeybadger.
#!/usr/bin/env stack
-- stack --resolver lts-12.10 script
{-# OPTIONS_GHC -Weverything -Wno-unsafe -Wno-implicit-prelude #-}
module Main ( main ) where
import qualified Control.Concurrent as Concurrent
import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Catch
import qualified Control.Monad.IO.Class as IO
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import qualified GHC.Stack as Stack
import qualified Happstack.Server as Happstack
import qualified Network.HTTP.Client.TLS as Tls
import qualified Ratel
import qualified System.Directory as Directory
import qualified System.Environment as Environment
main :: Stack.HasCallStack => IO ()
main = do
putStrLn "Starting up ..."
[honeybadgerApiKey] <- Environment.getArgs
manager <- Tls.newTlsManager
directory <- Directory.getCurrentDirectory
Happstack.simpleHTTP Happstack.nullConf $ Catch.catch
(mconcat
[ Happstack.dir "undefined" undefined
, Happstack.ok "Hello, world!"
])
(\ exception -> do
request <- Happstack.askRq
Monad.void . IO.liftIO . Concurrent.forkIO $ do
print (exception :: Catch.SomeException)
Monad.void $ Ratel.notify honeybadgerApiKey (Just manager) Ratel.Payload
{ Ratel.payloadError = Ratel.toError exception
, Ratel.payloadNotifier = Nothing
, Ratel.payloadRequest = Just Ratel.Request
{ Ratel.requestAction = Just . show $ Happstack.rqMethod request
, Ratel.requestCgiData = Just
. Map.fromList
. Maybe.mapMaybe (\ header -> case Happstack.hValue header of
value : _ -> Just
( Text.unpack . Text.decodeUtf8 $ Happstack.hName header
, Text.unpack $ Text.decodeUtf8 value
)
_ -> Nothing)
. Map.elems
$ Happstack.rqHeaders request
, Ratel.requestComponent = Just "controller.action"
, Ratel.requestContext = Nothing
, Ratel.requestParams = Just
. Map.fromList
. Maybe.mapMaybe (\ ( name, input ) ->
case Happstack.inputValue input of
Right bytes -> Just
( name
, LazyText.unpack $ LazyText.decodeUtf8 bytes
)
_ -> Nothing)
$ Happstack.rqInputsQuery request
, Ratel.requestSession = Nothing
, Ratel.requestUrl = Just $ Happstack.rqUri request
}
, Ratel.payloadServer = Ratel.Server
{ Ratel.serverEnvironmentName = Just "development"
, Ratel.serverHostname = Just "localhost"
, Ratel.serverProjectRoot = Just . Ratel.Project $ Just directory
}
}
Happstack.internalServerError "oh no")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.