Server.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
module Hspec.Utils.Server where

import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Monad (Monad(..))
import Data.Function (($))
import Data.Maybe (fromJust)
import System.IO (IO)
import qualified Network.HTTP.Client as Client
import qualified Network.Socket as Net
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp

import Symantic.HTTP
import Symantic.HTTP.Client

-- * Type 'TestServer'
data TestServer = TestServer
 { thread :: ThreadId
 , socket :: Net.Socket
 , env    :: ClientEnv
 }

runTestServer :: Wai.Application -> IO TestServer
runTestServer waiApp = do
	let baseURI = fromJust $ parseURI "http://localhost:8080"
	(port, socket) <- openTestSocket
	thread <- forkIO $
		Warp.runSettingsSocket
		 (Warp.setPort port $ Warp.defaultSettings)
		 socket waiApp
	manager <- Client.newManager Client.defaultManagerSettings
	return $ TestServer
	 { env = clientEnv manager baseURI
	 , .. }

killTestServer :: TestServer -> IO ()
killTestServer TestServer{..} = do
	Net.close socket
	killThread thread

openTestSocket :: IO (Warp.Port, Net.Socket)
openTestSocket = do
	sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
	Net.setSocketOption sock Net.ReuseAddr 1
	Net.bind sock (Net.SockAddrInet port host)
	Net.listen sock 1000
	return (port, sock)
	where
	host = Net.tupleToHostAddress (127, 0, 0, 1)
	port = 8080