用 Haskell 通过 Rovela API 发送邮件

本文介绍如何用 Haskell 调用 Rovela API 发送事务邮件，涵盖 http-conduit、req 库、幂等键重试、mapConcurrently 并发批量发送，以及 Scotty 框架用 cryptonite 实现常量时间 HMAC Webhook 验签。

前提条件

将 API 密钥设置为环境变量：

export ROVELA_API_KEY="re_..."

在 package.yaml 中添加依赖：

dependencies:
  - http-conduit >= 2.3
  - aeson >= 2.0
  - bytestring
  - text

用 http-conduit 发送

{-# LANGUAGE OverloadedStrings #-}

module Rovela where

import           Data.Aeson              (encode, object, (.=))
import qualified Data.ByteString.Char8   as BS
import           Data.Text               (Text)
import           Network.HTTP.Conduit
import           Network.HTTP.Types      (statusIsSuccessful)
import           System.Environment      (getEnv)

sendEmail :: Text -> Text -> Text -> IO ()
sendEmail to subject html = do
  apiKey  <- getEnv "ROVELA_API_KEY"
  manager <- newTlsManager

  let payload = object
        [ "from"    .= ("Acme <noreply@yourdomain.com>" :: Text)
        , "to"      .= to
        , "subject" .= subject
        , "html"    .= html
        ]

  initReq <- parseRequest "https://api.rovela.dev/emails"
  let req = initReq
        { method         = "POST"
        , requestBody    = RequestBodyLBS (encode payload)
        , requestHeaders =
            [ ("Authorization", "Bearer " <> BS.pack apiKey)
            , ("Content-Type",  "application/json")
            ]
        }

  resp <- httpLbs req manager
  if statusIsSuccessful (responseStatus resp)
    then return ()
    else ioError (userError ("HTTP 错误: " <> show (responseStatus resp)))

用 req 发送

req 提供更符合人体工程学的接口和类型安全的 URL 构建：

dependencies:
  - req >= 3.13

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds         #-}

module Rovela.Req where

import           Data.Aeson    (object, (.=))
import           Data.Text     (Text)
import qualified Data.Text     as T
import           Network.HTTP.Req
import           System.Environment (getEnv)

sendEmail :: Text -> Text -> Text -> IO BsResponse
sendEmail to subject html = do
  apiKey <- getEnv "ROVELA_API_KEY"

  let payload = object
        [ "from"    .= ("Acme <noreply@yourdomain.com>" :: Text)
        , "to"      .= to
        , "subject" .= subject
        , "html"    .= html
        ]

  runReq defaultHttpConfig $
    req POST
      (https "api.rovela.dev" /: "emails")
      (ReqBodyJson payload)
      bsResponse
      ( header "Authorization" ("Bearer " <> TE.encodeUtf8 (T.pack apiKey))
     <> header "Content-Type" "application/json"
      )

重试与幂等键

在循环之前生成一次幂等键，每次重试都复用同一个键，防止服务器接受请求后网络断开导致重复发送。只对 429 重试：

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE NumericUnderscores  #-}

module Rovela.Retry where

import           Control.Concurrent      (threadDelay)
import           Control.Exception       (throwIO)
import           Data.Aeson              (Value, encode)
import qualified Data.ByteString.Char8   as BS
import qualified Data.ByteString.Lazy    as LBS
import           Network.HTTP.Conduit
import           Network.HTTP.Types      (Status (statusCode))
import           System.Environment      (getEnv)
import           System.Random           (randomRIO)
import           Text.Printf             (printf)

randomHex :: Int -> IO String
randomHex n = do
  bytes <- mapM (\_ -> randomRIO (0, 255 :: Int)) [1..n]
  return $ concatMap (printf "%02x") bytes

sendWithRetry :: Value -> Int -> IO LBS.ByteString
sendWithRetry payload maxRetries = do
  apiKey         <- getEnv "ROVELA_API_KEY"
  idempotencyKey <- randomHex 16  -- 循环前生成，重试时复用
  manager        <- newTlsManager
  initReq        <- parseRequest "https://api.rovela.dev/emails"

  let baseReq = initReq
        { method      = "POST"
        , requestBody = RequestBodyLBS (encode payload)
        , requestHeaders =
            [ ("Authorization",   "Bearer " <> BS.pack apiKey)
            , ("Content-Type",    "application/json")
            , ("Idempotency-Key", BS.pack idempotencyKey)
            ]
        }

  let go attempt = do
        resp <- httpLbs baseReq manager
        let code = statusCode (responseStatus resp)
        case code of
          429 | attempt < maxRetries -> do
            threadDelay (2 ^ attempt * 1_000_000)
            go (attempt + 1)
          _ | code >= 200 && code < 300 -> return (responseBody resp)
          _ -> ioError (userError ("HTTP 错误: " <> show code))

  go 0

mapConcurrently 并发批量发送

mapConcurrently 并发执行列表中的所有操作，用 QSem 信号量限制最大并发数：

dependencies:
  - async >= 2.2

{-# LANGUAGE OverloadedStrings #-}

module Rovela.Batch where

import           Control.Concurrent        (newQSem, signalQSem, waitQSem)
import           Control.Concurrent.Async  (mapConcurrently)
import           Control.Exception         (bracket_)
import           Data.Text                 (Text)
import           Rovela                    (sendEmail)

data Recipient = Recipient
  { recipientEmail   :: Text
  , recipientSubject :: Text
  , recipientHtml    :: Text
  }

sendBatch :: [Recipient] -> Int -> IO [Either String String]
sendBatch recipients concurrency = do
  sem <- newQSem concurrency   -- 信号量控制并发上限

  mapConcurrently (withSem sem . sendOne) recipients
  where
    withSem sem action =
      bracket_ (waitQSem sem) (signalQSem sem) action

    sendOne r = do
      _ <- sendEmail (recipientEmail r) (recipientSubject r) (recipientHtml r)
      return (Right "sent" :: Either String String)

waitQSem 在计数器归零时阻塞，signalQSem 在任务完成后释放，确保最多 concurrency 个请求同时进行。

Scotty Webhook 验签

Rovela 用 HMAC-SHA256 对每个事件签名。签名在 x-resend-signature 请求头中，格式为 t=<时间戳>,v1=<十六进制签名>。对 <时间戳>.<原始 body> 用 Webhook 密钥计算 HMAC，再用 constEq 做常量时间比对防止时序攻击。

dependencies:
  - scotty >= 0.20
  - cryptonite >= 0.30
  - memory >= 0.18

{-# LANGUAGE OverloadedStrings #-}

module Rovela.Webhook where

import qualified Crypto.Hash.Algorithms  as Hash
import qualified Crypto.MAC.HMAC         as HMAC
import           Control.Monad.IO.Class  (liftIO)
import qualified Data.ByteArray          as BA
import           Data.ByteArray          (constEq)
import qualified Data.ByteArray.Encoding as BAE
import qualified Data.ByteString         as BS
import qualified Data.ByteString.Char8   as BSC
import qualified Data.ByteString.Lazy    as LBS
import qualified Data.Text.Encoding      as TE
import qualified Data.Text.Lazy          as TL
import           Network.HTTP.Types      (status400)
import           System.Environment      (getEnv)
import           Web.Scottyimport           Web.Scotty

parseSigHeader :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)
parseSigHeader hdr = do
  let parts = map (BSC.break (== '=')) (BSC.splitWith (== ',') hdr)
      toKV (k, v)
        | BS.null v = Nothing
        | otherwise = Just (k, BS.tail v)
      kvs = [kv | Just kv <- map toKV parts]
  t  <- lookup "t"  kvs
  v1 <- lookup "v1" kvs
  return (t, v1)

verifySignature :: BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString -> Bool
verifySignature secret timestamp rawBody v1Hex =
  case BAE.convertFromBase BAE.Base16 v1Hex of
    Left  _ -> False
    Right provided ->
      let signingInput = timestamp <> "." <> rawBody
          expected = HMAC.hmac secret signingInput :: HMAC.HMAC Hash.SHA256
      -- constEq 逐字节比对，不提前返回，防止时序攻击
      in constEq (BA.convert (HMAC.hmacGetDigest expected) :: BS.ByteString) provided

main :: IO ()
main = scotty 8080 $
  post "/webhooks/rovela" $ do
    secret    <- liftIO (getEnv "ROVELA_WEBHOOK_SECRET")
    rawBody   <- body
    sigHeader <- header "x-resend-signature"

    let sigBS = maybe "" (TE.encodeUtf8 . TL.toStrict) sigHeader

    case parseSigHeader sigBS of
      Nothing -> do
        status status400
        text "缺少签名字段"
      Just (ts, v1Hex) -> do
        if verifySignature (BSC.pack secret) ts (LBS.toStrict rawBody) v1Hex
          then do
            -- 解析 body 并处理事件类型
            text "ok"
          else do
            status status400
            text "签名无效"

constEq 来自 memory 包，逐字节比对且不短路，确保比对时间不因哪些字节匹配而泄露信息。