前回の記事、Elmish ... メッセージがいっぱいはFable.ElmishでTaxonomyマスタ保守画面をどのように実装したか?というお話でした。
マスタ保守画面の機能としては、その前のF#でDapperを使ったDBアクセスと併せて、ひとまず完了したつもりですが、このままでは誰でもデータを変更できてしまうのでログイン画面を追加します。

追加しようとしているログイン画面はユーザーidとパスワードを入力して認証する単純なものです。
ASP.NET Identityを使うとそれっぽいのでしょうけど、今回はDBアクセスもなし。プログラムに埋め込んでしまいます。 手抜き
もしこの記事を参考になさる方がいらっしゃったら適宜変更していただければ良いかと思います。
Dapperを使うならこのシリーズの記事が応用できますよね。

JWT(JSON Web Token)については、JWT 認証とかでググると沢山出てきますが、簡単に説明すると「認証時にユーザー情報等からトークンと呼ばれる文字列を生成してクライアント側に返し、クライアントは以降のアクセス時にトークンをHttpHeaderに付与してアクセスする」ということになるかと思います。送られてきたトークンをサーバー側でチェックして認証済みユーザーかどうかを判断するわけですね。

Fable.Remotingにはトークンを指定してアクセスする仕組みが有り、Saturnにはそれをチェックする仕組みがあるので、細部は説明しません。 よくわかっていないし

このあたりは SAFE BookStoreを参考に実装しています。
SAFE BookStoreはログイン画面をひとつのページとして実装していますが、今回はモーダルダイアログで実装してみました。

完成版のソースコードはGitHubのこちらです。
煮るなり焼くなりお好きにどうぞ。

サーバー側と共有コード

基になっているpart6のソースと比較して、サーバー側の主な変更点は以下のようになります。

  • Server\Services\Auth.fs の追加。ログイン時の処理、JWTの生成。
  • Shared\Shared.fs にAuthサブモジュールの追加。ログインAPIの定義。
  • Shared\Shared.fs のRouteサブモジュールのルートビルダを、JWTを必要とするルートとそうでないルートに分けた。
  • Server\Server.fs にルートの追加。上記変更に併せて。
  • Server\Server.fs の applicationのところにJWTによる認証を使用するように設定

共有コード Shared.fs

まず、簡単なRouteサブモジュールから。

module Route =
    /// Defines how routes are generated on server and mapped from client
    let apiRouteBuilder typeName methodName =
        sprintf "/api/%s/%s" typeName methodName
    let publicRouteBuilder typeName methodName =
        sprintf "/public/%s/%s" typeName methodName

JWTを必要とするルートはapiRouteBuilder、そうでない方はpublicRouteBuilderです。
違いは頭の/api/publicしかありません。
後述しますが、Taxonomyマスタメンテ画面はapiRouteBuilder、それ以外(今回追加するログインとCounterサンプルページ)はpublicRouteBuilderの方を使います。

続いて、Authサブモジュールは次のようになります。

[<AutoOpen>]
module Auth =
    // Json web token type.
    type JWT = string
    type UserData = { 
        UserName : string
        Token    : JWT 
    }
    // Login credentials.
    type Login = { 
        UserName   : string
        Password   : string
    }
    type IAuthApi = {
        login : Login -> Async<UserData>
    }

ちなみに頭の[<AutoOpen>]はopenしなくても使えるよ!という属性です。

クライアントからログイン時に渡ってくるレコードがLoginで、認証結果を返す方がUserDataです。
API定義なので、説明は特にありません。

サービス Auth.fs

Server\Services\Auth.fs は以下。短いので全部載っけちゃいます。

module Services.Auth

open System
open System.Security.Claims
open System.IdentityModel.Tokens.Jwt
open Microsoft.IdentityModel.Tokens
open Saturn

open Microsoft.AspNetCore.Http
open Giraffe
open Fable.Remoting.Server
open Fable.Remoting.Giraffe
open FSharp.Control.Tasks.V2

