Implemented ;invite and ;banish for giving and denying permission to stations.

Read permissions for journals and mailboxes are constant: all and our team resp.
This commit is contained in:
Fang 2017-04-10 22:35:25 +02:00
parent 2a3dffc8c4
commit c33d5a04e5
4 changed files with 118 additions and 39 deletions

View File

@ -65,10 +65,8 @@
{$leave p/where} ::
{$say p/(list speech)} ::
{$eval p/cord q/twig} ::
{$invite p/knot q/(list partner)} :: whitelist add
{$banish p/knot q/(list partner)} :: blacklist add
{$block p/knot q/(list partner)} :: blacklist add
{$author p/knot q/(list partner)} :: whitelist add
{$invite p/knot q/(set ship)} :: give permission
{$banish p/knot q/(set ship)} :: deny permission
{$nick p/(unit ship) q/(unit cord)} ::
{$set p/knot} ::
{$unset p/knot} ::
@ -496,6 +494,9 @@
;~(pfix cen sym)
qut
==
::
;~((glue ace) (perk %invite ~) ;~(pfix cen sym) shiz)
;~((glue ace) (perk %banish ~) ;~(pfix cen sym) shiz)
::
;~(plug (perk %who ~) ;~(pose ;~(pfix ace para) (easy ~)))
;~(plug (perk %bind ~) ;~(pfix ace glyph) (punt ;~(pfix ace para)))
@ -1128,8 +1129,6 @@
$bind (bind +.job)
$invite (invite +.job)
$banish (banish +.job)
$author (author +.job)
$block (block +.job)
$create (create +.job)
$nick (nick +.job)
$set (wo-set +.job)
@ -1230,24 +1229,14 @@
(sh-note:(set-glyph cha u.pan) "bound {<cha>} {<u.pan>}")
::
++ invite :: %invite
|= {nom/knot tal/(list partner)}
|= {nom/knot sis/(set ship)}
^+ ..sh-work
!!
::
++ block :: %block
|= {nom/knot tal/(list partner)}
^+ ..sh-work
!!
::
++ author :: %author
|= {nom/knot tal/(list partner)}
^+ ..sh-work
!!
(sh-act %permit nom & sis)
::
++ banish :: %banish
|= {nom/knot tal/(list partner)}
|= {nom/knot sis/(set ship)}
^+ ..sh-work
!!
(sh-act %permit nom | sis)
::
++ create :: %create
|= {por/posture nom/knot txt/cord}
@ -1720,6 +1709,15 @@
$url url+(crip (earf p.sep))
$mor mor+(turn p.sep |=(speech ^$(sep +<)))
$fat [%mor $(sep q.sep) tan+(tr-rend-tors p.sep) ~]
$inv
:- %tan
:_ ~
:- %leaf
%+ weld
?: p.sep
"you have been invited to "
"you have been banished from "
~(sn-phat sn man q.sep)
$api
:- %tan
:_ ~
@ -1807,6 +1805,13 @@
(~(del in pal) [%& who (main who)])
(weld ~(te-pref te man pal) txt)
(weld " " txt)
::
$inv
%+ weld
?: p.sep
" invited you to "
" banished you from "
~(sn-phat sn man q.sep)
::
$app
(tr-chow 64 "[{(trip p.sep)}]: {(trip q.sep)}")

View File

