[WIP] Make up some basic identity challenge

apps/fistful/src/ff_identity.erl

@@ -15,19 +15,56 @@
 
 %% API
 
--type party()       :: ff_party:id().
+-type id(T)             :: T.
--type provider()    :: ff_provider:provider().
+-type timestamp()       :: machinery:timestamp().
--type contract()    :: ff_party:contract().
+-type party()           :: ff_party:id().
+-type provider()        :: ff_provider:provider().
+-type contract()        :: ff_party:contract().
+-type class()           :: ff_identity_class:class().
+-type level()           :: ff_identity_class:level().
+-type challenge_class() :: ff_identity_class:challenge_class().
 
 -type identity() :: #{
+    id           := id(_),
     party        := party(),
     provider     := provider(),
     class        := class(),
-    contract     => contract()
+    level        := level(),
+    contract     => contract(),
+    challenges   => #{id(_) => challenge()}
 }.
 
+-type challenge() :: #{
+    identity     := id(_),
+    class        := challenge_class(),
+    proofs       := [proof()],
+    status       := challenge_status()
+}.
+
+-type proof() ::
+    _TODO.
+
+-type challenge_status() ::
+    pending                              |
+    {completed , challenge_completion()} |
+    {failed    , challenge_failure()}    |
+    cancelled                            .
+
+-type challenge_completion() :: #{
+    valid_until  => timestamp()
+}.
+
+-type challenge_failure() ::
+    _TODO.
+
 -type ev() ::
-    {contract_set, contract()}.
+    {contract_set      , contract()}            |
+    {level_changed     , level()}               |
+    {challenge_started , id(_), challenge()}    |
+    {challenge         , id(_), challenge_ev()} .
+
+-type challenge_ev() ::
+    {status_changed    , challenge_status()}.
 
 -type outcome() ::
     [ev()].
@@ -35,42 +72,7 @@
 -export_type([identity/0]).
 -export_type([ev/0]).
 
-%% TODO
+-export([id/1]).
-%%  - Factor out into dedicated module
-
--type class_id()              :: binary().
--type contract_template_ref() :: dmsl_domain_thrift:'ContractTemplateRef'().
-
--type class() :: #{
-    contract_template_ref := contract_template_ref(),
-    initial_level_id      := level_id(),
-    levels                := #{level_id() => level()},
-    challenges            := #{challenge_id() => challenge()}
-}.
-
--type level_id()         :: binary().
--type contractor_level() :: dmsl_domain_thrift:'ContractorIdentificationLevel'().
-
--type level() :: #{
-    name             := binary(),
-    contractor_level := contractor_level()
-}.
-
--type challenge_id() :: binary().
-
--type challenge() :: #{
-    name             := binary(),
-    base_level_id    := level_id(),
-    target_level_id  := level_id()
-}.
-
--export_type([class_id/0]).
--export_type([class/0]).
--export_type([level_id/0]).
--export_type([level/0]).
--export_type([challenge_id/0]).
--export_type([challenge/0]).
-
 -export([provider/1]).
 -export([party/1]).
 -export([class/1]).
@@ -80,27 +82,33 @@
 
 -export([create/3]).
 -export([setup_contract/1]).
--export([start_challenge/2]).
+-export([start_challenge/4]).
+
+-export([challenge/2]).
+-export([challenge_status/1]).
+
+-export([poll_challenge_completion/2]).
 
 -export([apply_event/2]).
 
-%%
-
--export([contract_template/1]).
--export([initial_level/1]).
-
 %% Pipeline
 
--import(ff_pipeline, [do/1, unwrap/1]).
+-import(ff_pipeline, [do/1, unwrap/1, unwrap/2, expect/2, flip/1, valid/2]).
 
 %% Accessors
 
