graphql-engine/server/tests-hspec/Harness/Webhook.hs
Philip Lykke Carlsen b658df1c43 Spike attempt at adding logging to the hspec test-suite
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4772
Co-authored-by: Gil Mizrahi <8547573+soupi@users.noreply.github.com>
GitOrigin-RevId: 5c6c9056952574462d5b309774331a909a7eac6d
2022-08-03 14:19:53 +00:00

69 lines
2.8 KiB
Haskell

-- | Functions to setup and run a dedicated webhook server
module Harness.Webhook
( run,
EventsQueue (..),
)
where
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan qualified as Chan
import Control.Exception.Safe (bracket)
import Data.Aeson qualified as Aeson
import Data.Parser.JSONPath (parseJSONPath)
import Data.Text qualified as T
import Harness.Http qualified as Http
import Harness.TestEnvironment (Server (..), serverUrl)
import Hasura.Base.Error (iResultToMaybe)
import Hasura.Prelude
import Hasura.Server.Utils (executeJSONPath)
import Network.Socket qualified as Socket
import Network.Wai.Extended qualified as Wai
import Network.Wai.Handler.Warp qualified as Warp
import Web.Spock.Core qualified as Spock
newtype EventsQueue = EventsQueue (Chan.Chan Aeson.Value)
-- | This function starts a new thread with a minimal server on the
-- first available port. It returns the corresponding 'Server'.
--
-- This new server serves the following routes:
-- - GET on @/@, which returns a simple 200 OK;
-- - POST on @/echo@, which extracts the event data from the body
-- of the request and inserts it into the `EventsQueue`.
--
-- This function performs a health check, using a GET on /, to ensure that the
-- server was started correctly, and will throw an exception if the health check
-- fails. This function does NOT attempt to kill the thread in such a case,
-- which might result in a leak if the thread is still running but the server
-- fails its health check.
run :: IO (Server, EventsQueue)
run = do
let urlPrefix = "http://127.0.0.1"
port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst)
eventsQueueChan <- Chan.newChan
let eventsQueue = EventsQueue eventsQueueChan
threadId <- forkIO $
Spock.runSpockNoBanner port $
Spock.spockT id $ do
Spock.get "/" $
Spock.json $ Aeson.String "OK"
Spock.post "/hello" $
Spock.json $ Aeson.String "world"
Spock.post "/echo" $ do
req <- Spock.request
body <- liftIO $ Wai.strictRequestBody req
let jsonBody = Aeson.decode body
let eventDataPayload =
-- Only extract the data payload from the request body
let mkJSONPathE = either (error . T.unpack) id . parseJSONPath
eventJSONPath = mkJSONPathE "$.event.data"
in iResultToMaybe =<< executeJSONPath eventJSONPath <$> jsonBody
liftIO $
Chan.writeChan eventsQueueChan $
fromMaybe (error "error in parsing the event data from the body") eventDataPayload
Spock.setHeader "Content-Type" "application/json; charset=utf-8"
Spock.json $ Aeson.object ["success" Aeson..= True]
let server = Server {port = fromIntegral port, urlPrefix, threadId}
Http.healthCheck $ serverUrl server
pure (server, eventsQueue)