]> Git — Sourcephile - haskell/symantic-http.git/blob - symantic-http-test/Hspec/Utils/Server.hs
stack: bump to lts-14.13
[haskell/symantic-http.git] / 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