AnIntro.md

Example use:

> import Network.HTTP.Simple
> import qualified Data.ByteString.Char8 as B8
> :set -XOverloadedStrings
> import Data.String
> withWebService (responseBs "Hello!") (\port -> httpBS (fromString ("http://localhost:" ++ show port)) >>= B8.putStrLn . getResponseBody)
Hello!
>

Harness.WebService.hs

-- | A harness for temporarily running a web service for testing
-- purposes.

{-# OPTIONS_GHC -fno-warn-deprecations #-}

module Harness.WebService
  ( withWebService
  , responseBs
  , responseLbs
  ) where

import qualified Control.Concurrent.Async as Async
import qualified Control.Exception
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Network.BSD as Network
import qualified Network.HTTP.Types as Warp
import qualified Network.Socket as Network
import qualified Network.Wai as Warp
import qualified Network.Wai.Handler.Warp as Warp

-- | A port number.
type Port = Int

-- | Respond with a simple bytestring.
responseBs :: S.ByteString -> Warp.Application
responseBs = responseLbs . L.fromStrict

-- | Respond with a simple lazy bytestring.
responseLbs :: L.ByteString -> Warp.Application
responseLbs bs = \_req respond -> respond (Warp.responseLBS Warp.status200 [] bs)

-- | Run an action with a web service.
withWebService :: Warp.Application -> (Port -> IO a) -> IO a
withWebService app client = do
  socket <- listenOnLoopback
  port <- fmap fromIntegral (Network.socketPort socket)
  Async.withAsync
    (runWarpOnSocket
       (Warp.setOnException ignoreExceptions Warp.defaultSettings)
       socket
       app)
    (\_async -> client port)
  where
    ignoreExceptions :: Maybe a -> Control.Exception.SomeException -> IO ()
    ignoreExceptions _req _ex = pure ()

-- | Run a warp server on the given socket.
runWarpOnSocket :: Warp.Settings -> Network.Socket -> Warp.Application -> IO ()
runWarpOnSocket settings socket app = do
  port <- fmap fromIntegral (Network.socketPort socket)
  Warp.runSettingsSocket (Warp.setPort port settings) socket app

-- | Copied from intero, so I know it works.
listenOnLoopback :: IO Network.Socket
listenOnLoopback = do
  proto <- Network.getProtocolNumber "tcp"
  Control.Exception.bracketOnError
    (Network.socket Network.AF_INET Network.Stream proto)
    Network.close
    (\sock -> do
       Network.setSocketOption sock Network.ReuseAddr 1
       address <- Network.getHostByName "127.0.0.1"
       Network.bind
         sock
         (Network.SockAddrInet Network.aNY_PORT (Network.hostAddress address))
       Network.listen sock Network.maxListenQueue
       return sock)