こんにちは､びしょ～じょです｡脱毛にて､痛みで身体が震えることを知りました｡

1. はじめに

さて､前回はレイヤードアーキテクチャ､特にDDDについて話した｡またソフトウェアアーキテクチャ一般について､なぜそういったアーキテクチャを採用するのかとかちゃんとせいよという一般的な部分も触れた｡

こんにちは､びしょ〜じょです｡11月26日といえば1､後醍醐天皇､Laz､おれの誕生日でした｡みんなは何人わかるかな?# ここに欲しいものリストを貼る Amazonほしい物リストを...

今回は､具体的にOCamlでDDDを実装する際のポイントを紹介したい｡再掲になるが以下に実装がある｡

今回は結構簡素です｡

2. 型の隠蔽でドメインの値を絞る

まずはドメインオブジェクトをモデリングしていく｡ DDDはアプリケーションの不変条件としてドメインを置き､それらが不正な状態にならないことが重要になる｡この実現のために､スマートコンストラクタなど特定のパスでバリデーションが通った値だけを生成したい｡

OCamlではopaque typesを使えばOKだが､エンティティ自体の型を隠蔽してしまうとフィールドアクセスが煩雑になる｡そこで､ドメインオブジェクトの型のシェイプは公開し､ それぞれのフィールド(value objects)のみ 隠蔽する｡

domains/objects/user.ml

module Id : sig
  type t
  val from : int -> t
  val to_ : t -> int
end = struct
  type t = int
  let from = Fun.id
  let to_ = Fun.id
end

