Servant に Experimental モジュールとして追加された認証の仕組み

はじめに

久しぶりに Haskell に戻って Servant を触ってみたら,いつの間にか認証周りの仕組みが実験的に追加されていました. 興味がわいたため,Authentication in Servant とコードを読みながら少しだけ仕組みをのぞいてみました.

バージョン情報

lts-7.14 です.バージョンは以下の通りです.

  • GHC 8.0.1
  • servant 0.8.1

サンプルコード

実際に動くコードを用意しました.

Recap の方にまとまっていますが,認証無しの場合と異なる箇所をザックリ挙げると以下の通りです.

  • 認証をかけたいエンドポイントに AuthProtect コンビネーターを指定する
    • AuthProtect "hoge" :> ProtectedAPI とした場合,ProtectedAPI が認証処理で保護される
  • AuthProtect tag と対応した type family AuthServerData の型インスタンスを宣言する
    • 認証ハンドラが返す値の具体的な型を HasServer api context インスタンスに指定する役割
  • serve の代わりに serveWithContext を使用する
    • ここで HasServer api contextcontext を指定
  • Context には実際の認証処理を担う AuthHandler を積む
    • AuthHandler は認証処理関数 (r -> Handler usr) をラップしたもの

少しだけ仕組みを覗いてみる

AuthProtect コンビネーターを指定すると以下のルーティングが有効になります.

-- 引用: https://hackage.haskell.org/package/servant-server-0.8.1/docs/src/Servant.Server.Experimental.Auth.html#line-54
instance ( HasServer api context
         , HasContextEntry context (AuthHandler Request (AuthServerData (AuthProtect tag)))
         )
  => HasServer (AuthProtect tag :> api) context where

  type ServerT (AuthProtect tag :> api) m =
    AuthServerData (AuthProtect tag) -> ServerT api m

  route Proxy context subserver =
    route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)
      where
        authHandler :: Request -> Handler (AuthServerData (AuthProtect tag))
        authHandler = unAuthHandler (getContextEntry context)
        authCheck :: Request -> DelayedIO (AuthServerData (AuthProtect tag))
        authCheck = (>>= either delayedFailFatal return) . liftIO . runExceptT . authHandler

-- 以下はコードを読むための補足:
-- type Server api = ServerT api Handler
-- type Handler = ExceptT ServantErr IO

HasContextEntry により,HasServer api contextcontext からは getContextEntry を使って AuthHandler Request (AuthServerData (AuthProtect tag)) を取得することが出来ます (ということが型制約から要求されます). contextserverWithContext で指定した型で,先のサンプルコードでは AuthHandler を積んだ型レベルのリストです.

AuthServerData (AuthProtect tag) の部分には (先のサンプルコード中にある) type family のインスタンス宣言によって Account が対応します.

また関連型により以下のような対応付けがなされるため,

  type ServerT (AuthProtect tag :> api) m =
    AuthServerData (AuthProtect tag) -> ServerT api m

subserverDelayed env (Account -> ServerT api Handler a) という型を持つことになります (Delayed については後述). これにより,対応するハンドラは Account を引数として受けることが要求されます.

後は取り出した authHandler を実行してその結果を subserver に渡すだけですが,すぐには実行されず一旦 Delayed の形で積まれて後続の処理へと渡されます*1

-- 引用: https://hackage.haskell.org/package/servant-server-0.8.1/docs/src/Servant.Server.Internal.RoutingApplication.html#addAuthCheck
addAuthCheck :: Delayed env (a -> b)
             -> DelayedIO a
             -> Delayed env b
addAuthCheck Delayed{..} new =
  Delayed
    { authD   = (,) <$> authD <*> new
    , serverD = \ c (y, v) b req -> ($ v) <$> serverD c y b req
    , ..
    } -- Note [Existential Record Update]

Delayed はエラーハンドリングの順序を決定するための仕組みだそうです.以下のような順序で実行され,すべてパスした場合に実際のハンドラが呼び出されます.

-- 引用: https://hackage.haskell.org/package/servant-server-0.8.1/docs/src/Servant.Server.Internal.RoutingApplication.html#runDelayed
runDelayed :: Delayed env a
           -> env
           -> Request
           -> IO (RouteResult a)
runDelayed Delayed{..} env = runDelayedIO $ do
  c <- capturesD env
  methodD
  a <- authD
  b <- bodyD
  DelayedIO (\ req -> return $ serverD c a b req)

runDelayedrunAction から呼び出されます.

-- 引用: https://hackage.haskell.org/package/servant-server-0.8.1/docs/src/Servant.Server.Internal.RoutingApplication.html#runAction
runAction :: Delayed env (Handler a)
          -> env
          -> Request
          -> (RouteResult Response -> IO r)
          -> (a -> RouteResult Response)
          -> IO r
runAction action env req respond k =
  runDelayed action env req >>= go >>= respond
  where
    go (Fail e)      = return $ Fail e
    go (FailFatal e) = return $ FailFatal e
    go (Route a)     = do
      e <- runExceptT a     -- Handler a の結果を取り出している
      case e of
        Left err -> return . Route $ responseServantErr err
        Right x  -> return $! k x

runAction... :> Get '[JSON] Text のような末端を処理する route 関数から呼び出されます.これで無事レスポンスが生成されました.

servant-auth (servant-auth-server) という別の選択肢

AuthProtect を使わずに認証周りを実装したパッケージとして servant-auth があります.

Auth (auths :: [*]) val というコンビネーターが用意されており,auths に複数の認証方式を指定できるようになっています.

このパッケージでは JWTCookie が提供されています. どちらも暗号化したデータを Token や Set-Cookie に用いる実装のようです.

おわりに

AuthProtect の仕組みによって認証を型として指定できるようになりました. セッション ID とユーザーの紐付けや,API トークンベースの認証が実装しやすくなりました.

Context のあたりは他にも WithNamedContext といった仕組みがあるようです.

しかし巧妙な方法ですね.自分ではとても思いつけそうにありません.

*1:ここら辺も結構変更されていますね