open ApiCommon
open Shared


let secretKey = Guid.NewGuid().ToString()
let issuer = "nekoni.net"
let generateToken user =
    let expires = DateTime.UtcNow.AddHours(1.0)
    let claims = [|
        Claim(JwtRegisteredClaimNames.Sub, user);
        Claim(JwtRegisteredClaimNames.Jti, Guid.NewGuid().ToString()) |]
    claims
    |> Saturn.Auth.generateJWT (secretKey, SecurityAlgorithms.HmacSha256) issuer expires

let login(param: Login) = task {
    // ここは本来ならDBとチェックすることになるでしょう
    let ret = 
        match param.UserName, param.Password with
        | "guest", "guest" -> { UserName=param.UserName; Token=generateToken param.UserName }
        | _, _ -> failwith "ログインに失敗しました"
    return ret
}
let apiRoute:(HttpFunc -> HttpContext -> HttpFuncResult)  = 
    let api:IAuthApi = { 
        login = login >> Async.AwaitTask 
    }
    Remoting.createApi()
    |> Remoting.withRouteBuilder Route.publicRouteBuilder
    |> Remoting.withErrorHandler errorHandler
    |> Remoting.fromValue api
    |> Remoting.buildHttpHandler

generateTokenという関数がJWTを生成している部分です。
見ての通り、最低限。
ユーザー名しか使ってません。あわわ
業務で使う場合は所属とか役職とかいくつか属性追加してあげると良いでしょう。

login関数は先ほどShared.fsに定義されていたIAuthApiの実装関数です。
見ての通り、ユーザーidとパスワードは"guest"固定! うはは
これも業務で使う場合はDB等のユーザー情報に問い合わせてチェックする形になると思います。

最後のapiRoute関数はFable.Remotingの定義です。
Remoting.withErrorHandlerに指定しているのは Server\ApiCommon.fsに定義しているerrorHandler関数です。
これはlogin関数で発生させているログイン失敗時の例外を処理するもので、Fable.Remotingのここを参考にしています。

Server\ApiCommon.fsに定義しているerrorHandler関数

let errorHandler (ex: Exception) (routeInfo: RouteInfo<HttpContext>) = 
    // do some logging
    printfn "Error at %s on method %s" routeInfo.path routeInfo.methodName
    // decide whether or not you want to propagate the error to the client
    match ex with
    | x ->
        let err = 
            if x.InnerException = null then { errorMsg = x.Message }
            else { errorMsg = x.InnerException.Message }
        Propagate err

最後のPropagateFable.Remoting.Server.ErrorResultという判別共用体のケース識別子で、指定したオブジェクトがクライアント側で発生するProxyRequestException例外のResponseTextというプロパティにJSON形式で格納されるようになります。
後述のクライアント側のエラーハンドリングのところでまた出てきますので、今はふーんぐらいに思っていただければ。

Saturnのルート定義

/publicというルートを追加したので、Saturn側にも追加します。

src\Server\Sever.fs

// 中略

// WebApiルート(jwtによるセキュアなルート)
let apiRouter = router {
    not_found_handler (text "404")
    pipe_through (Auth.requireAuthentication ChallengeType.JWT)
    forward "/ITaxonomyApi" Services.Taxonomies.apiRoute
}

// フリーWebApiルート
let publicRouter = router {
    not_found_handler (text "404")
    forward "/IAuthApi" Services.Auth.apiRoute
    forward "/ICounterApi" Services.Counter.apiRoute
}


// Topルーター
let topRouter = router {
    not_found_handler (text "404")
    forward "/public" publicRouter
    forward "/api" apiRouter
}

let app = application {
    use_jwt_authentication Services.Auth.secretKey Services.Auth.issuer

    url ("http://0.0.0.0:" + port.ToString() + "/")
    use_router topRouter
    memory_cache
    use_static publicPath
    use_gzip
    app_config DbInit.Initialize
}

