SimpleServer.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.SimpleServer
  ( -- * functions
    statusOfGet
  , statusOfGet'

    -- * test constants
  , defaultTLSSettings
  )
where

import           Data.List                   (foldl')

import           Data.Text                   (Text)
import qualified Data.Text                   as Text

import qualified Network.Connection          as HC
import qualified Network.HTTP.Client         as HC
import           Network.HTTP.Client.TLS     (mkManagerSettings)
import           Network.HTTP.Req
import qualified Network.Wai.Handler.Warp    as Warp
import qualified Network.Wai.Handler.WarpTLS as Warp


-- | Determine the status from a Get on localhost.
statusOfGet :: Warp.Port -> Text -> IO Int
statusOfGet p path = runReq defaultHttpConfig $ do
  r <- req GET (localUrl path) NoReqBody ignoreResponse $ port p
  return $ responseStatusCode r


statusOfGet' :: Int -> Text -> IO Int
statusOfGet' p path = do
  manager <- mkSimpleTLSManager
  runReq (defaultHttpConfig { httpConfigAltManager = Just manager }) $ do
    r <- req GET (localHttpsUrl path) NoReqBody ignoreResponse $ port p
    return $ responseStatusCode r


localUrl :: Text -> Url 'Http
localUrl p = foldl' (/:) (http "localhost")
  $ Text.splitOn "/" $ Text.dropWhile (== '/') p


localHttpsUrl :: Text -> Url 'Https
localHttpsUrl p = foldl' (/:) (https "localhost")
  $ Text.splitOn "/" $ Text.dropWhile (== '/') p


defaultTLSSettings :: Warp.TLSSettings
defaultTLSSettings = Warp.tlsSettings "test_certs/certificate.pem" "test_certs/key.pem"


mkSimpleTLSManager :: IO HC.Manager
mkSimpleTLSManager = HC.newManager
  $ mkManagerSettings (HC.TLSSettingsSimple True False False) Nothing