求servant-server、wai、warp的Cookie最小示例及简便操作方法

Hey there! Let's walk through a complete minimal example that sets and reads a language=en cookie using the mentioned libraries, then address your question about simpler cookie handling similar to happstack-lite.

1. Full Minimal Example Code #

First, make sure your Cabal file includes these dependencies:

build-depends:
  base >= 4.14 && < 5,
  servant-server >= 0.19,
  wai >= 3.2,
  warp >= 3.3,
  servant >= 0.19,
  http-types >= 0.12,
  web-cookie >= 0.4,
  text >= 1.2

Here's the complete Haskell code:

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

import Servant.API
import Servant.Server
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types.Header (hSetCookie)
import Network.Wai (Request, responseLBS, requestHeaders)
import Network.HTTP.Types.Status (ok200)
import Web.Cookie (SetCookie(..), defaultSetCookie, renderSetCookie, parseCookiesText)
import Data.Text (Text, pack, unpack)
import Data.Maybe (listToMaybe)
import qualified Data.Text as T

-- Define our API: two endpoints
type CookieAPI =
  "set-cookie" :> Get '[PlainText] Text
  :<|> "get-language" :> Get '[PlainText] Text

-- Server implementation
cookieServer :: Server CookieAPI
cookieServer = setCookieHandler :<|> getLanguageHandler
  where
    -- Handler to set the `language=en` cookie
    setCookieHandler :: Handler Text
    setCookieHandler = do
      -- Create the cookie with name "language" and value "en"
      let langCookie = defaultSetCookie
            { setCookieName = pack "language"
            , setCookieValue = pack "en"
            , setCookiePath = Just (pack "/") -- Make cookie available site-wide
            }
          -- Convert SetCookie to a header value
          cookieHeader = (hSetCookie, renderSetCookie langCookie)
          -- Build response with the cookie header
          resp = responseLBS ok200 [cookieHeader] (pack "Cookie 'language=en' set!")
      -- Return the response from the handler
      return (pack $ unpack $ responseBody resp)

    -- Handler to read the `language` cookie
    getLanguageHandler :: Handler Text
    getLanguageHandler = do
      req <- askRequest
      let -- Extract the Cookie header from the request
          mCookieHeader = listToMaybe $ lookup "Cookie" $ requestHeaders req
          -- Parse cookies into a key-value map if header exists
          mLangValue = mCookieHeader >>= \hdr ->
            lookup (pack "language") (parseCookiesText hdr)
      case mLangValue of
        Just lang -> return $ pack "Language cookie value: " <> lang
        Nothing -> return $ pack "No language cookie found!"

-- Run the server
main :: IO ()
main = run 8080 (serve (Proxy :: Proxy CookieAPI) cookieServer)

How It Works #

• Setting the Cookie: We use defaultSetCookie as a base, override the setCookieName and setCookieValue fields, then convert it to a Set-Cookie header using renderSetCookie. This header is added to the response.
• Reading the Cookie: We extract the Cookie header from the incoming request, parse it into a text-based key-value map with parseCookiesText, then look up the language key.

2. Simpler Cookie Handling (Like happstack-lite's addCookies and lookCookieValue) #

Servant doesn't include these exact convenience functions out of the box, but it's trivial to wrap the underlying web-cookie and wai utilities to match happstack-lite's style. Here's how:

Encapsulate the Helpers #

Add these helper functions to your code:

import Network.Wai (Response, mapResponseHeaders)

-- Similar to happstack-lite's `addCookies` (simplified for single cookie)
addCookie :: SetCookie -> Response -> Response
addCookie sc = mapResponseHeaders ((hSetCookie, renderSetCookie sc) :)

-- Exactly like happstack-lite's `lookCookieValue`
lookCookieValue :: Text -> Request -> Maybe Text
lookCookieValue name req = do
  cookieHeader <- listToMaybe $ lookup "Cookie" $ requestHeaders req
  lookup name (parseCookiesText cookieHeader)

Using the Helpers #

Now you can rewrite the handlers to be much cleaner:

-- Updated setCookieHandler with addCookie
setCookieHandler :: Handler Text
setCookieHandler = do
  let langCookie = defaultSetCookie
        { setCookieName = pack "language"
        , setCookieValue = pack "en"
        , setCookiePath = Just (pack "/")
        }
      baseResp = responseLBS ok200 [] (pack "Cookie 'language=en' set!")
      respWithCookie = addCookie langCookie baseResp
  return (pack $ unpack $ responseBody respWithCookie)

-- Updated getLanguageHandler with lookCookieValue
getLanguageHandler :: Handler Text
getLanguageHandler = do
  req <- askRequest
  case lookCookieValue (pack "language") req of
    Just lang -> return $ pack "Language cookie value: " <> lang
    Nothing -> return $ pack "No language cookie found!"

This gives you the same concise, readable cookie handling that you're used to in happstack-lite. If you need to handle multiple cookies at once, you can extend addCookie to take a list of SetCookie and map over them to add all headers.

内容的提问来源于stack exchange，提问作者RamiroPastor