run app

Saturnの指定の仕方はとてもわかりやすいですね。
どんな関数があるかはSaturn Docsを見るといいのですが、若干、ドキュメントの方が本体のアップデートに追い付いていないようなので注意です。
だいぶ前にscoperouteとリネームされたのですが、ドキュメントはscopeのままです。

開発時のWebpackの設定

サーバー側のコード変更については以上なのですが、/publicルートの設定をWebpackの開発用サーバーにも設定する必要があります。
SAFE StackはフロントにWebpackの開発用サーバーを使ってHMR(Hot Module Replacing 実行させたままソースコードを変更できるようにする仕組み)を利用しています。

Client\webpack.config.jsの以下の部分を変更します。

// 中略
var CONFIG = {
    fsharpEntry: {
        "app": [
            "whatwg-fetch",
            "@babel/polyfill",
            resolve("./Client.fsproj")
        ]
    },
    // ルートの追加
    // devServerProxy: {
    //     '/api/*': {
    //         target: 'http://localhost:' + (process.env.SUAVE_FABLE_PORT || "8085"),
    //         changeOrigin: true
    //     }
    // },
    devServerProxy: [{
        context: ['/public', '/api'],
        target: 'http://localhost:' + (process.env.SUAVE_FABLE_PORT || "8085"),
        changeOrigin: true
    }],
    historyApiFallback: {
        index: resolve("./index.html")
    },
// 中略

module.exports = {
    entry : CONFIG.fsharpEntry,
// 中略
    // Configuration for webpack-dev-server
    devServer: {
        proxy: CONFIG.devServerProxy,
        hot: true,
        inline: true,
        historyApiFallback: CONFIG.historyApiFallback,
        contentBase: CONFIG.contentBase
    },

CONFIG.devServerProxyは下の方で、devServerのproxyに設定されます。

なんかうまく動かなくて小一時間悩んでいたのですが、これを忘れていました...

クライアント側

クライアント側の主な変更点は以下のようになります。

  • Client\LoginForm.fs の追加。ログイン画面
  • Client\UserStorage.fs の追加。ログイン情報をBrowserのLocal Storageに保存
  • Client\pages\Counter\State.fs のapi定義に指定しているルートの変更
  • Client\pages\Taxonomies\State.fs のapi定義に指定しているルートの変更
  • Client\pages\Taxonomies\Type.fs のモデル定義にjwtプロパティを追加
  • Client\pages\Taxonomies\State.fs APIアクセス関数やinit関数にjwtを引数で受けるように修正
  • Client\Types.fs のメッセージ定義にログイン関連を追加。また、モデルにログイン情報を追加
  • Client\View.fs ログイン/ログアウトボタン追加。LoginFormモーダルの埋め込み
  • Client\State.fs update関数にログイン処理の追加。Taxonomiesのinit関数呼び出し時にjwtを渡すように変更

こうしてみると、かなり変更点が多いですねぇ。
ひとつひとつ見ると大したことないんですけど...。

全てを説明するよりはコードを見ていただいた方が早いので、ここでは要所だけかいつまんで説明いたします。

ログイン画面 LoginForm.fs

これまではモデルとメッセージ定義のTypes.fs、HTMLレンダリングのView.fs、init関数とupdate関数のState.fsというようにソースファイルを分割していましたが、LoginForm.fsはひとつにまとめてしまいました。
これ一枚をそのまま別のプロジェクトに流用出来そうだなと感じたからです。それほど長くありませんしね。

Elmishにおけるコンポーネントて、こんな感じにしていくのでしょうかねぇ。

一点だけ、ご説明を。

let update (msg:Msg) model : Model*Cmd<Msg> =
    match msg with
    | LoginModelChanged login ->
        { model with Login = login }, Cmd.none
    | ClickLogin ->
        let cmd =
            Cmd.ofAsync
                api.login
                model.Login
                (Ok >> LoginResult)
                (Error >> LoginResult)
        model, cmd
    | LoginResult (Ok user) ->
        { model with State = LoggedIn user; Login = { model.Login with Password = "" } }, Cmd.none
    | LoginResult (Error exn) ->
        match exn with
        | :? ProxyRequestException as ex -> 
            printfn "%s" ex.ResponseText
            let response = Decode.Auto.unsafeFromString<ErrorResponse> ex.ResponseText
            { model with ErrorMsg = string (response.error.errorMsg) }, Cmd.none
        | _ ->
            { model with ErrorMsg = string (exn.Message) }, Cmd.none

update関数なのですが、LoginResultメッセージのエラーハンドリングでProxyRequestExceptionという例外を受けています。
これはFable.Remotingに定義されている例外で、サーバー側のカスタム例外に対応しています。
この例外のResponsTextプロパティはJSON形式のデータとなっており、以下のような構造になっています。

{ 
    "error":  {
        "errorMsg": "Something terrible happened"
    },
    "ignored": false, 
    "handled": true 
}

これはサーバー側の説明でも出てきたFable.RemotingのError Handlingに記述があります。

"error"プロパティに、Server\ApiCommon.fsで定義しているerrorHandler関数の戻り値 Propagate errに指定したerrオブジェクトが設定されるようになります。

JSON文字列からF#のレコードに変換するのにFable2.0からのおすすめの Thoth.Jsonを使用しています。
Fable1.xにはofJsonという関数があったのですが、Fable2.0ではdeplicatedにマーキングされてました。

Login関連のメッセージと処理の追加

ProgramのTypes.fsは以下のようにログイン関連とApiErrorというメッセージを追加しています。

type Msg =
  | LoggedIn of Auth.UserData
  | LoggedOut
  | Logout
  | LoginMsg of LoginForm.Msg
  | StorageFailure of exn
  | ErrorMsg of exn
  | NotificationMsg of Notification.MsgType
  | ApiError of exn
  | HomeMsg of Home.Types.Msg
  | CounterMsg of Counter.Types.Msg
  | JankenMsg of Janken.Types.Msg
  | TaxonomiesMsg of Taxonomies.Types.Msg

そしてこれを処理するupdate関数は以下のように。

let update msg model =
    match msg, model.PageModel with
// 中略
    // ログイン
    | LoginMsg msg, _ ->
        let (loginModel, cmd) = LoginForm.update msg model.LoginModel
        match loginModel.State with
        | LoginForm.LoggedOut ->
            { model with LoginModel = loginModel }, Cmd.map LoginMsg cmd
        | LoginForm.LoggedIn user ->
            { model with LoginModel = loginModel }, saveUserCmd user
    | LoggedIn newUser, _ ->
        let page = 
            match model.PageModel with
            | TaxonomiesModel m -> TaxonomiesModel {m with jwt = newUser.Token}
            | _ -> model.PageModel
        { model with UserData = Some newUser; PageModel = page }, Cmd.none

    // ログアウト
    | Logout, _ ->
        model, removeUserCmd()
    | LoggedOut, _ ->
        let (login, _) = LoginForm.init None
        { model with LoginModel = login; UserData = None }, Cmd.none

    // APIエラー
    | ApiError exn, _ ->    
        match exn with
        | :? ProxyRequestException as ex -> 
            match ex.StatusCode with
            | 401 ->    //Unauthorized
                Browser.console.log("Unauthorized");
                model, Cmd.ofMsg Logout
            | _ -> 
                model, Cmd.ofMsg (ErrorMsg exn)
        | _ ->
            model, Cmd.ofMsg (ErrorMsg exn)
// 中略
    // Taxonomiesページ
    | TaxonomiesMsg msg, TaxonomiesModel m ->
        match msg with
        | Taxonomies.Types.Msg.ApiError exn -> 
            model, Cmd.ofMsg (ApiError exn)
        | Taxonomies.Types.Msg.Notify notifyMsg -> 
            model, Cmd.ofMsg (NotificationMsg notifyMsg)
        | _ ->
            let (model', cmd) = Taxonomies.State.update msg m
            { model with PageModel = TaxonomiesModel model' }, Cmd.map TaxonomiesMsg cmd
    | TaxonomiesMsg _, _ ->
        model, Cmd.none

ログイン、ログアウトはTaxonomiesと同様、実行指示メッセージ&後処理メッセージの構成になっています。

ApiErrorメッセージはFable.Remotingでエラーが起きた場合の共通処理を行うメッセージです。
今回はログイン情報をブラウザのLocal Storageに格納するようにしているので、一度ログインすれば期限内なら再度ログインを要求されることは無いのですが、期限切れになると401(Unauthorized)になるのでログイン画面を再表示するようにしています。

LoggedInメッセージの処理で既に現在ページがTaxonomiesなら、Taxonomiesのモデルにトークンを設定しています。
また、これとは別に ProgramのモデルにUserDataとしてトークンを保持しています。

保持したトークンはTaxonomiesのページを選択した際のinit関数の引数として渡しています。

let urlUpdate (result: Page option) (model: App.Types.Model) =
    match result with
    | None ->
        Browser.console.error("Error parsing url: " + Browser.window.location.href)
        model, Navigation.modifyUrl (toPageUrl model.CurrentPage) 
    // 中略
    | Some Page.Taxonomies ->
        let jwt = 
            match model.UserData with 
            | Some user -> user.Token
            | None -> ""
        let m, cmd = Taxonomies.State.init jwt
        { model with PageModel = TaxonomiesModel m }, Cmd.map TaxonomiesMsg cmd

Taxonomiesの変更点

Programから渡ってきたトークンを保持するため、モデルにjwtプロパティが追加されています。

Server\pages\Taxonomies\Types.fs

type Model = {
  jwt: string
  listCriteria: ListCriteria
  dataList: seq<BlogModels.Taxonomy> option
  currentRec: BlogModels.Taxonomy option
}

渡ってきたトークンを使用して通信するのは以下のようになります。

Server\pages\Taxonomies\State.fs

let getApi jwt : ITaxonomyApi =
    let header = sprintf "Bearer %s" jwt
    Remoting.createApi()
    |> Remoting.withRouteBuilder Route.apiRouteBuilder
    |> Remoting.withAuthorizationHeader header
    |> Remoting.buildProxy<ITaxonomyApi>

Remoting.withAuthorizationHeader"Bearer <トークン>"という形式の文字列を指定しています。

getApi関数やgetList関数にjwtという引数が追加されたのですが、呼び出し部分は以下のように部分適用すればいいだけなのが関数型言語のいいところですね。

let update (msg : Msg) (model : Model) : Model * Cmd<Msg> =
    let jwt = model.jwt
    let api = getApi jwt        // 部分適用
    let getList = getList jwt   // 部分適用
    
// 中略

    match msg with
    // 一覧再読み込み
    | Reload -> 
        {model with currentRec = None}, getList model.listCriteria  // ← これまで通りの記述で呼び出し

// 略


webpack.config.jsには悩まされましたが、それ以外は特にトラブルも無く実装出来ました。
これまで一切、画面レイアウトのイメージを載せてきませんでしたが、要素を並べただけのちゃちな画面でハズカシイからです。ゴメンナサイ
どんだけちゃちな画面か気になる方は是非、コードをビルドして実行してみてください。

ひとまず、これでなんとか使えそうなレベルになったので、当ブログのDBに合わせて若干修正を入れてリリースしようと思います。
このシリーズもこれで完了です。

SAFE Stackについては割と気に入っているので、また別の記事にでもご紹介できればいいなと思います。