shrub/pkg/landscape/app/group-view.hoon

/-  view-sur=group-view, group-store, *group, metadata=metadata-store, hark=hark-store
/+  default-agent, agentio, mdl=metadata,
    resource, dbug, grpl=group, conl=contact, verb
|%
++  card  card:agent:gall
::
+$   base-state-0
  joining=(map rid=resource [=ship =progress:view])
::
+$   base-state-1
  joining=(map rid=resource request:view)
::
+$  state-zero
  [%0 base-state-0]
::
+$  state-one
  [%1 base-state-0]
::
+$  state-two
  [%2 base-state-1]
::
+$  versioned-state
  $%  state-zero
      state-one
      state-two
  ==
::
++  view  view-sur
--
=|  state-two
=*  state  -
::
%-  agent:dbug
%+  verb  |
^-  agent:gall
=<
|_  =bowl:gall
+*  this  .
    def   ~(. (default-agent this %|) bowl)
    gc    ~(. +> bowl)
    io    ~(. agentio bowl)
++  on-init  
  `this
++  on-save
  !>(state)
::
++  on-load
  |=  =vase
  =+  !<(old=versioned-state vase)
  =|  cards=(list card)
  |^
  ?-  -.old
    %2  [cards this(state old)]
    %1  $(-.old %2, +.old (base-state-to-1 +.old))
    %0  $(-.old %1, cards :_(cards (poke-self:pass:io noun+!>(%cleanup))))
  ==
  ::
  ++  base-state-to-1
    |=  base-state-0
    %-  ~(gas by *(map resource request:view))
    (turn ~(tap by joining) request-to-1)
  ::
  ++  request-to-1
    |=  [rid=resource =ship =progress:view]
    ^-  [resource request:view]
    :-  rid
    %*  .  *request:view
      started   now.bowl
      hidden    %.n
      ship      ship
      progress  progress
    ==
  --
::
++  on-poke
  |=  [=mark =vase]
  ^-  (quip card _this)
  ?:  ?=(%noun mark)
    =^  cards  state
      poke-noun:gc
    [cards this]
  ?.  ?=(%group-view-action mark)
    (on-poke:def mark vase)
  =+  !<(=action:view vase)
  =^  cards  state
    ?+  -.action  !!
      %join  jn-abet:(jn-start:join:gc +.action)
      %hide  (hide:gc +.action)
    ==
  [cards this]
::
++  on-watch
  |=  =path
  ?+  path  (on-watch:def path)
      [%all ~]  
    :_  this
    :_  ~
    %+  fact:io  
      :-  %group-view-update
      !>(`update:view`[%initial joining])
    ~
  ==
::
++  on-peek  on-peek:def
::
++  on-agent
  |=  [=wire =sign:agent:gall]
  =^  cards  state
    ?+    wire  `state
        [%join %ship @ @ *]
      =/  rid
        (de-path:resource t.wire)
      ?.  (~(has by joining) rid)  `state
      jn-abet:(jn-agent:(jn-abed:join:gc rid) t.t.t.t.wire sign)
    ==
  [cards this]
::
++  on-arvo  on-arvo:def
++  on-leave  on-leave:def
++  on-fail  on-fail:def
--
|_  =bowl:gall
++  met  ~(. mdl bowl)
++  grp  ~(. grpl bowl)
++  io   ~(. agentio bowl)
++  con  ~(. conl bowl)
++  hide
  |=  rid=resource
  ^-  (quip card _state)
  =/  =request:view  (~(got by joining) rid)
  ?:  ?=(final:view progress.request)
    =.  joining  (~(del by joining) rid)
    :_  state
    (fact:io group-view-update+!>(`update:view`[%initial joining]) /all ~)^~
  :-  (fact:io group-view-update+!>([%hide rid]) /all ~)^~
  state(joining (~(put by joining) rid request(hidden %.y)))
::
++  has-joined
  |=  rid=resource
  =-  ?=(^ -)
  ?~  grp=(peek-group:met %groups rid)
    (peek-group:met %graph rid)
  grp
::
++  poke-noun
  ^-  (quip card _state)
  =;  new-joining=(map resource request:view)
    `state(joining new-joining)
  %+  roll  ~(tap by joining)
  |=  [[rid=resource =request:view] out=_joining]
  ?.  (has-joined rid)  out
  (~(del by out) rid)
