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