mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 18:42:30 +03:00
3fc25a39d3
This improves `parseJSONPath` and `encodeJSONPath` to encode special characters appropriately by delegating to Aeson. This also makes a couple of improvements to `encodeJSONPath`. 1. The function is moved from `Hasura.Base.Error` to `Data.Parser.JSONPath`. This still doesn't seem too appropriate but it is somewhat better. I am basing this on the fact that its test cases already lived in `Data.Parser.JSONPathSpec`. 2. It now returns `Text`, not `String`. 4. It quotes strings with double quotes (`"`) rather than single quotes (`'`), just like JSON. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4935 GitOrigin-RevId: bf44353cd740500245f2e38907a7d6263ae0291c
71 lines
2.9 KiB
Haskell
71 lines
2.9 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 Data.Text qualified as T
|
|
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 "/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)
|