+-spec id(identity()) -> id(_).
+id(#{id := V}) -> V.
+
 -spec provider(identity()) -> provider().
 provider(#{provider := V}) -> V.
 
 -spec class(identity()) -> class().
 class(#{class := V})    -> V.
 
+-spec level(identity()) -> level().
+level(#{level := V})    -> V.
+
 -spec party(identity()) -> party().
 party(#{party := V})    -> V.
 
@@ -118,30 +126,6 @@ contract(V) ->
 is_accessible(Identity) ->
     ff_party:is_accessible(party(Identity)).
 
-%% Class
-
--spec contract_template(class()) -> contract_template_ref().
-contract_template(#{contract_template_ref := V}) -> V.
-
--spec initial_level(class()) ->
-    level().
-
-initial_level(#{initial_level_id := V} = Identity) ->
-    {ok, Level} = level(V, Identity),
-    Level.
-
--spec level(level_id(), class()) ->
-    {ok, level()} |
-    {error, notfound}.
-
-level(ID, #{levels := Levels}) ->
-    ff_map:find(ID, Levels).
-
-%% Level
-
--spec contractor_level(level()) -> contractor_level().
-contractor_level(#{contractor_level := V}) -> V.
-
 %% Constructor
 
 -spec create(party(), provider(), class()) ->
@@ -152,7 +136,8 @@ create(Party, Provider, Class) ->
         #{
             party    => Party,
             provider => Provider,
-            class    => Class
+            class    => Class,
+            level    => ff_identity_class:initial_level(Class)
         }
     end).
 
@@ -167,20 +152,78 @@ setup_contract(Identity) ->
         Class    = class(Identity),
         Contract = unwrap(ff_party:create_contract(party(Identity), #{
             payinst           => ff_provider:payinst(provider(Identity)),
-            contract_template => contract_template(Class),
+            contract_template => ff_identity_class:contract_template(Class),
-            contractor_level  => contractor_level(initial_level(Class))
+            contractor_level  => ff_identity_class:contractor_level(level(Identity))
         })),
         [{contract_set, Contract}]
     end).
 
--spec start_challenge(level(), identity()) ->
+%%
+
+-spec start_challenge(id(_), challenge_class(), [proof()], identity()) ->
     {ok, outcome()} |
     {error,
-        {level, invalid}
+        exists |
+        {level, ff_identity_class:level()} |
+        _IdentityClassError
     }.
 
-start_challenge(Level, Identity) ->
+start_challenge(ChallengeID, ChallengeClass, Proofs, Identity) ->
-    oops.
+    do(fun () ->
+        Class     = class(Identity),
+        BaseLevel = ff_identity_class:base_level(ChallengeClass, Class),
+        notfound  = expect(exists, flip(challenge(ChallengeID, Identity))),
+        ok        = unwrap(level, valid(BaseLevel, level(Identity))),
+        Challenge = unwrap(create_challenge(ChallengeID, id(Identity), ChallengeClass, Proofs)),
+        [{challenge_started, ChallengeID, Challenge}]
+    end).
+
+create_challenge(_ID, IdentityID, Class, Proofs) ->
+    do(fun () ->
+        #{
+            identity => IdentityID,
+            class    => Class,
+            proofs   => Proofs,
+            status   => pending
+        }
+    end).
+
+-spec challenge(id(_), identity()) ->
+    {ok, challenge()} |
+    {error, notfound}.
+
+challenge(ChallengeID, #{challenges := Challenges}) ->
+    ff_map:find(ChallengeID, Challenges).
+
+-spec challenge_status(challenge()) ->
+    challenge_status().
+
+challenge_status(#{challenge_status := V}) ->
+    V.
+
+-spec challenge_class(challenge()) ->
+    challenge_class().
+
+challenge_class(#{class := V}) ->
+    V.
+
+-spec poll_challenge_completion(id(_), challenge()) ->
+    {ok, outcome()} |
+    {error,
+        notfound |
+        challenge_status()
+    }.
+
+poll_challenge_completion(ID, Identity) ->
+    do(fun () ->
+        Challenge   = unwrap(challenge(ID, Identity)),
+        ok          = unwrap(valid(pending, challenge_status(Challenge))),
+        TargetLevel = ff_identity_class:target_level(challenge_class(Challenge)),
+        [
+            {challenge, ID, {status_changed, {completed, #{}}}},
+            {level_changed, TargetLevel}
+        ]
+    end).
 
 %%
 
@@ -188,4 +231,20 @@ start_challenge(Level, Identity) ->
     identity().
 
 apply_event({contract_set, C}, Identity) ->
-    Identity#{contract => C}.
+    Identity#{contract => C};
+apply_event({level_changed, L}, Identity) ->
+    Identity#{level := L};
+apply_event({challenge_started, ID, C}, Identity) ->
+    Cs = maps:get(challenges, Identity, #{}),
+    Identity#{
+        challenges => Cs#{ID => C}
+    };
+apply_event({challenge, ID, Ev}, Identity = #{challenges := Cs}) ->
+    Identity#{
+        challenges := Cs#{
+            ID := apply_challenge_event(Ev, maps:get(ID, Cs))
+        }
+    }.
+
+apply_challenge_event({status_changed, S}, Challenge) ->
+    Challenge#{status := S}.

apps/fistful/src/ff_identity_class.erl

@@ -0,0 +1,127 @@
+%%%
+%%% Identity class
+%%%
+
+-module(ff_identity_class).
+
+%%
+
+-type id() :: binary().
+
+-type class() :: #{
+    contract_template_ref := contract_template_ref(),
+    initial_level_id      := level_id(),
+    levels                := #{level_id() => level()},
+    challenge_classes     := #{challenge_class_id() => challenge_class()}
+}.
+
+-type contract_template_ref() ::
+    dmsl_domain_thrift:'ContractTemplateRef'().
+
+%%
+
+-type level_id() :: binary().
+-type level() :: #{
+    name             := binary(),
+    contractor_level := contractor_level()
+}.
+
+-type contractor_level() ::
+    dmsl_domain_thrift:'ContractorIdentificationLevel'().
+
+%%
+
+-type challenge_class_id() :: binary().
+
+-type challenge_class() :: #{
+    name             := binary(),
+    base_level_id    := level_id(),
+    target_level_id  := level_id()
+}.
+
+-export([name/1]).
+-export([contract_template/1]).
+-export([initial_level/1]).
+-export([level/2]).
+-export([level_name/1]).
+-export([contractor_level/1]).
+-export([challenge_class/2]).
+-export([base_level/2]).
+-export([target_level/2]).
+-export([challenge_class_name/1]).
+
+-export_type([id/0]).
+-export_type([class/0]).
+-export_type([level_id/0]).
+-export_type([level/0]).
+-export_type([challenge_class_id/0]).
+-export_type([challenge_class/0]).
+
+%% Class
+
+-spec name(class()) ->
+    binary().
+
+name(#{name := V}) ->
+    V.
+
+-spec contract_template(class()) ->
+    contract_template_ref().
+
+contract_template(#{contract_template_ref := V}) ->
+    V.
+
+-spec initial_level(class()) ->
+    level().
+
+initial_level(#{initial_level_id := V} = Class) ->
+    {ok, Level} = level(V, Class), Level.
+
+-spec level(level_id(), class()) ->
+    {ok, level()} |
+    {error, notfound}.
+
+level(ID, #{levels := Levels}) ->
+    ff_map:find(ID, Levels).
+
+-spec challenge_class(challenge_class_id(), class()) ->
+    {ok, challenge_class()} |
+    {error, notfound}.
+
+challenge_class(ID, #{challenge_classs := ChallengeClasses}) ->
+    ff_map:find(ID, ChallengeClasses).
+
+%% Level
+
+-spec level_name(level()) ->
+    binary().
+
+level_name(#{name := V}) ->
+    V.
+
+-spec contractor_level(level()) ->
+    contractor_level().
+
+contractor_level(#{contractor_level := V}) ->
+    V.
+
+%% Challenge
+
+-spec challenge_class_name(challenge_class()) ->
+    binary().
+
+challenge_class_name(#{name := V}) ->
+    V.
+
+-spec base_level(challenge_class(), class()) ->
+    level().
+
+base_level(#{base_level_id := ID}, Class) ->
+    {ok, Level} = level(ID, Class), Level.
+
+-spec target_level(challenge_class(), class()) ->
+    level().
+
+target_level(#{target_level_id := ID}, Class) ->
+    {ok, Level} = level(ID, Class),
+    Level.

apps/fistful/src/ff_identity_machine.erl

@@ -22,7 +22,8 @@
 -type ctx()       :: ff_ctx:ctx().
 
 -type activity() ::
-    idle.
+    {challenge, challenge_id()} |
+    undefined                   .
 
 -type st()        :: #{
     activity      := activity(),
@@ -31,6 +32,9 @@
     ctx           => ctx()
 }.
 
+-type challenge_id() ::
+    machinery:id().
+
 -export_type([id/0]).
 
 -export([identity/1]).
@@ -38,6 +42,7 @@
 
 -export([create/3]).
 -export([get/1]).
+-export([start_challenge/2]).
 
 %% Machinery
 
@@ -49,7 +54,7 @@
 
 %% Pipeline
 
--import(ff_pipeline, [do/1, unwrap/1, unwrap/2]).
+-import(ff_pipeline, [do/1, do/2, unwrap/1, unwrap/2]).
 
 %%
 
@@ -96,6 +101,26 @@ get(ID) ->
         identity(collapse(unwrap(machinery:get(?NS, ID, backend()))))
     end).
 
+-type challenge_params() :: #{
+    id     := challenge_id(),
+    class  := ff_identity_class:challenge_class_id(),
+    proofs := [ff_identity:proof()]
+}.
+
+-spec start_challenge(id(), challenge_params()) ->
+    ok |
+    {error,
+        notfound |
+        {challenge,
+            {pending, challenge_id()} |
+            {class, notfound} |
+            _IdentityChallengeError
+        }
+    }.
+
+start_challenge(ID, Params) ->
+    machinery:call(?NS, ID, {start_challenge, Params}, backend()).
+
 backend() ->
     fistful:backend(?NS).
 
@@ -124,17 +149,63 @@ init({Events, Ctx}, #{}, _, _Opts) ->
         aux_state => #{ctx => Ctx}
     }.
 
+%%
+
 -spec process_timeout(machine(), _, handler_opts()) ->
     result().
 
-process_timeout(_Machine, _, _Opts) ->
+process_timeout(Machine, _, _Opts) ->
-    #{}.
+    process_activity(collapse(Machine)).
 
--spec process_call(_, machine(), _, handler_opts()) ->
+process_activity(#{activity := {challenge, ChallengeID}} = St) ->
-    {ok, result()}.
+    Identity = identity(St),
+    {ok, Events} = ff_identity:poll_challenge_completion(ChallengeID, Identity),
+    case Events of
+        [] ->
+            #{action => set_poll_timer(St)};
+        _Some ->
+            #{events => emit_ts_events(Events)}
+    end.
 
-process_call(_CallArgs, #{}, _, _Opts) ->
+set_poll_timer(St) ->
-    {ok, #{}}.
+    Now = machinery_time:now(),
+    Timeout = erlang:max(1, machinery_time:interval(Now, updated(St))),
+    {set_timer, {timeout, Timeout}}.
+
+%%
+
+-type call() ::
+    {start_challenge, challenge_params()}.
+
+-spec process_call(call(), machine(), _, handler_opts()) ->
+    {_TODO, result()}.
+
+process_call({start_challenge, Params}, Machine, _, _Opts) ->
+    do_start_challenge(Params, collapse(Machine)).
+
+do_start_challenge(Params, #{activity := undefined} = St) ->
+    Identity = identity(St),
+    handle_result(do(challenge, fun () ->
+        #{
+            id     := ChallengeID,
+            class  := ChallengeClassID,
+            proofs := Proofs
+        } = Params,
+        Class          = ff_identity:class(Identity),
+        ChallengeClass = unwrap(class, ff_identity_class:challenge_class(ChallengeClassID, Class)),
+        Events         = unwrap(ff_identity:start_challenge(ChallengeID, ChallengeClass, Proofs, Identity)),
+        #{
+            events => emit_ts_events(Events),
+            action => continue
+        }
+    end));
+do_start_challenge(_Params, #{activity := {challenge, ChallengeID}}) ->
+    handle_result({error, {challenge, {pending, ChallengeID}}}).
+
+handle_result({ok, R}) ->
+    {ok, R};
+handle_result({error, _} = Error) ->
+    {Error, #{}}.
 
 %%
 
@@ -154,7 +225,22 @@ merge_event_body({created, Identity}, St) ->
         identity => Identity
     };
 merge_event_body(IdentityEv, St = #{identity := Identity}) ->
-    St#{identity := ff_identity:apply_event(IdentityEv, Identity)}.
+    St#{
+        activity := deduce_activity(IdentityEv),
+        identity := ff_identity:apply_event(IdentityEv, Identity)
+    }.
+
+deduce_activity({contract_set, _}) ->
+    undefined;
+deduce_activity({level_changed, _}) ->
+    undefined;
+deduce_activity({challenge_created, ChallengeID, _}) ->
+    {challenge, ChallengeID};
+deduce_activity({challenge, _ChallengeID, {status_changed, _}}) ->
+    undefined.
+
+updated(#{times := {_, V}}) ->
+    V.
 
 %%
 

apps/fistful/src/ff_provider.erl

@@ -83,15 +83,15 @@ get(ID) ->
                     end,
                     maps:get(levels, ICC)
                 ),
-                Challenges = maps:map(
+                ChallengeClasses = maps:map(
-                    fun (ChallengeID, CC) ->
+                    fun (ChallengeClassID, CCC) ->
-                        CName         = maps:get(name, CC, ChallengeID),
+                        CCName        = maps:get(name, CCC, ChallengeClassID),
-                        BaseLevelID   = maps:get(base, CC),
+                        BaseLevelID   = maps:get(base, CCC),
-                        TargetLevelID = maps:get(target, CC),
+                        TargetLevelID = maps:get(target, CCC),
                         {ok, _}       = maps:find(BaseLevelID, Levels),
                         {ok, _}       = maps:find(TargetLevelID, Levels),
                         #{
-                            name            => CName,
+                            name            => CCName,
                             base_level_id   => BaseLevelID,
                             target_level_id => TargetLevelID
                         }
@@ -103,7 +103,7 @@ get(ID) ->
                     contract_template_ref => ContractTemplateRef,
                     initial_level_id      => maps:get(initial_level, ICC),
                     levels                => Levels,
-                    challenges            => Challenges
+                    challenge_classes     => ChallengeClasses
                 }
             end,
             maps:get(identity_classes, C)