第 17 章 - 使用 Servant 构建 API（APIs using Servant）

本章内容包括：

• 用类型描述 HTTP API
• 通过 Servant 从 API 类型生成服务器
• 理解幻影类型如何把额外信息放进类型层
• 使用 WAI 运行 Web 应用
• 从同一份 API 描述生成客户端

本书一路走来，我们已经构建过命令行程序、解析器、图像处理工具、同步工具和数据库访问层。现在来到最后一个应用场景：Web API。

许多程序最终都需要通过网络提供能力。一个同步工具可能需要远程触发任务，一个数据处理程序可能需要暴露查询接口，一个服务可能需要给浏览器或其他进程返回 JSON。HTTP API 是这类交互中最常见的形式。

在 Haskell 中，Servant 提供了一种独特的 API 构建方式：先用类型描述 API，然后从这个类型派生服务器、客户端、文档和链接。也就是说，API 的形状不是散落在路由字符串和处理函数中，而是集中在一个类型里。这和本书一直强调的思路一致：把重要约束放进类型系统，让编译器帮助我们维护一致性。

17.1 定义类型安全 API（Defining a typesafe API）

先从一个简单目标开始：为上一章的同步任务提供 HTTP 接口。我们希望支持：

• GET /jobs 列出所有任务
• POST /jobs 创建一个新任务
• GET /jobs/:id 查询一个任务
• DELETE /jobs/:id 删除一个任务

传统 Web 框架通常会把这些路由写成字符串，然后把处理函数注册到路由表。Servant 的做法不同：路由本身就是类型。

17.1.1 使用 Servant 的类型化 API（Typed APIs with Servant）

Servant API 类型由一组类型组合子构成。先看一个最小接口：

代码清单 17.1 一个简单的 Servant API 类型

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Api where

import Servant

type API =
  "health" :> Get '[JSON] String

这个类型描述了一个端点：

GET /health

它返回 JSON，并且 JSON 内容对应 Haskell 的 String。

这里出现了几个新东西：

• "health" 表示路径片段
• :> 把路径、参数和方法组合起来
• Get '[JSON] String 表示 HTTP GET，响应格式是 JSON，结果类型是 String
• DataKinds 允许字符串和列表出现在类型层
• TypeOperators 允许在类型中使用 :> 这样的操作符

多个端点可以用 :<|> 组合：

代码清单 17.2 组合多个端点

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Api where

import Servant

type API =
  "health" :> Get '[JSON] String
    :<|> "version" :> Get '[JSON] String

:<|> 的形状和我们以前见过的和类型有点相似：它表示 API 的左右两个分支。

现在为同步任务定义领域类型：

代码清单 17.3 API 数据类型

