servant-combinators-0.0.1: tests/TestRawQueryString.hs

module TestRawQueryString where

import Data.ByteString
import Network.HTTP.Client (method)
import Servant
import Servant.API.RawQueryString
import Test.QuickCheck.Monadic (PropertyM (..), assert, monadicIO)
import Test.Tasty
import TestLib (returns400, success)

import qualified Network.HTTP.Simple as S
import qualified Test.Tasty.QuickCheck as QC

type RawQueryStrAPI =
  "check-raw-query" :> RawQueryString :> Get '[JSON] NoContent

rawQueryStrServer :: Server RawQueryStrAPI
rawQueryStrServer = rawQuery
  where
    rawQuery :: ByteString -> Handler NoContent
    rawQuery rQuery = do
      case rQuery == "?test_value=foobar" of
        True -> pure NoContent
        False -> throwError err400 {errBody = "Invalid query flag passed."}

rawQueryStrProps :: Int -> TestTree
rawQueryStrProps port =
  testGroup
    "RawQueryString"
    [ QC.testProperty "Raw query endpoint recognizes the correct string" $
        monadicIO $ do
          result <- (fetchEndpoint port "?test_value=foobar") >>= success
          assert $ result == True
    , QC.testProperty "Raw query endpoint rejects incorrect string" $
        monadicIO $ do
          result <- (fetchEndpoint port "?invalid") >>= returns400
          assert $ result == True
    ]
  where
    fetchEndpoint :: Int -> String -> PropertyM IO (S.Response ByteString)
    fetchEndpoint port' value = do
      let initReq =
            S.parseRequest_ $
              "http://localhost:"
                <> (show port')
                <> "/check-raw-query"
                <> value
          req = initReq {method = "GET"}
       in do
            resp <- S.httpBS req
            pure resp