symantic-http-test/Hspec/Utils/Server.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 module Hspec.Utils.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 import Symantic.HTTP.Client
  16
  17 -- * Type 'TestServer'
  18 data TestServer = TestServer
  19  { thread :: ThreadId
  20  , socket :: Net.Socket
  21  , env    :: ClientEnv
  22  }
  23
  24 runTestServer :: Wai.Application -> IO TestServer
  25 runTestServer waiApp = do
  26         let baseURI = fromJust $ parseURI "http://localhost:8080"
  27         (port, socket) <- openTestSocket
  28         thread <- forkIO $
  29                 Warp.runSettingsSocket
  30                  (Warp.setPort port $ Warp.defaultSettings)
  31                  socket waiApp
  32         manager <- Client.newManager Client.defaultManagerSettings
  33         return $ TestServer
  34          { env = clientEnv manager baseURI
  35          , .. }
  36
  37 killTestServer :: TestServer -> IO ()
  38 killTestServer TestServer{..} = do
  39         Net.close socket
  40         killThread thread
  41
  42 openTestSocket :: IO (Warp.Port, Net.Socket)
  43 openTestSocket = do
  44         sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
  45         Net.setSocketOption sock Net.ReuseAddr 1
  46         Net.bind sock (Net.SockAddrInet port host)
  47         Net.listen sock 1000
  48         return (port, sock)
  49         where
  50         host = Net.tupleToHostAddress (127, 0, 0, 1)
  51         port = 8080