{-# LANGUAGE DeriveGeneric #-}

module Api.Types where

import Data.Aeson
import GHC.Generics

data Job = Job
  { jobId :: Int,
    jobSource :: FilePath,
    jobTarget :: FilePath,
    jobDryRun :: Bool
  }
  deriving (Eq, Generic, Show)

instance ToJSON Job
instance FromJSON Job

data NewJob = NewJob
  { newJobSource :: FilePath,
    newJobTarget :: FilePath,
    newJobDryRun :: Bool
  }
  deriving (Eq, Generic, Show)

instance ToJSON NewJob
instance FromJSON NewJob

有了这些类型，就可以描述任务 API：

代码清单 17.4 同步任务 API 类型

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Api where

import Api.Types
import Servant

type JobsAPI =
  "jobs" :> Get '[JSON] [Job]
    :<|> "jobs" :> ReqBody '[JSON] NewJob :> Post '[JSON] Job
    :<|> "jobs" :> Capture "id" Int :> Get '[JSON] Job
    :<|> "jobs" :> Capture "id" Int :> DeleteNoContent

逐个读这个类型：

"jobs" :> Get '[JSON] [Job]

表示 GET /jobs，返回 JSON 数组。

"jobs" :> ReqBody '[JSON] NewJob :> Post '[JSON] Job

表示 POST /jobs，请求体是 JSON 格式的 NewJob，响应是创建后的 Job。

"jobs" :> Capture "id" Int :> Get '[JSON] Job

表示 GET /jobs/:id，路径中的 id 会被解析成 Int。

"jobs" :> Capture "id" Int :> DeleteNoContent

表示 DELETE /jobs/:id，删除成功时没有响应体。

API 类型现在就是一份可由编译器检查的契约。如果服务器处理函数和这份契约不匹配，代码不会通过编译。

17.1.2 幻影类型（Phantom types）

Servant 大量使用类型层信息。路径片段、内容类型、状态码和参数名都出现在类型里。理解这一点之前，先看一个更小的概念：幻影类型。

幻影类型是指出现在类型参数中，但不出现在值构造器字段中的类型。

代码清单 17.5 幻影类型示例

module Phantom where

data Draft
data Published

newtype Article state = Article
  { articleText :: String
  }

Article state 中的 state 没有出现在 Article 构造器字段里。也就是说，运行时的 Article Draft 和 Article Published 表示完全相同，但编译期类型不同。

这可以用来表达状态转换：

代码清单 17.6 用幻影类型表达状态

module Phantom where

data Draft
data Published

newtype Article state = Article
  { articleText :: String
  }

newDraft :: String -> Article Draft
newDraft =
  Article

publish :: Article Draft -> Article Published
publish (Article text) =
  Article text

renderPublished :: Article Published -> String
renderPublished =
  articleText

现在 renderPublished 不能接收草稿文章。编译器会阻止我们在发布前渲染它。

Servant 的 API 类型也类似。许多信息并不会成为运行时值，但它们存在于类型层，驱动服务器和客户端生成。例如 Capture "id" Int 中的 "id" 主要用于类型和文档层面；真正运行时需要的是解析出的 Int。

类型层信息的好处是：它让 API 结构、处理函数和客户端之间形成静态关系。修改 API 类型之后，编译器会指出所有不一致的位置。

17.1.3 实现 API（Implementing the API）

API 类型只是契约。接下来要实现服务器处理函数。Servant 使用 Server API 类型描述对应的处理器。

先从健康检查开始：

代码清单 17.7 实现简单服务器

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Server where

import Api
import Servant

server :: Server API
server =
  pure "ok"

如果 API 有多个分支，服务器也用 :<|> 组合：

代码清单 17.8 实现多个端点

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Server where

import Servant

type API =
  "health" :> Get '[JSON] String
    :<|> "version" :> Get '[JSON] String

server :: Server API
server =
  pure "ok"
    :<|> pure "1.0.0"

同步任务 API 的处理函数更有意思。为了让示例专注于 Servant，先用内存列表表示存储。

代码清单 17.9 内存任务存储

module Store where

import Api.Types
import Data.IORef

newtype Store = Store
  { storeJobs :: IORef [Job]
  }

newStore :: IO Store
newStore =
  Store <$> newIORef []

现在实现对存储的操作：

代码清单 17.10 操作任务存储

module Store where

import Api.Types
import Data.IORef
import Data.List

newtype Store = Store
  { storeJobs :: IORef [Job]
  }

newStore :: IO Store
newStore =
  Store <$> newIORef []

listJobs :: Store -> IO [Job]
listJobs store =
  readIORef (storeJobs store)

insertJob :: Store -> NewJob -> IO Job
insertJob store newJob =
  atomicModifyIORef' (storeJobs store) $ \jobs ->
    let nextId =
          case jobs of
            [] -> 1
            _ -> maximum (map jobId jobs) + 1
        job =
          Job
            { jobId = nextId,
              jobSource = newJobSource newJob,
              jobTarget = newJobTarget newJob,
              jobDryRun = newJobDryRun newJob
            }
     in (jobs <> [job], job)

findJob :: Store -> Int -> IO (Maybe Job)
findJob store idValue =
  find ((== idValue) . jobId) <$> readIORef (storeJobs store)

deleteJob :: Store -> Int -> IO Bool
deleteJob store idValue =
  atomicModifyIORef' (storeJobs store) $ \jobs ->
    let remaining = filter ((/= idValue) . jobId) jobs
        deleted = length remaining /= length jobs
     in (remaining, deleted)

真实服务通常会使用数据库而不是 IORef。这里使用 IORef 是为了让 Servant 相关结构更清楚。

接着实现 JobsAPI：

代码清单 17.11 实现同步任务 API

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Server where

import Api
import Api.Types
import qualified Store
import Servant

jobsServer :: Store.Store -> Server JobsAPI
jobsServer store =
  listHandler
    :<|> createHandler
    :<|> getHandler
    :<|> deleteHandler
  where
    listHandler =
      liftIO (Store.listJobs store)

    createHandler newJob =
      liftIO (Store.insertJob store newJob)

    getHandler idValue = do
      result <- liftIO (Store.findJob store idValue)
      case result of
        Just job -> pure job
        Nothing -> throwError err404

    deleteHandler idValue = do
      deleted <- liftIO (Store.deleteJob store idValue)
      if deleted
        then pure NoContent
        else throwError err404

Handler 是 Servant 默认使用的处理 monad。它支持 IO，也支持通过 throwError 返回 HTTP 错误。err404 表示 404 Not Found。

注意处理函数的参数来自 API 类型。例如：

"jobs" :> Capture "id" Int :> Get '[JSON] Job

对应的处理函数会接收一个 Int 参数：

getHandler idValue = ...

而：

ReqBody '[JSON] NewJob :> Post '[JSON] Job

对应的处理函数会接收一个 NewJob 参数：

createHandler newJob = ...

这是 Servant 最漂亮的地方之一：路径参数、查询参数、请求体和响应类型都会被 API 类型同步到处理函数类型中。

17.2 运行应用程序（Running the application）

服务器处理函数还不是可运行的 Web 应用。Servant 需要把 API 类型和服务器实现组合成 WAI 应用，然后交给 Warp 运行。

17.2.1 WAI 应用程序（The WAI application）

WAI 是 Web Application Interface 的缩写。它是 Haskell Web 生态中的一个通用接口。很多框架可以生成 WAI Application，很多服务器也可以运行 WAI Application。

Servant 提供 serve 函数：

serve :: HasServer api context => Proxy api -> Server api -> Application

由于 API 只存在于类型层，运行时需要一个 Proxy 把类型传给 serve。

代码清单 17.12 创建 WAI 应用

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module App where

import Api
import Data.Proxy
import Network.Wai
import Server
import qualified Store
import Servant

api :: Proxy JobsAPI
api =
  Proxy

mkApp :: Store.Store -> Application
mkApp store =
  serve api (jobsServer store)

Proxy 没有携带有趣的运行时数据。它只是一个把类型带到值层的小工具。

接着使用 Warp 运行：

代码清单 17.13 运行 Servant 服务

module Main (main) where

import App
import Network.Wai.Handler.Warp
import qualified Store

main :: IO ()
main = do
  store <- Store.newStore
  run 8080 (mkApp store)

启动后，可以访问：

GET http://localhost:8080/jobs
POST http://localhost:8080/jobs
GET http://localhost:8080/jobs/1
DELETE http://localhost:8080/jobs/1

创建任务时，请求体可以类似：

{
  "newJobSource": "src",
  "newJobTarget": "dst",
  "newJobDryRun": false
}

如果希望 JSON 字段名更友好，可以沿用上一章介绍的 Aeson Options，把 newJobSource 转换为 source。

17.2.2 应用中间件（Application middleware）

WAI 应用可以用中间件包装。中间件是接收一个 Application 并返回一个新 Application 的函数：

type Middleware = Application -> Application

常见中间件包括日志、压缩、CORS、静态文件服务和认证。

例如，给应用添加请求日志：

代码清单 17.14 添加请求日志中间件

module Main (main) where

import App
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger
import qualified Store

main :: IO ()
main = do
  store <- Store.newStore
  run 8080 (logStdoutDev (mkApp store))

logStdoutDev 会把请求信息打印到标准输出。开发时这很方便。生产环境通常会使用更结构化的日志方案。

中间件可以组合：

appWithMiddleware =
  middlewareA (middlewareB app)

或者用函数组合写：

appWithMiddleware =
  middlewareA . middlewareB $ app

这种设计让横切能力与业务处理函数分离。API 处理器只关注业务逻辑，中间件负责请求层面的通用行为。

17.2.3 从数据生成 HTML（Producing HTML from data）

虽然 Servant 经常用于 JSON API，但它也可以返回 HTML。为此需要使用 HTML 内容类型和 HTML 构造库。常见选择是 Lucid。

先定义一个返回 HTML 的端点：

代码清单 17.15 HTML 端点类型

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module WebApi where

import Lucid
import Servant

type WebAPI =
  "jobs.html" :> Get '[HTML] (Html ())

Lucid 使用普通 Haskell 函数构造 HTML：

代码清单 17.16 使用 Lucid 构造 HTML

module WebPage where

import Api.Types
import Lucid

jobsPage :: [Job] -> Html ()
jobsPage jobs =
  html_ $ do
    head_ $
      title_ "Jobs"
    body_ $ do
      h1_ "Jobs"
      ul_ $
        mapM_ renderJob jobs

renderJob :: Job -> Html ()
renderJob job =
  li_ $
    toHtml $
      show (jobId job) <> ": "
        <> jobSource job
        <> " -> "
        <> jobTarget job

然后实现处理器：

代码清单 17.17 返回 HTML 页面

module WebServer where

import qualified Store
import Servant
import WebApi
import WebPage

webServer :: Store.Store -> Server WebAPI
webServer store = do
  jobs <- liftIO (Store.listJobs store)
  pure (jobsPage jobs)

JSON API 和 HTML 页面也可以组合在同一个应用里：

代码清单 17.18 组合 JSON API 和 HTML 页面

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Api where

import Servant
import WebApi

type FullAPI =
  JobsAPI :<|> WebAPI

服务器也用同样形状组合：

fullServer store =
  jobsServer store :<|> webServer store

这说明 Servant 不只是一个 JSON 路由库。它的核心是类型层 API 描述；具体返回 JSON、HTML 或其他格式，只是内容类型的选择。

17.3 客户端生成（Deriving a client）

Servant 的另一个强大能力是从同一份 API 类型生成客户端。这样服务器和客户端共享一份契约，减少手写请求路径和参数导致的不一致。

17.3.1 使用 servant-client

servant-client 提供 client 函数。给定 API 类型，它会生成对应的客户端函数。

代码清单 17.19 从 API 类型生成客户端

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Client where

import Api
import Api.Types
import Data.Proxy
import Servant
import Servant.Client

api :: Proxy JobsAPI
api =
  Proxy

listJobsClient ::
  ClientM [Job]
createJobClient ::
  NewJob -> ClientM Job
getJobClient ::
  Int -> ClientM Job
deleteJobClient ::
  Int -> ClientM NoContent

listJobsClient
  :<|> createJobClient
  :<|> getJobClient
  :<|> deleteJobClient =
    client api

生成出的函数形状和 API 完全对应：

• GET /jobs 不需要参数，返回 [Job]
• POST /jobs 需要 NewJob，返回 Job
• GET /jobs/:id 需要 Int，返回 Job
• DELETE /jobs/:id 需要 Int，返回 NoContent

要运行 ClientM，需要 HTTP 管理器和基础 URL：

代码清单 17.20 运行客户端请求

module Main (main) where

import Client
import Network.HTTP.Client
import Servant.Client

main :: IO ()
main = do
  manager <- newManager defaultManagerSettings
  let baseUrl = BaseUrl Http "localhost" 8080 ""
      env = mkClientEnv manager baseUrl
  result <- runClientM listJobsClient env
  case result of
    Left err -> print err
    Right jobs -> print jobs

runClientM 返回 Either ClientError a。网络请求可能失败，服务器可能返回错误状态码，响应 JSON 也可能解析失败。客户端代码必须处理这些情况。

17.3.2 为 CLI 定义命令（Defining commands for the CLI）

现在可以为 API 客户端添加命令行界面。假设希望支持：

jobs list
jobs create --source src --target dst
jobs get --id 1
jobs delete --id 1

先定义命令类型：

代码清单 17.21 CLI 命令类型

module Cli where

import Api.Types

data Command
  = ListJobs
  | CreateJob NewJob
  | GetJob Int
  | DeleteJob Int

使用 optparse-applicative 解析这些命令：

代码清单 17.22 解析客户端命令

module Cli where

import Api.Types
import Options.Applicative

data Command
  = ListJobs
  | CreateJob NewJob
  | GetJob Int
  | DeleteJob Int

commandParser :: Parser Command
commandParser =
  hsubparser
    ( command "list" (info (pure ListJobs) (progDesc "List jobs"))
        <> command "create" (info createParser (progDesc "Create a job"))
        <> command "get" (info getParser (progDesc "Get a job"))
        <> command "delete" (info deleteParser (progDesc "Delete a job"))
    )

createParser :: Parser Command
createParser =
  CreateJob
    <$> ( NewJob
            <$> strOption (long "source" <> metavar "DIR")
            <*> strOption (long "target" <> metavar "DIR")
            <*> switch (long "dry-run")
        )

getParser :: Parser Command
getParser =
  GetJob <$> option auto (long "id" <> metavar "ID")

deleteParser :: Parser Command
deleteParser =
  DeleteJob <$> option auto (long "id" <> metavar "ID")

hsubparser 用于定义子命令。每个子命令都有自己的解析器和说明。

17.3.3 实现客户端（Implementing the client）

最后把命令映射到客户端请求。

代码清单 17.23 执行客户端命令

module Cli.Run where

import Cli
import Client
import Servant.Client

runCommand :: Command -> ClientM String
runCommand command =
  case command of
    ListJobs -> do
      jobs <- listJobsClient
      pure (show jobs)
    CreateJob newJob -> do
      job <- createJobClient newJob
      pure ("created " <> show job)
    GetJob idValue -> do
      job <- getJobClient idValue
      pure (show job)
    DeleteJob idValue -> do
      _ <- deleteJobClient idValue
      pure "deleted"

然后实现 main：

代码清单 17.24 客户端程序入口

module Main (main) where

import Cli
import Cli.Run
import Network.HTTP.Client
import Options.Applicative
import Servant.Client

parseCommand :: IO Command
parseCommand =
  execParser $
    info
      (commandParser <**> helper)
      (fullDesc <> progDesc "Manage sync jobs")

main :: IO ()
main = do
  command <- parseCommand
  manager <- newManager defaultManagerSettings
  let baseUrl = BaseUrl Http "localhost" 8080 ""
      env = mkClientEnv manager baseUrl
  result <- runClientM (runCommand command) env
  case result of
    Left err -> print err
    Right output -> putStrLn output

现在服务器和客户端共享同一个 JobsAPI 类型。修改 API 时，服务器实现和客户端函数都会受到编译器检查。这并不能消除所有运行时错误，但能消除大量无聊又常见的错误：路径写错、参数类型不匹配、响应类型和解析器不一致。

这也是本书最后一个实用例子。我们从普通函数、列表和 IO 开始，一路走到解析器、图像处理、并行、异常、转换器、JSON、SQL 和类型安全 Web API。每一步背后的主题都是一样的：用类型表达结构，用纯函数组织核心逻辑，把副作用放在清晰边界上。

总结

• Servant 使用类型描述 HTTP API，而不是把路由只写成运行时字符串。
• :> 用于组合路径、参数、请求体和方法；:<|> 用于组合多个端点。
• DataKinds 让字符串、列表等信息可以提升到类型层。
• 幻影类型可以在不改变运行时表示的情况下，把额外状态放进类型里。
• Server API 会根据 API 类型生成对应的处理函数形状。
• Handler 支持执行 IO，也能用 throwError 返回 HTTP 错误。
• serve 把 API 类型和服务器实现转换为 WAI Application。
• WAI 中间件可以为应用添加日志、CORS、认证等横切能力。
• Servant 不只支持 JSON，也可以返回 HTML 等其他内容类型。
• servant-client 可以从同一份 API 类型生成客户端函数，让服务器和客户端共享契约。