module Email : sig
  type t
  val from : string -> (t, [> `InvalidFormat of string]) Result.t
  val to_ : t -> string
end = struct
  type t = string
  let from s =
    if String.contains s '@' then Ok s
    else Error (`InvalidFormat "email")
  let to_ = Fun.id
end

type t =
  { id : Id.t
  ; email : Email.t
  }

Id の from､to_は単なる型変換だが､Email の from はバリデーションを行う｡実装はid関数になっており､単に型を隠蔽しているだけなのがテク｡ Signatureを定義できるって､うれしいなあ｡これで user.email など各フィールドへのアクセスはできつつもEmail.t がないとオブジェクト自体は作れない｡したがって､あるオブジェクトがあれば､その各フィールドはdomain的に正しい値であることが保証される｡いわゆる『Parse, don't validate』¹ですね｡各フィールドは単にレコードのアクセスで済ませられ､フィールドの値の取り出しになって初めてdeconstructionする｡値の生成=parsingになり､野良domain objectsが事実上存在しなくなり､バリデーションのロジックがdomain層に集約されるためapplication層での値のチェックが不要になる｡しかも同型ならランタイムコストは実質0になる｡

同型…(ここで雷鳴) ムムッ ､これは (準)同型変換 だな｡各フィールドは同じように書けるんで､ファンクターを定義するとよさそう｡

domains/morph.ml

module type Sealed = sig
  type bwd [@@deriving eq, show]
  type t [@@deriving eq, show]

  val from : bwd -> t
  val to_ : t -> bwd
end

module type SealedHom = sig
  (* 略 *)

  val validate : bwd -> bool
  val from : bwd -> (t, [> Errors.t ]) Result.t (* domain上のエラー *)
end

module Seal (M : sig
    type t [@@deriving eq, show]
  end) : Sealed with type bwd = M.t = struct
  include M

  type bwd = t [@@deriving eq, show { with_path = false }]

  let from = Fun.id
  let to_ = Fun.id
end

module SealHom (M : sig
    (* 略 *)
  end) : SealedHom with type bwd = M.t = struct
  (* 略*)

  let from t = if validate t then Ok t else Error (`ConvertError field)
end

各フィールドの(準)同型変換を束ねるとドメインオブジェクトの変換になるんでproduct morphismと考えられますね｡またそれぞれのフィールドはベースの型に戻るのでbifuntor､じゃな｡ from to_ は inj prj とかにするとさらに雰囲気出そうですね｡ちゃんと数学やってるともう少し意味のあることが言えそうですが､私は積み重ねてこなかった側なんで､詳しい話は冬休み中お家の人に聞いてみてね｡

Domain側の実装では脳に刺激が与えられ､caller側ではオブジェクトをシンプルに扱えるようになり､脳に良い～～｡

3. 依存関係をエフェクトで文脈に持ち上げる

Domainが実装できたので次いでrepositoriesとusecasesを定義しよう｡バックエンドはinfrastructureにあるので､振る舞いそのものにだけ集中して書ける｡書けるというか書くことになる｡ Usecasesはrepositoriesに依存することになるので､まあファンクターを使ってみましょうか…?

app/usecases/register_user.ml 一旦ファンクター

module New(M: Domains.Repositories.User) = struct
    let run ~name ~email =
      let open Result.Syntax in
      let open Domains.Objects in
      let* name = User.Name.from name in
      let* email = User.Email.from email in
      M.create ~name ~mail
      >>| fun { id; _ } -> id
    ;;
end

でもこれ…全部のusecaseでやるんすか? この例ではM = User repositoryだけど､複数のreposをまたぐ場合 New(M: R1)(N: R2)...で呼び出し側もえぐいど…｡

例えば皆さんご存知ライブラリOSのMirageOSはOCamlで実装されており各抽象レイヤーはファンクターで繋げられる｡しかし複雑さが極まっているので､Functoriaという他段階計算を用いてビルド時にファンクター適用を解決するDSLを提供している｡いやー俺達もすでに面倒そうなんですけど､DSL提供するという新たな痛みを生みたくないんですけど…｡

せや! エフェクトに頼ろう!

というわけでeffectsを使って依存関係を文脈に追いやって数珠つなぎの依存注入からプログラム､そして人類を解放する｡ Repositoriesの振る舞いをeffectsとして定義し､usecasesではそれをperformするだけにする｡

各reposのeffectsをひとまとめにするために､まずactionというextensible variantを用意して､それをemitするeffectを定義する｡

domains/repositories/locator.ml

type _ action = .. (* 一応ちなむと`..`はextensible variantの記法ですよ *)

type _ Effect.t +=
  | Inject : (('a, [> Errors.t ]) Result.t as 'action) action
           -> 'action Effect.t

let call action = Effect.perform (Inject action)

どんな値が欲しいかを書いてeffectを投げると､その値が返ってくるイメージ｡

実際のactionは各repositoryごとに定義する｡

domains/repositories/user.ml

open struct
  module M = Objects.User
end

open Locator

type _ action +=
  | Create :
      { name : M.Name.t
      ; email : M.Email.t
      }
      -> (M.t, [> Errors.t ]) Result.t action

これの嬉しいところは､シグネチャと実装が分けられるうえに､シグネチャ(action)を利用しないとeffectが投げられないため､強制的に一致する点だ｡これでusecaseは次のように書ける｡

app/usecases/register_user.ml with effect

let run ~name ~email =
  let open Result.Syntax in
  let open Domains.Objects in
  let* name = User.Name.from name in
  let* email = User.Email.from email in
  Domains.Repositories.(Locator.call @@ User.Create {name; email})
  >>| fun { id; _ } -> id
;;

依存が値の世界から文脈にアセンションされたため､インターフェイスが簡潔になった｡簡潔になったんで､依存を最後の最後に結合するmainまで注入を考えなくてよくなった｡脳に良すぎる…｡同様に､usecasesで呼びたい外部サービスもeffectsとして定義して､それらをperformすればよい｡

3-1. さらに脳の負担を減らすか?

RepositoryのアクションのシグネチャがResult.tを返すが､なくても良いかもしれない｡

omit Result

(* domains/repositories/locator.ml *)
type _ Effect.t +=
  | Inject : 'action action
           -> 'action Effect.t

(* domains/repositories/user.ml *)
type _ action +=
  | Create :
      { name : User.Name.t
      ; email : User.Email.t
      }
      -> User.t action

えっじゃあミスったらどうするんですか? どうするかをハンドラ側に委ねればよい｡

main/handler.ml

let repo_handler th =
  match th () with
  | effect Inject (User.Create { name; email }), k ->
    let res = Infrastructure.DB.Sql.Users.create ~name ~email in
    (match res with
     | Ok user -> conitnue k user
     | (Error _) as e -> e)
  | v -> Ok v

おお確かに､ミスったら継続を捨てればよくて､最後にvalue handlerでOkに包めばよい｡うーんでもどうかな､repository actionって失敗する可能性あるからResultあってもいい気がする｡極限までやりたいこと以外の処理を遅延させるか､失敗する可能性を明示するか､一旦トレードオフということで議論の余地を残しておきます｡

4. 結び目としてのmain: DDD as an extensible interpreter

さて､usecaseが定義できた｡実はinfrastructureもinterfaceも実装できている｡そういうことにしよう｡実装は/server/infra/db/sql/users.mlとか/server/interface/grpc/services/oresai/services/user.mlをみてね｡

そして依存解決をmainでおこなっていく｡

先程すこし書いたが､やってくるeffectsに対してハンドラを書けばよい｡

main/handler.ml

let repo_handler ~db th =
  let system th =
    try th () with
    | effect Inject System.Ping. k -> continue k @@ Infrastructure.System.ping ()
  in
  let users th =
    try th () with
    | effect Inject (User.Create { name; email }), k ->
      continue k @@ Infrastructure.DB.Sql.Users.create ~name ~email
    ...
  in
  Sql.Handler.v db @@ fun () ->
    system @@ fun () ->
    users @@ fun () ->
    th ()

このハンドラでプログラムを囲むだけで実行環境が渡せてしまう｡大変簡単ですね｡

ここで､アーキテクチャの実装全体を俯瞰すると以下のような図になる｡

わかりやすい依存関係図

domains (repositories)
    ↑        ↑
    |        |
usecases     |
    ↑        |
    |        |
interface    |
    ↑        |
    |  ←ー infrastructure
    |        |
main (handlers)

Domainsでrepositoryを操作する語彙を定義し､usecaseでそれらを利用したあらたな語彙を定義し､interfaceでuseacsesの語彙を利用してアプリケーションの動作全体を記述する｡そしてmainにて､usecaseの語彙－effectとして送出されるrepositoryの語彙－を解釈する｡

これって… extensible interpreter パターンじゃないですか? 各層でDSLを定義し､語彙を追加していき､最後に解釈器を合成していく｡ Expression problemもeffect handlerで粉砕や｡ Webアプリケーションを作っていたつもりだが､いつのまにかDSLを定義し､インタプリタを記述していた｡アプリケーションのロジックは純粋な計算の記述となっており､infrastructureにてランタイムのオペレーションを書き､mainで合成する｡ Extensible interpreter言いたいだけちゃうかって感じですが､まあなんかスッキリした気分なんでOKです｡

5. "副次効果としての"テスト容易性

さて､みなさんテストは書いてくださいね｡これまでテストの話は一切でてこなかったが､なんとこのアーキテクチャはテストが書きやすい｡ Domainsは言わずもがな､usecasesも副作用がeffectとして飛び出てくるので､ハンドラを書けば簡単にテストできる｡

app/usecases/test/register_user.ml

let test =
  ( "register_user"
  , [ ( test_case "ok" `Quick @@ fun () ->
        let fixture =
          Testing.User.fixture
            ~name:"test"
            ~email:"test@example.com"
            ()
        in
        let inj : type a. a Locator.action -> a = function
          | User.(Create { name ; email }) ->
            Alcotest.check'
              (module Domains.Objects.User.Name)
              ~msg:"same name"
              ~expected:(Domains.Objects.User.Name.unsafe_from "test")
              ~actual:name;
            Alcotest.check'
              (module Domains.Objects.User.Email)
              ~msg:"same email"
              ~expected:(Domains.Objects.User.Email.unsafe_from "test@example.com")
              ~actual:email;
            Ok fixture
          | _ -> failwith "unmatched"
        in
        let actual =
          let comp () =
            M.run
              ~name:"test"
              ~email:"test@example.com"
              ()
            |> Result.map Domains.Objects.User.Id.to_
          in
          try comp () with
          | effect Locator.Inject action, k -> Effect.Deep.continue k (inj action)
        in
        Alcotest.check'
          (result int64 Errors'.t)
          ~msg:"equal"
          ~expected:(Ok (Domains.Objects.User.id fixture))
          ~actual )

特別なモックライブラリなどは不要で､effect handlerを書くだけでOK｡

6. 余談: OCamlでgRPCは(一応)できるし､duneとeioは偉大

今回はNix上に環境を作り､PostgreSQL+AtlasでDBを用意し､bufでprotobufをコンパイルする流れになった｡だいたい毎度OCamlでアプリケーションを書くとどこかにPRを出す必要が生まれるが､nixではopam-nixにまずPRを投げた｡

Add openssl to add libssl for conf-postgresql in overlay by Nymphium · Pull Request #134 · tweag/opam-nix

This PR adds nixpkgs.openssl to conf-postgresql buildInputs.libpq provided by nixpkgs is not linked to libssl:$ pkg-config --print-errors libpqPackage libssl was not found in the pkg-config sear...

Nixpkgsのハッシュによってはopensslなどが必要になるバージョンが降ってくるんで､それの対応ですね｡

またgRPCのreflectionのためにOCamlのprotoc pluginにPRを出した｡自分の都合でpendingさせてしまっているが､マージされたら皆さんもgrpcurlなどを叩く際にパラメータをいくつか省略できるようになるだろう｡ gRPC reflectionは所与のものとして考えていたので､実装方法が知れて勉強になった｡

Add metadata for gRPC reflection API by Nymphium · Pull Request #50 · andersfugmann/ocaml-protoc-plugin

This PR adds Metainfo module to each generated files.That module has information to implement gRPC reflection API:file name: its source proto file name pathfile descriptor: protobuf binary form...

さて書き味でいうと､EioのおかげでだいぶIO周りが書きやすくなったし､対応しているライブラリもだいぶ多く､困らない｡今回はgRPCサーバの実装にocaml-grpcのeioランタイムを利用した｡ ocaml-grpcはリクエストごとにスレッドを作るが､スレッドをまたぐeffectの送出はできないため､ハンドラごとに渡すことになった｡スレッドをまたげない理由は『Retrofitting effect handlers over OCaml』に載ってた気がするが､単にスレッドをまたいでどうやって継続を呼ぶかあたりっすね｡なかったらすまん｡論文の解説は以下に書いた｡

Retrofitting Effect Handlers onto OCaml - lilyum ensemble

あけましておめでとうございます､びしょ～じょです｡これは言語実装Advent Calendar2022 17日目の記事です｡諸事情ありましたが端的に申し上げると私の怠慢で大幅に投稿日が遅れました...

Duneも3.20を利用しており､include_subdirsやruleのdepsにディレクトリを指定できたりとモダンなビルドシステムとしての成熟を見せている｡ include_subdirsはディレクトリを掘るとそのディレクトリ名と内容に対応したモジュールを生成してくれるというもので､そんなんできてあたりめーだろってのが､無かったんすねえ｡