Keycloak を利用して OpenID Connect ライブラリ (haskell-oidc-client) の動作確認をする
はじめに
昨年末に以下の Issue が来ていたことに気付いて修正したのですが,リリース前に Keycloak を用いて haskell-oidc-client の動作確認をできないか試したところ,とても簡単に実施できました.
今回はその方法をまとめたものです.
方法
Keycloak は Docker イメージが公開されています. hub.docker.com
ですから pull して起動すれば,(テスト目的であれば) すぐに利用可能です.
docker pull jboss/keycloak docker run -d -p 8080:8080 -e KEYCLOAK_USER=admin -e KEYCLOAK_PASSWORD=test jboss/keycloak
docker logs -f
を眺めながら起動完了を待った後,localhost:8080
にアクセスするとリダイレクト後に以下の画面が表示されます.Administrator Console からログインします.
これより下で設定手順を説明しますが,あくまでも動作確認を目的とした簡易なものになっているため注意してください.
ログイン後,Clients から Create ボタンを押して Client ID/Secret を発行します.Add Client 画面で項目を埋めて Save し,
Settings タブから Access Type を credential に変更,かつ Valid Redirect URIs を Relying Party のコールバック URL に変更します. 変更を保存すると Credentials タブが出現して Secret を取得できるようになります.
次に Users からログイン用のユーザーを作成します.Email や各種 Name フィールドは設定しておいた方がテストの時に躓きません.パスワードは Save 後の Credentials タブから設定可能です.
またデフォルトでは profile
スコープに name
が含まれていません.Client Scopes から profile を選択し,Mappers タブから name を追加します.
以上で最低限の IdP として動作します.デフォルトの状態で Issuer Location は http://localhost:8080/auth/realms/master です.テストコードに設定して動作確認を開始しましょう.
おわりに
今回の実験でずいぶんと簡単に試せることが分かりました.Admin REST API があるみたいなので,ライブラリの API 仕様テストを自動化できないか試行錯誤したいと思います.
参考情報
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 familyAuthServerData
の型インスタンスを宣言する- 認証ハンドラが返す値の具体的な型を
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:ここら辺も結構変更されていますね
Haskell で書いた Web サービスにおける IO 部分の自動テスト
Haskell で書いた Web サービスの自動テストを考えたとき,IO の部分が問題になる場合があります. KVS や DBMS を利用する部分は CI サービス上で必要なものを起動すれば問題ないのですが,外部サービスと連携する部分は問題として残ります. またデグレするとユーザに直接影響を及ぼす部分については,IO であってもその動作を自動テスト化しておきたくなります.
こういった部分はモック化をサポートするライブラリを用いてテストすると思いますが*1,Haskell の場合はその辺どうするのだろうか?という疑問から調べて実験してみました.
なお,モック化のことを考えなければ既にある素晴らしいライブラリを利用してテストを書くことができます. この件についてはこちらの記事が大変参考になります.
先行事例
型クラスを利用したものと Free モナドを利用した事例がいくつかみつかります. 今回は型クラスによる分離を試みるため,その方針が紹介されていた記事を参考にさせてもらいました.
基本的な方針としては,IO が発生する操作を一般化した型クラスとして定義し,テストでは Reader
や State
モナドを用いてそれらを実装しています.
class Monad m => MonadXxx m where operation :: ... -> m a -- サービス instance MonadXxx IO where operation ... = ...(IO のコード)... -- テスト newtype MockXxx m a = MockXxx { unMock :: StateT MockState m a } deriving ... instance Monad m => MonadXxx (Mock m) where operation ... = ...(モック実装)... run :: Monad m => MockXxx m a -> ... -> m a run ... = ...
実験用 Web サービスのコード
実験用に小さな Web サービスを作成し,実際にモック化を試しました.Web サービスフレームワークには servant を使用しています.
この Web サービスで定義した API は以下の 3 つです.
POST /register
- ユーザ情報を新規作成し,登録完了メールを送信する
POST /login
- 最新のログイン時刻を更新し,ログイン成功メールを送信する
GET /users/:id
- ユーザ情報を取得する,キャッシュを使用する
今回は外部サービスとの連携部分をメール送信処理で代用しています.
IO 発生箇所の分離
基本方針は先行事例と同じですが,操作の内容に応じて分割定義しました. サービスはそれらをまとめる形で実装しています.
(※ この命名が慣習に従ったものなのかどうかは……自信がありません)
サービスとしての実装
まずは先の型クラスを IO
に対して実装します.
-- src/WS/Cache.hs instance MonadCache IO where get key = do ...(ここはいつも通り書く)...
またこれらをまとめた App m
を定義し,servant のハンドラにはこの制約を付けます.
-- src/WS/App.hs class (MonadCatch m, MonadMail m, MonadCache m, MonadDB m) => App m where ...(サービス固有の関数を定義したり)... register :: App m => RegForm -> m User -- こんな感じで型クラスを実装したら切り替えられるようにしておく ...
これで IO
に対する実装があれば上記の register
を servant のハンドラとして実行できるようになります.
テスト用のモックと型クラスの実装
MockApp m a
が今回のモックです.
テスト実行中の状態を保存したいため State
を使用しています.
また今回はテストに SQLite を使用するため部分的に IO
が発生します*2.
なので StateT
として IO
を lift
可能にしておきます.
-- test/Spec.hs newtype MockApp m a = MockApp { app :: StateT MockAppState m a } deriving (Functor, Applicative, Monad, MonadTrans, MonadThrow, MonadCatch)
あとはこのモックに対して型クラスを実装していきます.
このとき State
に持たせるデータを調整することで,戻り値を自由に変えるだけで無く呼び出し履歴の記録といったことも可能です.
-- test/Spec.hs instance (Functor m, MonadCatch m) => WS.MonadCache (MockApp m) where get k = do S.modify $ saveHistory "Cache.get" s <- S.get return $ decode' <$> Map.lookup k (cache s) ...
テストの実装
テストの記述には Hspec を使用しています.
テストコードのうち,モックを使用した部分は registerSpec
です*3.
実行するときは初期状態 initState
とテストしたい servant のハンドラを渡して以下のように実行します.
-- test/Spec.hs registerSpec :: Spec registerSpec = describe "POST /register" $ it "mock registration" $ do curr <- getPOSIXTime let form = WS.RegForm (pack $ "user-" ++ show curr) (pack $ "user-" ++ show curr ++ "@localhost") (res, state) <- runMock (WS.register form) initState -- モックで実行する WS.name res `shouldBe` WS.regName form emails state `shouldNotSatisfy` null (addressEmail . head . mailTo . head . emails $ state) `shouldBe` WS.regEmailAddress form history state `shouldBe` ["DB.insert", "DB.select", "Mail.sendMail"] -- 最後にメールを送信しているかチェック
サービスとしては IO
で実行される部分が,テストでは MockApp m
としてモック化した状態で実行されます.
おわりに
基本に従って実装すれば,IO をモック化した自動テストはうまくいきそうだなという感覚は得られました.
- IO が発生する箇所を限定する
- 実装の粒度とモック化のしやすさを考えながら分離面を決める
また Free
モナドを利用した方法もあるようですが,こちらの検討についてはまた今度.
おまけ: その他いろいろ
使用したフレームワークとライブラリ
servant のエラー処理
今回のようにハンドラ全体が IO になっている場合,その内部からエラーを投げたいときにどうすれば良いのか迷いました.
今回は throwM
で外までぶん投げてから catch
し,Either.left
し直しています.
transfomers
import
で Control.Monad.State
と Control.Monad.Trans.State
を間違えていることに気づかず,get
や put
の型が合わなくてしばらく悩んだりしました.
OpenID Connect 1.0 Relying Party を実装するための Haskell 用ライブラリ
タイトルの通り,OpenID Connect 1.0 のクライアントライブラリを作りました.Hackage に上げてありますので cabal install
で導入できます.
背景
Web サービスを作成するにあたって認証をどうするかは悩ましいところです.先々の展望を考慮して自前で実装することもありますが,小規模あるいは個人サービスであれば外部の認証サービスを利用することが選択肢に入るはずです.
あるサービスを実装するにあたり Google を OpenID Provider (以降 OP) として利用しようと考えたのですが,OpenID Connect 1.0 に対応したパッケージが見当たらなかった (2015 年 7 - 8 月ぐらいのことです) ため,今回のライブラリを作成しました.
現在サポートしているのは Code Flow のみです.
利用方法
手順としては以下の通りです.
discover
で OP の情報 (Provider
) を取得Provider
とクレデンシャルからOIDC
を作成- Authentication Request URL を作成 (してリダイレクト)
- OP からのコールバックを受けてトークンを要求,かつ受け取ったトークンを検証
- 検証済みトークンをサービスで利用する
実際に実行可能なコードが リポジトリ の examples にあります.
API の簡単な紹介
まずは discover
で OP の情報 (Provider
) を取得します.
discover :: IssuerLocation -> Manager -> IO Provider discover location manager = do ...
Web.OIDC.Discovery.Issuers
に具体的な Issuer Location の値を定義しています.Manager
は http-client パッケージのものです.Code Flow では TLS 必須ですから http-client-tls の設定を使って Manager
を生成する必要があります.
次に OIDC
を準備します.
newOIDC :: CPRG g => IORef g -> OIDC newOIDC ref = def { cprgRef = Ref ref }
CPRG
は crypto-random に定義されている暗号論的擬似乱数生成器の class です.暗号論的擬似乱数生成器はほぼ間違いなく使うでしょうから,引数にはそれを指定します.
指定された引数は ID Token Validation の際に id_token
(JWT) のデコード処理で使用します.デコード処理では jose-jwt を利用しています.
あとは setProvider
や setCredentials
を使用して,先に取得した Provider
や client ID/secret 等を設定します.
次に authorization endpoint にリクエストするための URL を取得します.
getAuthenticationRequestUrl :: (MonadThrow m, MonadCatch m) => OIDC -> Scope -> Maybe State -> Parameters -> m URI getAuthenticationRequestUrl oidc scope state params = do ...
第 2 引数は OpenID Connect 1.0 仕様の scope
パラメータに相当します.このパラメータに対する openid
の指定は MUST であるため,明示的に指定しなくても内部で補完しています.
第 3 引数は state
パラメータ (RECOMMENDED) に指定する値です.MUST ではないため Maybe
としています.
第 4 引数は OPTIONAL なパラメータを指定するリストです.
ユーザの許可を得てコールバックされたら,token endpoint に ID Token とアクセストークンを要求します.
requestTokens :: OIDC -> Code -> Manager -> IO Tokens requestTokens oidc code manager = do ...
Code
は authorization endpoint から渡された code
パラメータの値です.
結果として得られる Tokens
には検証済みの ID Token が含まれていますので,これをサービスで利用します.またユーザ情報を取得する場合は Tokens
に含まれるアクセストークンを利用します.
haskell-servant の利用例とちょっとだけ仕組みの調査
はじめに
Haskell には大小様々な Web フレームワークがあります.(yesod, scotty, spock, apiary, rest, 等々)
API サーバを作りたいときは scotty を利用することが多かったのですが,つい最近 haskell-servant というパッケージ群を知りました.
小さな API サーバを書きたいときに便利そうだなと思い,使いつつ軽くコードを読んでみました*1.
環境
- GHC 7.8.3 (64bit)
haskell-servant
型を用いて API 仕様を定義するタイプのフレームワークで,クライアントコードやドキュメントも生成してくれます. API の型とそれに対応するハンドラを組み合わせることで WAI アプリケーションとして動作します.
現在の形になったのはつい最近なんでしょうか? → Rethinking webservice and APIs in Haskell: servant 0.2
試作: メモアプリ用 API サーバ
以下のような API を定義しています.
type MemoAPI = "memos" :> Get [Memo] :<|> "memos" :> ReqBody ReqMemo :> Post Memo :<|> "memos" :> Capture "id" Int :> Delete
:>
が /
みたいなもので,:<|>
が API の結合だそうです.
route を構成するパスやパラメータ名もリテラルとして型に埋め込めます.
戻り値の型は ToJSON
,ReqBody
に指定する型は FromJSON
,Capture
に指定する型は FromText
をそれぞれ実装する必要があります.
例えば FromText
であれば以下のようになります.
-- 例: 数値の offset を TimeZone として解釈させたいとき import Data.Time import Data.Text.Read (decimal) instance FromText TimeZone where fromText t = case decimal t of Right (h, _) -> Just $ hoursToTimeZone h _ -> Nothing
また,ドキュメント生成時にパラメータの説明やサンプルデータが必要になるため,それぞれ ToCapture
,ToSample
のインスタンスを実装します.
instance ToCapture (Capture "id" Int) where toCapture _ = DocCapture "id" "memo id" instance ToSample Memo where toSample = Just sampleMemo instance ToSample [Memo] where toSample = Just [sampleMemo] sampleMemo :: Memo sampleMemo = Memo { id = 5 , text = "Try haskell-servant." , createdAt = ZonedTime (LocalTime (fromGregorian 2014 12 31) midday) (hoursToTimeZone 9) }
仕様変更したときに何か不足していればコンパイルエラーになるため「実装とドキュメントがずれてしまう」といったことは減らせそうです.
ただ今のところデフォルトで出力可能な形式は markdown だけのようで,出力形式を変えたい場合は自前で API -> String
を実装する必要があります.
仕組みを知る上で前提となる知識
(※ご存知の方は読み飛ばしてください)
Type operators
https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/data-type-extensions.html
オペレータシンボルを型コンストラクタとして扱うための拡張です.-XTypeOperators
で有効になります.
型やクラスの宣言に利用されるオペレータを除けば,プレフィックスに :
がなくても良い?みたいです.
servant では :>
や :<|>
がこれに相当します.
Type-Level Literals
https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/type-level-literals.html
数値や文字列を型レベルの定数として扱うことができるようです.
-XDataKinds
で有効になります (DataKinds
自体は,型を kind に,値コンストラクタを型コンストラクタに持ち上げる拡張).
以下は上記ページの例そのままですが,Label "x"
が型として機能しています.
-- 引用元: https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/type-level-literals.html data Label (l :: Symbol) = Get -- String は Symbol kind class Has a l b | a l -> b where from :: a -> Label l -> b data Point = Point Int Int deriving Show instance Has Point "x" Int where from (Point x _) _ = x instance Has Point "y" Int where from (Point _ y) _ = y example = from (Point 1 2) (Get :: Label "x")
もちろん Get :: Label "y"
とすれば example
は 2
を返します.
servant では API のルーティングパスを表現するところで利用されています.
Kind polymorphism
https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/kind-polymorphism.html
kind が多相的に扱えるようになります.何て呼ぶんでしょうか?多相カインド? -XPolyKinds
で有効になります.
kind が明示されていない部分は *
ではなく kind 変数として推論されるようになるみたいです.
data T m a = MkT (m a)
↓GHCi
*Test> :kind T T :: (* -> *) -> * -> * *Test> :set -XPolyKinds *Test> :kind T T :: (k -> *) -> k -> * -- m の kind が * -> * から k -> * (変数あり) に変わった
Proxy
base の Data.Proxy に定義された,型情報を持つだけの data です.
data Proxy t = Proxy
↓GHCi
Prelude Data.Proxy> :kind Proxy Proxy :: k -> *
kind が多相的になっているため,*
や Nat
,Symbol
といった kind に関係なく様々な型を持つことができます.
servant の :>
はいろいろな kind を持った型をとるため,Proxy
を使って定義されています.
-- 引用元: https://hackage.haskell.org/package/servant-0.2.1/docs/src/Servant-API-Sub.html#:> data (path :: k) :> a = Proxy path :> a infixr 9 :>
ちょっとだけ内部に潜る
Application の作成
serve
に渡した p :: Proxy layout
と server :: Server layout
から,HasServer
クラスの route
関数 (の実装) が RoutingApplication
を作成します.
RoutingApplication
は WAI の Application
が少し変更されたもので,servant の RoutingResult
を扱うようになっているため toApplication
関数でこれを変換して最終的な Application
にしています.
-- 引用元: https://hackage.haskell.org/package/wai-3.0.2/docs/src/Network-Wai.html#Application type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived -- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server.html#serve serve :: HasServer layout => Proxy layout -> Server layout -> Application serve p server = toApplication (route p server)
ルーティング処理
実際にルーティングを行っている route
関数は Visitor パターンのような実装になっています.HasServer
の instance 実装でパターンマッチしているようなイメージ?であっているでしょうか.
パスやパラメータ/戻り値の型は Proxy layout
から決定され,Server layout
もその型に従うように要求されます.
-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#HasServer class HasServer layout where type Server layout :: * route :: Proxy layout -> Server layout -> RoutingApplication
API を結合する :<|>
の場合,以下のように分離された a :: Server a
,b :: Server b
をそれぞれまた route
に引き渡すような実装になっています.
a
が失敗した場合に b
が実行されるようになっていることもわかります.
-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(a%20:<|>%20b) instance (HasServer a, HasServer b) => HasServer (a :<|> b) where type Server (a :<|> b) = Server a :<|> Server b -- ここは type operator route Proxy (a :<|> b) request respond = -- ここは constructor route pa a request $ \ mResponse -> if isMismatch mResponse then route pb b request $ \mResponse' -> respond (mResponse <> mResponse') else respond mResponse where pa = Proxy :: Proxy a pb = Proxy :: Proxy b
途中の path をたどっていく部分は,WAI の Request
から取得したリクエストパスと,シンボルとして型に埋め込まれた文字列 path
とを比較し,一致すればさらに進み,一致しなければ失敗 (NotFound
) としてレスポンスを返していることがわかります.
-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(path%20:>%20sublayout) instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where type Server (path :> sublayout) = Server sublayout route Proxy subserver request respond = case pathInfo request of (first : rest) | first == cs (symbolVal proxyPath) -- ここで文字列を取り出して比較 -> route (Proxy :: Proxy sublayout) subserver request{ pathInfo = rest } respond _ -> respond $ failWith NotFound where proxyPath = Proxy :: Proxy path
なお,symbolVal
は型レベルリテラル (Symbol) を文字列として取り出す関数です.
symbolVal (Proxy :: Proxy "hoge") == "hoge" -- True
パラメータがある場合 (例えばサンプルコードの Capture "id" Int
) は,captured
で Text
から a
型の値に変換され (ここで FromText
のインスタンスが必要になる),ハンドラの方 (route
の引数である subserver :: Server layout
) は a -> Server sublayout
型としてキャプチャしたパラメータの値に適用されています.
-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(Capture%20capture%20a%20:>%20sublayout) instance (KnownSymbol capture, FromText a, HasServer sublayout) => HasServer (Capture capture a :> sublayout) where type Server (Capture capture a :> sublayout) = a -> Server sublayout route Proxy subserver request respond = case pathInfo request of (first : rest) -> case captured captureProxy first of Nothing -> respond $ failWith NotFound Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{ -- *ここ pathInfo = rest } respond _ -> respond $ failWith NotFound where captureProxy = Proxy :: Proxy (Capture capture a)
最終的に Proxy layout
の末尾に指定された HTTP Method と戻り値の型の部分までたどり着き,ここで WAI のレスポンスが構築されます.
-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(Get%20result) instance ToJSON result => HasServer (Get result) where type Server (Get result) = EitherT (Int, String) IO result route Proxy action request respond | null (pathInfo request) && requestMethod request == methodGet = do e <- runEitherT action -- ここでハンドラの実行結果を取り出す respond . succeedWith $ case e of Right output -> responseLBS ok200 [("Content-Type", "application/json")] (encode output) Left (status, message) -> responseLBS (mkStatus status (cs message)) [] (cs message) | null (pathInfo request) && requestMethod request /= methodGet = respond $ failWith WrongMethod | otherwise = respond $ failWith NotFound
EitherT
の Left
は失敗したときのステータスコードとメッセージの組,Right
は成功したときの戻り値をそれぞれ表しています.
type Server (Get result) = EitherT (Int, String) IO result
おわりに
あまり深追いはしていませんが,ざっと仕組みは追えたと思います.
ルーティングの部分を型で守りたいと思い apiary を試していましたが,servant も興味深い選択肢の一つだと思いました.
*1:加えて,読み進める過程で自身の知識不足がよく分かりましたので,いろいろ書き残そうと思いました.
Haskell の machines に入門してみた,というお話
はじめに
io-streams パッケージがリリースされた折にふと「conduit,pipes,io-streams 以外の streaming data を扱うライブラリには何があるんだろうか?」と疑問に思いつぶやいてみたところ, machines がある ということを教えていただきました.
気になったので調べてみた,というのが今回の内容です.
基本的な使い方に始まり,何とか attoparsec を組み込むあたりまでは辿り着きました.なお,GHC 7.4.1 を使用しています.
見出し
- これは何?
- 雰囲気
- どう使うの?
- 基本形
- Source の作成
- Process の作成
- Transducer を組み込む
- 複数入力の取り扱い
- Parser を組み込む
- おわりに
これは何?
今回の対象は↓これ.
- machines-0.2.3.1
Machines are demand driven input sources like pipes or conduits, but can support multiple inputs.
だそうです.加えてトランスデューサのデータ構造も定義されています.
用意されている API はシンプルに見えるのですが,どれも汎用性の高いものばかりです.
雰囲気
- Plan から Machine を作成
(<~)
や(~>)
を使って Machine をつなげる- Source は入力を読まない Machine
- 文字通りソースとして利用する
- Process は
a -> b
という関数に相当する Machine- stream に何か処理をかけたいときはこれを利用する
- Tee や Wye は複数入力を扱う Machine
- Mealy や Moore はトランスデューサを表現
- Automaton のインスタンスになっているため,Process にして連結できる
- Unread は入力の push back を表現
- 0.2.3.1 では使い方がわからず...
- github から
commit f03dd47
までは行ったバージョンを持ってくると unreading が定義されていて Process 化できる
- Automaton クラスのインスタンスは Process になる
- auto 関数を使う
(->)
がインスタンスになっているため,a -> b
型の関数は auto で Process になる
最後に run
すると動きます.
どう使うの?
ドキュメントとソース (の一部) を読んでサンプルコードを作ってみました.なお,以下すべてにおいて先頭の
{-# LANGUAGE OverloadedStrings #-} module Main where import Data.Machine
を省略しています.
基本形
最も単純な例として,リストをソースとしてそれをそのまま出力するコードです.
main :: IO () main = runT test >>= print where test = source [1..10] ~> echo -- [1,2,3,4,5,6,7,8,9,10]
source
関数は Foldable
のインスタンスから Source
を生成します.
(~>)
は Data.Machine.Process
に定義されている関数で,ProcessT
と MachineT
を連結します.
Source
/SourceT
や Process
/ProcessT
はすべて MachineT
のシノニムになっているため,これで連結できるというわけです (連結には MachineT m k o
の k
が関係するため,好き勝手に連結できるわけではない).
また,Data.Machine.Process
にはいくつかの Process
があらかじめ定義されています.上記の echo
もその一つです.
Source の作成
Plan
を使うことで Source
を作ることができます.ここでは Handle
から ByteString
を読み込んで Source
にしてみます.
import qualified Data.ByteString as BS import qualified System.IO as IO import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Exception.Lifted (bracket) sourceHandle :: MonadIO m => IO.Handle -> SourceT m BS.ByteString sourceHandle h = repeatedly $ do bs <- liftIO $ BS.hGetSome h 4096 if BS.null bs then stop else yield bs main :: IO () main = readAll "test.txt" >>= print where readAll fp = bracket (IO.openBinaryFile fp IO.ReadMode) IO.hClose action action h = runT $ sourceHandle h ~> echo -- ここで使ってる
sourceHandle
には,以下の内容をそのまま書き下しているだけです.
- データを取り出す
- 空なら停止
- そうで無いなら yield で返す
- 停止するまで繰り返す (repeatedly)
repeatedly
は Plan
を繰り返し実行する Machine
を作り出す関数です.Data.Machine.Types
に定義されており,他にも construct
や before
があります.
Process の作成
取り出した値を文字列化するだけの単純なものを作ってみます.
main :: IO () main = runT test >>= print where test = src ~> str src = source [1..5] str = repeatedly $ do -- 注意: auto show と等価 i <- await yield $ show i -- ["1","2","3","4","5"]
str
は auto
関数を使って auto show
と書いたものと等価です.
Automaton
クラスのインスタンスは auto
を使えば Process
に変換できます.
(->)
のインスタンスが定義されているため,a -> b
は Process
にできます.
Transducer を組み込む
トランスデューサを Process
として連結できます.例えば以下のような立ち上がりエッジ検出もどきは
次のように書けます.
main :: [Int] -> IO () main i = test i >>= print where test i = runT $ source i ~> auto ms ms = Mealy $ \a -> case a of 0 -> (0, m0) 1 -> (0, m1) m0 = Mealy $ \a -> case a of 0 -> (0, m0) 1 -> (1, m1) m1 = Mealy $ \a -> case a of 0 -> (0, m0) 1 -> (0, m1) -- > main [0,0,1,1,0,1,0,1,1,1,1,0] -- [0,0,1,0,0,1,0,1,0,0,0,0] -- > main [1,0,1,1,0,1,0,1,1,1,1,0] -- [0,0,1,0,0,1,0,1,0,0,0,0]
Mealy
で遷移を組んで,auto
で Process
にしているだけです.そのまんまですね.
複数入力の取り扱い
Tee
や Wye
を使うと複数の入力を扱うことができます.
main :: IO () main = runT test >>= print where test = tee inL inR use inL :: Process Int Int inL = source [1..10] inR :: Process Int Int inR = source [1..10] ~> auto (*10) use = repeatedly $ do l <- awaits L r <- awaits R yield $ l + r -- [11,22,33,44,55,66,77,88,99,110]
test
関数の内容は単純で,以下のようなことをしているだけです.
inL: [1..10] ------------+ | use: l + r ---> 出力 | inR: [1..10] --> (*10) --+
Tee
の部分は Plan
を使って作成しています.各入力は対応するコンストラクタを awaits
関数に指定して取り出します.
Wye
を使う場合も多分同じようにします.
Parser を組み込む
Plan
に attoparsec
の parsing 処理を組み込めば attoparsec-conduit
みたいなものが作れます.
なお,ここだけは github から最新の (commit f03dd47 まで入っている) コードを取得して利用しています.
最近になって unreading
という,Unread
を利用した Plan
を Process
化する関数が入ったためです.
import qualified Data.ByteString as BS import Control.Monad (unless) import qualified Data.Attoparsec.ByteString as AB import qualified Data.Attoparsec.Types as A -- ByteString や Text の差を吸収するためのクラス class ParserInput a where parse :: A.Parser a b -> a -> A.IResult a b isNull :: a -> Bool -- とりあえず ByteString だけ定義 instance ParserInput BS.ByteString where parse = AB.parse isNull = BS.null -- parser process の本体 pp :: (ParserInput i, Show o) => A.Parser i o -> Process i o pp pr = unreading $ plan (parse pr) -- (1) where plan p = await >>= runp where runp i = go $ p i go (A.Fail _ _ err) = error err -- XXX ごまかした go (A.Partial p') = plan p' go (A.Done t r) = do unless (isNull t) $ unread t -- (2) yield r plan (parse pr)
パースして残った入力は (2) で Unread a
として push back しています.(1) の unreading
で Unread
を適切に処理する Process
へと変換されます.
これで Source
をパースすることができるようになりました.
import qualified System.IO as IO import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Exception.Lifted (bracket) import Control.Applicative (empty) import qualified Data.LTSV as L -- 前回の記事で作成した LTSV パーサ main :: IO () main = readAll "test.txt" >>= print where readAll fp = bracket (IO.openBinaryFile fp IO.ReadMode) IO.hClose action action h = run $ sourceHandle h ~> pp L.recordNL sourceHandle :: (MonadIO m) => IO.Handle -> Machine m BS.ByteString sourceHandle h = repeatedly $ do bs <- liftIO $ BS.hGetSome h 10 -- わざと小さくしている if BS.null bs then empty -- 0.2.3.1 より後のバージョンでは stop が無くなっている else yield bs -- 実行結果: -- sourceHandle 自体の出力 -- ["aaa:111\tbb","b:222\naaa:","111\tbbb:22","2\tccc:333\n"] -- main の出力 -- [[("aaa","111"),("bbb","222")],[("aaa","111"),("bbb","222"),("ccc","333")]]
入力は \n
に関係なく途切れていますが,正しく処理されています.
おわりに
Plan
からMachine
が作れるMachine
を連結することでより大きなMachine
が作れるSource
やProcess
もPlan
を書くことで自由に定義できるTee
やWye
で複数の入力を連結し,処理することができるMealy
やMoore
でトランデューサを定義し,Process
として連結できる- parser を
Process
として組み込んでみた (Unread
の利用例でもある)
次のバージョンではコードが結構変わっているっぽいです.