shrub/pkg/arvo/app/invite-store.hoon

::  invite-store [landscape]
/-  *invite-store
/+  res=resource, default-agent, dbug
|%
+$  card  card:agent:gall
+$  versioned-state
  $%  state-0
      state-1
  ==
::
+$  invitatory-0  (map serial invite-0)
+$  invite-0
  $:  =ship           ::  ship to subscribe to upon accepting invite
      app=@tas        ::  app to subscribe to upon accepting invite
      =path           ::  path to subscribe to upon accepting invite
      recipient=ship  ::  recipient to receive invite
      text=cord       ::  text to describe the invite
  ==
::
+$  state-0  [%0 invites=(map path invitatory-0)]
+$  state-1  [%1 =invites]
--
::
=|  state-1
=*  state  -
%-  agent:dbug
^-  agent:gall
::
|_  =bowl:gall
+*  this      .
    def       ~(. (default-agent this %|) bowl)
::
++  on-init   on-init:def
++  on-save   !>(state)
++  on-load
  |=  old-vase=vase
  =/  old  !<(versioned-state old-vase)
  ?:  ?=(%1 -.old)
   `this(state old)
  :-  ~
  %=  this
      state
    :-  %1
    %-  ~(gas by *^invites)
    %+  turn  ~(tap by invites.old)
    |=  [=path =invitatory-0]
    ^-  [resource invitatory]
    ?>  ?=([@ @ ~] path)
    :-  [(slav %p i.path) i.t.path]
    %-  ~(gas by *invitatory)
    %+  turn  ~(tap by invitatory-0)
    |=  [uid=serial =invite-0]
    ^-  [serial invite]
    :-  uid
    :*  ship.invite-0
        app.invite-0
        (de-path:res path.invite-0)
        recipient.invite-0
        text.invite-0
    ==
  ==
::
++  on-agent  on-agent:def
++  on-arvo   on-arvo:def
++  on-leave  on-leave:def
++  on-fail   on-fail:def
::
++  on-watch
  |=  =path
  ^-  (quip card _this)
  ?>  (team:title our.bowl src.bowl)
  =/  cards=(list card)
    ?+    path  (on-watch:def path)
        [%all ~]      [%give %fact ~ %invite-update !>([%initial invites])]~
        [%updates ~]  ~
        [%invitatory *]
      =/  inv=invitatory  (~(got by invites) (de-path:res t.path))
      [%give %fact ~ %invite-update !>([%invitatory inv])]~
    ==
  [cards this]
::
++  on-poke
  |=  [=mark =vase]
  ^-  (quip card _this)
  |^
  ?>  (team:title our.bowl src.bowl)
  =^  cards  state
    ?+  mark  (on-poke:def mark vase)
      %invite-action  (poke-invite-action !<(invite-action vase))
    ==
  [cards this]
  ::
  ++  poke-invite-action
    |=  action=invite-action
    ^-  (quip card _state)
    ?-  -.action
        %create   (handle-create +.action)
        %delete   (handle-delete +.action)
        %invite   (handle-invite +.action)
        %accept   (handle-accept +.action)
        %decline  (handle-decline +.action)
    ==
  ::
  ++  handle-create
    |=  =resource
    ^-  (quip card _state)
    ?:  (~(has by invites) resource)
      [~ state]
    :-  (send-diff resource [%create resource])
    state(invites (~(put by invites) resource *invitatory))
  ::
  ++  handle-delete
    |=  =resource
    ^-  (quip card _state)
    ?.  (~(has by invites) resource)
      [~ state]
    :-  (send-diff resource [%delete resource])
    state(invites (~(del by invites) resource))
  ::
  ++  handle-invite
    |=  [=resource uid=serial =invite]
    ^-  (quip card _state)
    ?.  (~(has by invites) resource)
      [~ state]
    =/  container  (~(got by invites) resource)
    =.  uid  (sham eny.bowl)
    =.  container  (~(put by container) uid invite)
    :-  (send-diff resource [%invite resource uid invite])
    state(invites (~(put by invites) resource container))
  ::
  ++  handle-accept
    |=  [=resource uid=serial]
    ^-  (quip card _state)
    ?.  (~(has by invites) resource)
      [~ state]
    =/  container  (~(got by invites) resource)
    =/  invite  (~(get by container) uid)
    ?~  invite
      [~ state]
    =.  container  (~(del by container) uid)
    :-  (send-diff resource [%accepted resource uid u.invite])
    state(invites (~(put by invites) resource container))
  ::
  ++  handle-decline
    |=  [=resource uid=serial]
    ^-  (quip card _state)
    ?.  (~(has by invites) resource)
      [~ state]
    =/  container  (~(got by invites) resource)
    =/  invite  (~(get by container) uid)
    ?~  invite
      [~ state]
    =.  container  (~(del by container) uid)
    :-  (send-diff resource [%decline resource uid])
    state(invites (~(put by invites) resource container))
  ::
  ++  update-subscribers
    |=  [=path upd=invite-update]
    ^-  card
    [%give %fact ~[path] %invite-update !>(upd)]
  ::
  ++  send-diff
    |=  [=resource upd=invite-update]
    ^-  (list card)
    :~  (update-subscribers /all upd)
        (update-subscribers /updates upd)
        (update-subscribers [%invitatory (en-path:res resource)] upd)
    ==
  --
::
++  on-peek
  |=  =path
  ^-  (unit (unit cage))
  |^
  ?+  path  (on-peek:def path)
    [%x %all ~]         [~ ~ %noun !>(invites)]
    [%x %invitatory *]  (peek-x-invitatory t.t.path)
    [%x %invite *]      (peek-x-invite t.t.path)
  ==
  ::
  ++  peek-x-invitatory
    |=  pax=^path
    ^-  (unit (unit cage))
    ?~  pax
      ~
    =/  invitatory=(unit invitatory)
      (~(get by invites) (de-path:res pax))
    [~ ~ %noun !>(invitatory)]
  ::
  ++  peek-x-invite
    |=  pax=^path
    ^-  (unit (unit cage))
    ::  /:path/:uid
    =/  pas  (flop pax)
    ?~  pas
      ~
    =/  uid=serial  (slav %uv i.pas)
    =.  pax  (scag (dec (lent pax)) `(list @ta)`pax)
    =/  invitatory=(unit invitatory)
      (~(get by invites) (de-path:res pax))
    ?~  invitatory
      ~
    =/  invite=(unit invite)  (~(get by u.invitatory) uid)
    [~ ~ %noun !>(invite)]
  --
--