|
| 1 | +-- | Functions to setup and run a dedicated webhook server |
| 2 | +module Harness.Webhook |
| 3 | + ( run, |
| 4 | + EventsQueue (..), |
| 5 | + ) |
| 6 | +where |
| 7 | + |
| 8 | +import Control.Concurrent (forkIO) |
| 9 | +import Control.Concurrent.Chan qualified as Chan |
| 10 | +import Control.Exception.Safe (bracket) |
| 11 | +import Control.Monad.IO.Class (liftIO) |
| 12 | +import Data.Aeson qualified as Aeson |
| 13 | +import Data.Parser.JSONPath (parseJSONPath) |
| 14 | +import Harness.Http qualified as Http |
| 15 | +import Harness.TestEnvironment (Server (..), serverUrl) |
| 16 | +import Hasura.Base.Error (iResultToMaybe) |
| 17 | +import Hasura.Prelude (fromMaybe) |
| 18 | +import Hasura.Server.Utils (executeJSONPath) |
| 19 | +import Network.Socket qualified as Socket |
| 20 | +import Network.Wai.Extended qualified as Wai |
| 21 | +import Network.Wai.Handler.Warp qualified as Warp |
| 22 | +import Web.Spock.Core qualified as Spock |
| 23 | +import Prelude |
| 24 | + |
| 25 | +newtype EventsQueue = EventsQueue (Chan.Chan Aeson.Value) |
| 26 | + |
| 27 | +-- | This function starts a new thread with a minimal server on the |
| 28 | +-- first available port. It returns the corresponding 'Server'. |
| 29 | +-- |
| 30 | +-- This new server serves the following routes: |
| 31 | +-- - GET on @/@, which returns a simple 200 OK; |
| 32 | +-- - POST on @/echo@, which extracts the event data from the body |
| 33 | +-- of the request and inserts it into the `EventsQueue`. |
| 34 | +-- |
| 35 | +-- This function performs a health check, using a GET on /, to ensure that the |
| 36 | +-- server was started correctly, and will throw an exception if the health check |
| 37 | +-- fails. This function does NOT attempt to kill the thread in such a case, |
| 38 | +-- which might result in a leak if the thread is still running but the server |
| 39 | +-- fails its health check. |
| 40 | +run :: IO (Server, EventsQueue) |
| 41 | +run = do |
| 42 | + let urlPrefix = "http://127.0.0.1" |
| 43 | + port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst) |
| 44 | + eventsQueueChan <- Chan.newChan |
| 45 | + let eventsQueue = EventsQueue eventsQueueChan |
| 46 | + threadId <- forkIO $ |
| 47 | + Spock.runSpockNoBanner port $ |
| 48 | + Spock.spockT id $ do |
| 49 | + Spock.get "/" $ |
| 50 | + Spock.json $ Aeson.String "OK" |
| 51 | + Spock.post "/echo" $ do |
| 52 | + req <- Spock.request |
| 53 | + body <- liftIO $ Wai.strictRequestBody req |
| 54 | + let jsonBody = Aeson.decode body |
| 55 | + let eventDataPayload = |
| 56 | + -- Only extract the data payload from the request body |
| 57 | + let mkJSONPathE = either error id . parseJSONPath |
| 58 | + eventJSONPath = mkJSONPathE "$.event.data" |
| 59 | + in iResultToMaybe =<< executeJSONPath eventJSONPath <$> jsonBody |
| 60 | + liftIO $ |
| 61 | + Chan.writeChan eventsQueueChan $ |
| 62 | + fromMaybe (error "error in parsing the event data from the body") eventDataPayload |
| 63 | + Spock.setHeader "Content-Type" "application/json; charset=utf-8" |
| 64 | + Spock.json $ Aeson.object ["success" Aeson..= True] |
| 65 | + let server = Server {port = fromIntegral port, urlPrefix, threadId} |
| 66 | + Http.healthCheck $ serverUrl server |
| 67 | + pure (server, eventsQueue) |
0 commit comments