{-# 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