mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 17:31:56 +03:00
68 lines
2.8 KiB
Haskell
68 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 Control.Monad.IO.Class (liftIO)
|
||
|
|
import Data.Aeson qualified as Aeson
|
||
|
|
import Data.Parser.JSONPath (parseJSONPath)
|
||
|
|
import Harness.Http qualified as Http
|
||
|
|
import Harness.TestEnvironment (Server (..), serverUrl)
|
||
|
|
import Hasura.Base.Error (iResultToMaybe)
|
||
|
|
import Hasura.Prelude (fromMaybe)
|
||
|
|
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
|
||
|
|
import Prelude
|
||
|
|
|
||
|
|
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 "/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 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)
|