::
++  join
  |_  [rid=resource =ship cards=(list card)]
  ++  jn-core  .
  ++  emit-many
    |=  crds=(list card)
    jn-core(cards (weld (flop crds) cards))
  ::
  ++  emit
    |=  =card
    jn-core(cards [card cards])
  ::
  ++  tx-progress
    |=  =progress:view
    =.  joining
      (~(jab by joining) rid |=(req=request:view req(progress progress)))
    =;  =cage
      (emit (fact:io cage /all tx+(en-path:resource rid) ~))
    group-view-update+!>([%progress rid progress]) 
  ::
  ++  pass
    =>  |%
        ++  pull-action
          pull-hook-action+!>([%add ship rid])
        --
    |%
    ::
    ++  watch-md      (watch-our:(jn-pass-io /md) %metadata-store /updates)
    ++  watch-groups  (watch-our:(jn-pass-io /groups) %group-store /groups)
    ++  watch-md-nacks  (watch-our:(jn-pass-io /md-nacks) %metadata-pull-hook /nack)
    ++  watch-grp-nacks  (watch-our:(jn-pass-io /grp-nacks) %group-pull-hook /nack)
    ::
    ++  add-us 
      %+  poke:(jn-pass-io /add)
        [ship %group-push-hook]
      group-update-0+!>([%add-members rid (silt our.bowl ~)])
    ::
    ++  pull-groups  
      (poke-our:(jn-pass-io /poke) %group-pull-hook pull-action)
    ++  pull-md
      (poke-our:(jn-pass-io /poke) %metadata-pull-hook pull-action)
    ++  pull-co
      (poke-our:(jn-pass-io /poke) %contact-pull-hook pull-action)
    ::
    ++  share-co
      %+  poke:(jn-pass-io /poke)
        [entity.rid %contact-push-hook]
      [%contact-share !>([%share our.bowl])]
    ::
    ++  pull-gra
      |=  gr=resource
      (poke-our:(jn-pass-io /poke) %graph-pull-hook pull-hook-action+!>([%add entity .]:gr))
    --
  ++  jn-pass-io
    |=  pax=path
    ~(. pass:io (welp join+(en-path:resource rid) pax))
  :: 
  ++  jn-abed
    |=  r=resource
    =/  =request:view
      (~(got by joining) r)
    jn-core(rid r, ship ship.request)
  ::
  ++  jn-abet
    ^-  (quip card _state)
    [(flop cards) state]
  ::
  ++  jn-start
    |=  [rid=resource =^ship]
    ^+  jn-core
    ?>  ?=  $@(~ [~ %done])
            (bind (~(get by joining) rid) |=(request:view progress))
    =.  joining
      (~(put by joining) rid [%.n now.bowl ship %start])
    =.  jn-core
      (jn-abed rid)
    =.  jn-core
      %-  emit
      %+  fact:io
        group-view-update+!>([%started rid (~(got by joining) rid)])
      ~[/all]
    ?<  ~|("already joined {<rid>}" (has-joined rid)) 
    =.  jn-core  (emit add-us:pass)
    =.  jn-core  (tx-progress %start)
    =>  (emit watch-md:pass)
    =>  (emit watch-groups:pass)
    =>  (emit watch-grp-nacks:pass)
    (emit watch-md-nacks:pass)
  ::
  ++  jn-agent
    |=  [=wire =sign:agent:gall]
    ^+  jn-core
    |^  
    ?+    -.wire  ~|("bad %join wire" !!)
        %add  :: join group
      ?>  ?=(%poke-ack -.sign)
      ?^  p.sign
        (cleanup %no-perms)
      =.  jn-core
        (tx-progress %added)
      (emit pull-groups:pass)
    ::
        %groups
      ?+  -.sign  !!
        %fact  (groups-fact +.sign)
        %watch-ack  (ack +.sign)
        %kick  (emit watch-groups:pass)
      ==
    ::
        %poke
      ?>  ?=(%poke-ack -.sign)
      (ack +.sign)
    ::
        %md
      ?+  -.sign  !!
        %fact  (md-fact +.sign)
        %watch-ack  (ack +.sign)
        %kick  (emit watch-md:pass)
      ==
    ::
        %pull-graphs
      ?>  ?=(%poke-ack -.sign)
      %-  cleanup
      ?^(p.sign %strange %done)
    ::
        %md-nacks
      ?+  -.sign  !!
        %watch-ack  (ack +.sign)
        %kick  (emit watch-md-nacks:pass)
      ::
          %fact
        ?.  =(%resource p.cage.sign)  jn-core
        =+  !<(nack=resource q.cage.sign)
        ?.  =(nack rid)  jn-core
        (cleanup %strange)
      ==
    ::
        %grp-nacks
      ?+  -.sign  !!
        %watch-ack  (ack +.sign)
        %kick       (emit watch-grp-nacks:pass)
      ::
          %fact
        ?.  =(%resource p.cage.sign)  jn-core
        =+  !<(nack=resource q.cage.sign)
        ?.  =(nack rid)  jn-core
        (cleanup %strange)
      ==
    ==
    ::
    ++  groups-fact
      |=  =cage
      ?.  ?=(%group-update-0 p.cage)  jn-core
      =+  !<(=update:group-store q.cage)
      ?.  ?=(%initial-group -.update)  jn-core
      ?.  =(rid resource.update)  jn-core
      =.  jn-core  (emit pull-md:pass)
      =.  jn-core  (emit pull-co:pass)
      ?:  scry-is-public:con
        (emit share-co:pass)
      jn-core
    ::
    ++  md-fact
      |=  [=mark =vase]
      ?.  ?=(%metadata-update-2 mark)    jn-core
      =+  !<(=update:metadata vase)
      ?.  ?=(%initial-group -.update)  jn-core
      ?.  =(group.update rid)          jn-core
      |^  ^+  jn-core
      =/  feed  feed-rid
      =.  jn-core  (cleanup %done)
      =/  hidden  hidden:(need (scry-group:grp rid))
      =?  jn-core  ?&(!hidden ?=(^ feed))
        %-  emit
        (pull-gra:pass (need feed))
      =?  jn-core  !hidden
        %-  emit-many
        (turn graphs pull-gra:pass)
      jn-core
      ::
      ++  feed-rid
        ^-  (unit resource)
        =/  list-md=(list [=md-resource:metadata =association:metadata])
          %+  skim  ~(tap by associations.update)
          |=  [=md-resource:metadata =association:metadata]
          =(app-name.md-resource %groups)
        ?~  list-md  ~
        =*  metadatum  metadatum.association.i.list-md
        ?.  ?&  ?=(%group -.config.metadatum)
                ?=([~ ~ *] feed.config.metadatum)
            ==
          ~
        `resource.u.u.feed.config.metadatum
      ::
      ++  graphs
        ^-  (list resource)
        %+  murn  ~(tap by associations.update)
        |=  [=md-resource:metadata =association:metadata]
        ?.  =(app-name.md-resource %graph)  ~
        `resource.md-resource
      --
    ::
    ++  ack
      |=  err=(unit tang)
      ?~  err  jn-core
      %-  (slog u.err)
      (cleanup %strange)
    ::
    ++  notify
      %-  emit
      %+  poke-our:(jn-pass-io /hark)  %hark-store
      =-  hark-action+!>(-)
      ^-  action:hark
      |^ 
      [%add-note bin body]
      ++  bin
        ^-  bin:hark
        [/ [q.byk.bowl /join/(scot %p entity.rid)/[name.rid]]]
      ++  title
        |=  [name=@t rest=@t]
        text/(rap 3 'Joining group: "' name '" ' rest ~)
      ++  body
        ^-  body:hark
        =/  =request:view  (~(got by joining) rid)
        ?>  ?=(final:view progress.request)
        =/  name  (rap 3 (scot %p entity.rid) '/' name.rid ~)
        ?-  progress.request
        ::
            %done
          =/  =metadatum:metadata  (need (peek-metadatum:met %groups rid))
          :*  ~[(title title.metadatum 'succeeded')]
              ~
              now.bowl
              /
              /groups/(scot %p entity.rid)/[name.rid]
          ==
        ::
            %strange
          :*  ~[(title name 'errored unexpectedly')]
              ~
              now.bowl
              /
              /
          ==
        ::
            %no-perms
          :*  ~[(title name 'failed, you are not permitted to join the group')]
              ~
              now.bowl
              /
              /
          ==
        ==
      --
    ::
    ++  cleanup
      |=  =progress:view
      =.  jn-core
        (tx-progress progress)
      =.  jn-core
        (emit (leave-our:(jn-pass-io /groups) %group-store))
      =.  jn-core
        (emit (leave-our:(jn-pass-io /grp-nacks) %group-pull-hook))
      =.  jn-core
        (emit (leave-our:(jn-pass-io /md) %metadata-store))
      =.  jn-core
        (emit (leave-our:(jn-pass-io /md-nacks) %metadata-pull-hook))
      =/  =request:view  (~(got by joining) rid)
      =?  jn-core  (lte (sub now.bowl started.request) ~s30)  
        notify
      =.  joining  (~(del by joining) rid)
      jn-core
    --
  --
--