wai/warp でBasic認証をかけてみる

Hello World!と表示するだけのとても簡単なWebアプリを書いてみます。

{-# LANGUAGE OverloadedStrings #-}

import Network.HTTP.Types
import Network.Wai
import qualified Network.Wai.Handler.Warp as Warp

app :: Application
app req res = res $ responseLBS status200 [] "Hello World!"

main :: IO ()
main = do
  putStrLn "Listening at http://localhost:3000/"
  Warp.run 3000 app

これにサクッとBasic認証をつけてみます。

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network.HTTP.Types
import Network.Wai
import qualified Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.HttpAuth

app :: Application
app req res = res $ responseLBS status200 [] "Hello World!"

authorize :: Middleware
authorize = basicAuth (\u p -> pure $ u == "lotz84" && p == "haskell") "Basic Auth Example"

main :: IO ()
main = do
  putStrLn "Listening at http://localhost:3000/"
  Warp.run 3000 $ authorize app

使ったのは wai-extra の Network.Wai.Middleware.HttpAuth の basicAuth という関数です。