servant-effectful-1.0.0: test/Main.hs

module Main where

import Data.ByteString.Lazy (LazyByteString)
import Data.Kind (Type)
import Effectful
import Effectful.Hspec
import Effectful.HttpClient hiding (Proxy)
import Effectful.Servant
import Effectful.Servant.Server.Generic (AsServer)
import Effectful.Wai (Application)
import Effectful.Wai.Handler.Warp (Port, withApplication)
import GHC.Generics (Generic)
import Network.HTTP.Types qualified as HTTP
import Prelude

type API = NamedRoutes NamedAPI

data NamedAPI (mode :: Type) = NamedAPI
    { hello :: mode :- Get '[PlainText] String
    , helloNamed :: mode :- Capture "name" String :/ Get '[PlainText] String
    }
    deriving stock (Generic)

server :: NamedAPI (AsServer es)
server = NamedAPI{..}
  where
    hello :: Handler es String
    hello = pure "Hello!"

    helloNamed :: String -> Handler es String
    helloNamed "teapot" = throwError err418
    helloNamed name = pure $ "Hello, " <> name <> "!"

app :: (IOE :> es) => Application es
app = serve @API Proxy server

get :: (HttpClient :> es) => String -> Port -> Eff es (Response LazyByteString)
get path port = do
    req <- parseRequest $ "http://127.0.0.1:" <> show port <> path
    httpLbs req{requestHeaders = [("Connection", "close")]}

main :: IO ()
main = runEff . runHttpClient . runHspec . describe "Servant" $ do
    it "says hello" do
        resp <- withApplication (pure app) (get "/")
        responseBody resp `shouldBe` "Hello!"

    it "says hello to Ueli" do
        resp <- withApplication (pure app) (get "/Ueli")
        responseBody resp `shouldBe` "Hello, Ueli!"

    it "is a teapot" do
        resp <- withApplication (pure app) (get "/teapot")
        responseStatus resp `shouldBe` HTTP.status418