MockServer.hs

{-# LANGUAGE OverloadedStrings #-}
module TestUtil.MockServer
       ( wsServer,
         parseRequest,
         receiveRequest,
         simpleRawResponse,
         waitForServer
       ) where

import Control.Concurrent (threadDelay)
import Control.Exception.Safe (throwString)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.Monoid ((<>))
import Data.Text (Text, pack)
import Data.UUID (UUID)
import qualified Data.UUID as UUID
import qualified Network.WebSockets as WS

import Network.Greskell.WebSocket.Codec (decodeBinary)
import Network.Greskell.WebSocket.Request (RequestMessage)


wsServer :: Int -- ^ port number
         -> (WS.Connection -> IO ())
         -> IO ()
wsServer p act = WS.runServer "localhost" p $ \pending_conn ->
  act =<< WS.acceptRequest pending_conn

parseRequest :: BSL.ByteString -> Either String RequestMessage
parseRequest raw_msg = do
  (_, payload) <- decodeBinary raw_msg
  Aeson.eitherDecode payload

receiveRequest :: WS.Connection -> IO RequestMessage
receiveRequest wsconn = do
  raw_msg <- WS.receiveData wsconn
  case parseRequest raw_msg of
   Left e -> throwString e
   Right r -> return r

simpleRawResponse :: UUID -> Int -> Text -> Text
simpleRawResponse request_id status_code data_content =
  "{\"requestId\":\"" <> UUID.toText request_id <> "\","
  <> "\"status\":{\"code\":" <> (pack $ show status_code) <> ",\"message\":\"\",\"attributes\":{}},"
  <> "\"result\":{\"data\":" <> data_content <> ",\"meta\":{}}}"

waitForServer :: IO ()
waitForServer = threadDelay 100000