@ -260,7 +260,12 @@
::
|= {man/knot con/config}
^+ +>
=+ pur=(fall (~(get by stories) man) *story)
=+ :- neu=!(~(has by stories) man)
pur=(fall (~(get by stories) man) *story)
::x if we just created the story, and it's invite only, make sure we're in.
=. con ::TODO =?
?. &(neu ?=(?($white $green) p.cordon.con)) con
con(q.cordon [our.hid ~ ~])
pa-abet:(~(pa-reform pa man ~ pur) con)
::
++ ra-unconfig
@ -594,19 +599,33 @@
::x story core, used for doing work on a story.
::x as always, an -abet arms is used for applying changes to the state.
::x ++pa-watch- arms get called by ++ra-subscribe to add a subscriber.
::x bones are used to identify subscribers (source event identifiers)
::x bones are used to identify subscribers (source event identifiers).
::
|_ ::x man: the knot identifying the story in stories.
::x story doesn't get a face because ease of use
::x coz: talk commands issued due to changes.
::x story doesn't get a face because ease of use.
::
$: man/knot
coz/(list command)
story
==
++ pa-abet
::x apply/fold changes back into the stories map.
::
^+ +>
+>(stories (~(put by stories) man `story`+<+))
=. +> +>(stories (~(put by stories) man `story`+<+>))
=. coz (flop coz)
|- ^+ +>+
?~ coz +>+
=. +>+ (ra-apply our.hid i.coz)
$(coz t.coz)
::
++ pa-tell
::x stores a talk command.
::
|= cod/command
^+ +>
+>(coz [cod coz])
::
++ pa-followers
^- (set bone)
@ -621,11 +640,12 @@
::
|= her/ship
^- ?
::?- -.cordon.shape
:: %& (~(has in p.cordon.shape) her)
:: %| !(~(has in p.cordon.shape) her)
::==
&
?- p.cordon.shape
$black !(~(has in q.cordon.shape) her) ::x channel, blacklist
$green (~(has in q.cordon.shape) her) ::x journal, whitelist
$brown !(~(has in q.cordon.shape) her) ::x mailbox, blacklist
$white (~(has in q.cordon.shape) her) ::x village, whitelist
==
::
++ pa-visible :: display to
::x checks her read permissions.
@ -633,10 +653,10 @@
|= her/ship
^- ?
?- p.cordon.shape
$black & ::x channel, all
$black !(~(has in q.cordon.shape) her) ::x channel, blacklist
$green & ::x journal, all
$brown (team our.hid her) ::x mailbox, our
$white (~(has in q.cordon.shape) her) ::x village, invite
$white (~(has in q.cordon.shape) her) ::x village, whitelist
==
::
++ pa-report :: update
@ -869,8 +889,8 @@
::
|= {her/ship pax/path}
^+ +>
?. (pa-admire her)
~& [%pa-first-grams-admire ~]
?. (pa-visible her)
~& [%pa-first-grams-visible ~]
(pa-sauce ost.hid [%quit ~]~)
::x find the range of grams to send.
=+ ^= ruv ^- (unit river)
@ -940,7 +960,6 @@
^+ +>
::x if author isn't allowed to write here, reject.
?. (pa-admire p.gam)
~& %pa-admire-rejected
+>.$
=. q.q.gam
::x if we are in the audience, mark us as having received it.
@ -981,6 +1000,56 @@
+>.$ :: no change
=. grams (welp (scag (dec way) grams) [gam (slag way grams)])
(pa-refresh num gam)
::
++ pa-unearth
::x find the bones in our follower list than belong to a ship in sis.
::
|= sis/(set ship)
^- (set bone)
%- ~(rep in sup.hid)
|= {{b/bone s/ship p/path} c/(set bone)}
?. ?& (~(has in sis) s)
(~(has by followers) b)
?=({@tas *} p)
=(i.p man)
==
c
(~(put in c) b)
::
++ pa-permit
::x invite/banish ships to/from this station.
::
|= {inv/? sis/(set ship)}
^+ +>
=/ white/? ?=(?($white $green) p.cordon.shape) :: whitelist?
=/ add/? =(inv white) :: add to list?
=. followers ::TODO =?
?: inv followers
%- ~(rep in (pa-unearth sis))
|= {b/bone f/_followers}
=. f ?~ f followers f ::TODO =?
(~(del by f) b)
=. +>.$
%- pa-tell
:- %publish
%- ~(rep in sis)
|= {s/ship t/(list thought)}
:_ t
=^ sir eny.hid (uniq eny.hid)
:+ sir :: serial
[[[%& s (main s)] [*envelope %pending]] ~ ~] :: audience
:+ now.hid ~ :: statement
[%inv inv [our.hid man]]
%- pa-reform
%= shape
q.cordon
%. sis
?: add
~& [%new-shape (~(uni in q.cordon.shape) sis)]
~(uni in q.cordon.shape)
~& [%new-shape (~(dif in q.cordon.shape) sis)]
~(dif in q.cordon.shape)
==
--
--
::

View File

@ -42,4 +42,9 @@
:+ (shaf %thot eny)
[[[%& our (main our)] [*envelope %pending]] ~ ~]
[now *bouquet [%app dap (crip ~(ram re i.mes))]]
::
++ uniq
|= eny/@uvJ
^- {@uvH _eny}
[(shaf %serial eny) (shax eny)]
--

View File

@ -53,10 +53,10 @@
$% {$twitter p/@t} :: twitter
== ::
++ posture :: security posture
$? $black :: channel
$white :: village
$green :: journal
$brown :: mailbox
$? $black :: channel, blacklist
$white :: village, whitelist
$green :: journal, author list
$brown :: mailbox, our + black
== ::
++ presence ?($gone $hear $talk) :: status type
++ register (pair atlas (map partner atlas)) :: ping me, ping srcs
@ -89,7 +89,7 @@
:: ...that's probably what %gall is, but then why do we have $ext?
{$ext p/@tas q/*} :: extended action
{$fat p/torso q/speech} :: attachment
:: {$inv p/station} :: invite to station
{$inv p/? q/station} :: inv/ban for station
{$url p/purf} :: parsed url
{$ire p/serial q/speech} :: in-reply-to
{$lin p/? q/@t} :: no/@ text line