test/Hspec/Client/Server.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 module Hspec.Client.Server where
   3
   4 import Control.Concurrent (ThreadId, forkIO, killThread)
   5 import Control.Monad (Monad(..))
   6 import Data.Function (($))
   7 import Data.Maybe (fromJust)
   8 import System.IO (IO)
   9 import qualified Network.HTTP.Client as Client
  10 import qualified Network.Socket as Net
  11 import qualified Network.Wai as Wai
  12 import qualified Network.Wai.Handler.Warp as Warp
  13
  14 import Symantic.HTTP
  15
  16 -- * Type 'TestServer'
  17 data TestServer = TestServer
  18  { thread :: ThreadId
  19  , socket :: Net.Socket
  20  , env    :: ClientEnv
  21  }
  22
  23 runTestServer :: Wai.Application -> IO TestServer
  24 runTestServer waiApp = do
  25         let baseURI = fromJust $ parseURI "http://localhost:8080"
  26         (port, socket) <- openTestSocket
  27         thread <- forkIO $
  28                 Warp.runSettingsSocket
  29                  (Warp.setPort port $ Warp.defaultSettings)
  30                  socket waiApp
  31         manager <- Client.newManager Client.defaultManagerSettings
  32         return $ TestServer
  33          { env = clientEnv manager baseURI
  34          , .. }
  35
  36 killTestServer :: TestServer -> IO ()
  37 killTestServer TestServer{..} = do
  38         Net.close socket
  39         killThread thread
  40
  41 openTestSocket :: IO (Warp.Port, Net.Socket)
  42 openTestSocket = do
  43         sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
  44         Net.setSocketOption sock Net.ReuseAddr 1
  45         Net.bind sock (Net.SockAddrInet port host)
  46         Net.listen sock 1000
  47         return (port, sock)
  48         where
  49         host = Net.tupleToHostAddress (127, 0, 0, 1)
  50         port = 8080