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

はじめに

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

バージョン情報

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

• GHC 8.0.1
• servant 0.8.1

サンプルコード

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

• examples/try-haskell-servant-auth

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

• 認証をかけたいエンドポイントに AuthProtect コンビネーターを指定する
  • AuthProtect "hoge" :> ProtectedAPI とした場合，ProtectedAPI が認証処理で保護される
• AuthProtect tag と対応した type family AuthServerData の型インスタンスを宣言する
  • 認証ハンドラが返す値の具体的な型を HasServer api context インスタンスに指定する役割
• serve の代わりに serveWithContext を使用する
  • ここで HasServer api context の context を指定
• 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 context の context からは getContextEntry を使って AuthHandler Request (AuthServerData (AuthProtect tag)) を取得することが出来ます (ということが型制約から要求されます)． context は serverWithContext で指定した型で，先のサンプルコードでは AuthHandler を積んだ型レベルのリストです．

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

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

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

subserver は Delayed 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)

runDelayed は runAction から呼び出されます．

-- 引用: 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 に複数の認証方式を指定できるようになっています．

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

おわりに

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

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

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

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