urbit/main/app/rodeo/core.hook
2014-12-11 07:49:01 -08:00

560 lines
20 KiB
Plaintext

::
:::: /hook/core/rodeo/app
::
/? 314
/- *radio
/+ twitter
::
::::
::
!:
=> |% :: data structures
++ house ,[%0 house-0] :: full state
++ house-any :: app history
$% [%0 house-0] :: 0: initial version
== ::
++ house-0 ::
$: parties=(map span party) :: conversations
general=(set bone) :: meta-subscribe
outbox=(pair ,@ud (map ,@ud thought)) :: urbit outbox
== ::
++ party :: a conversation
$: count=@ud :: (lent grams)
grams=(list telegram) :: all history
present=(map ship status) :: presence state
sequence=(map station ,@ud) :: stations heard
shape=config :: configuration
known=(map serial ,@ud) :: messages heard
guests=(map bone river) :: message followers
viewers=(set bone) :: presence followers
owners=(set bone) :: config followers
== ::
++ river (pair point point) :: stream definition
++ point :: stream endpoint
$% [%ud p=@ud] :: by number
[%da p=@da] :: by date
== ::
++ gift :: result
$% [%rust %radio-report report] :: refresh
[%mean ares] :: cancel
[%nice ~] :: accept
== ::
++ sign :: response
$% $: %e :: from %eyre
$% [%thou p=httr] :: HTTP response
== == ::
$: %g :: application
$% [%mean p=ares] :: cancel
[%nice ~] :: acknowledge
[%rust %radio-report report] :: refresh
== == == ::
++ move ,[p=bone q=(mold note gift)] :: all actions
++ hapt ,[p=ship q=path] :: app instance
++ note :: requests
$% $: %e :: through %eyre
$% [%them p=(unit hiss)] :: HTTP request
== == ::
$: %g :: network
$% [%mess p=hapt q=ship r=cage] :: message
[%nuke p=hapt q=ship] :: cancel
[%show p=hapt q=ship r=path] :: subscribe
== == == ::
--
|_ [hid=hide house]
++ ti
=+ ^= key
:* :- 'AP3G1t8ki6rPzeeAqdWCTw03F'
'VV784LPwZSaAxtF16RWWTnST4F85BHN8VqQKNyv7MprCkA0xZD'
:- '2821727326-RZGXSeTn7hCFQfJqR0ViivM3YYpu2O1M71gelBl'
'jW9VygFPOTsEK0WmrJDHYSoEnofOPdCE1oQRzueemVTl8'
==
|%
++ post
|= txt=cord ^- hiss
(~(stat-upda twit key lat.hid `@`eny.hid) [%status txt]~ ~)
--
::
++ ra :: transaction core
|_ [ost=bone moves=(list move)]
++ ra-abet :: resolve core
^- [(list move) _+>]
[(flop moves) +>]
::
++ ra-emil :: ra-emit move list
|= mol=(list move)
%_(+> moves (welp (flop mol) moves))
::
++ ra-emit :: emit a move
|= mov=move
%_(+> moves [mov moves])
::
++ ra-ever :: emit success
(ra-emit ost %give %nice ~)
::
++ ra-evil :: emit error
|= msg=cord
~& [%ra-evil msg]
(ra-emit ost %give %mean ~ msg ~)
::
++ ra-house :: emit stations
%+ ra-emit ost
:^ %give %rust %radio-report
:- %house
%- ~(gas in *(set span))
^- (list span)
(turn (~(tap by parties) ~) |=([a=span *] a))
::
++ ra-homes :: update stations
=+ gel=general
|- ^+ +>
?~ gel +>
=. +> $(gel l.gel)
=. +> $(gel r.gel)
ra-house(ost n.gel)
::
++ ra-apply :: apply command
|= [her=ship cod=command]
^+ +>
~& [%ra-apply cod]
?- -.cod
%design
?. =(her our.hid)
(ra-evil %radio-no-owner)
=+ pur=(~(get by parties) p.cod)
?~ q.cod
?~ pur
(ra-evil %radio-no-party)
=. +>.$ pa-abet:(~(pa-reform pa p.cod u.pur) *config)
=. +>.$ ra-homes
ra-ever(parties (~(del by parties) p.cod))
=+ poy=`(pair ,? party)`?~(pur [| *party] [& u.pur])
=. +>.$ pa-abet:(~(pa-reform pa p.cod q.poy) u.q.cod)
=. +>.$ ?:(p.poy +>.$ ra-homes)
ra-ever
::
%review ra-ever:(ra-think | her +.cod)
%publish ra-ever:(ra-think & her +.cod)
%ping
=+ pur=(~(get by parties) p.cod)
?~ pur
(ra-evil %radio-no-party)
=< ra-ever =< pa-abet
(~(pa-notify pa p.cod u.pur) her q.cod)
==
::
++ ra-friend :: %friend response
|= [man=span sih=sign]
^+ +>
=+ pur=(~(get by parties) man)
?~ pur ~& [%ra-friend-none man] +>.$
pa-abet:(~(pa-friend pa man u.pur) sih)
::
++ ra-repeat :: %repeat response
|= [num=@ud her=ship man=span sih=sign]
=+ oot=(~(get by q.outbox) num)
?~ oot ~& [%ra-repeat-none num] +>.$
=. q.outbox (~(del by q.outbox) num)
=. q.u.oot
%+ ~(put by q.u.oot)
[%& her man]
?+ sih !!
[%g %mean *] ~&([%radio-repeat-rejected num her man sih] %rejected)
[%g %nice ~] %received
==
(ra-think | her u.oot ~)
::
++ ra-cancel :: drop a bone
%_ .
general (~(del in general) ost)
parties
|- ^- (map span party)
?~ parties ~
:- :- p.n.parties
%= q.n.parties
guests (~(del by guests.q.n.parties) ost)
viewers (~(del in viewers.q.n.parties) ost)
owners (~(del in owners.q.n.parties) ost)
==
[$(parties l.parties) $(parties r.parties)]
==
::
++ ra-subscribe :: listen to
|= [her=ship pax=path]
^+ +>
:: ~& [%ra-subscribe pax]
?: ?=(~ pax)
ra-house(general (~(put in general) ost))
?: ?=([%am @ ~] pax)
=+ pur=(~(get by parties) i.t.pax)
?~ pur
~& [%bad-subscribe-party i.t.pax]
(ra-evil %radio-no-party)
pa-abet:(~(pa-watch pa i.t.pax u.pur) her)
?: ?=([%xm @ ~] pax)
=+ pur=(~(get by parties) i.t.pax)
?~ pur
~& [%bad-subscribe-party i.t.pax]
(ra-evil %radio-no-party)
pa-abet:(~(pa-master pa i.t.pax u.pur) her)
?. ?=([%fm *] pax)
~& [%bad-subscribe pax]
(ra-evil %radio-bad-path)
?. &(?=([@ *] t.pax) ((sane %tas) i.t.pax))
~& [%bad-subscribe pax]
(ra-evil %radio-bad-path)
=+ pur=(~(get by parties) i.t.pax)
?~ pur
~& [%bad-subscribe-party i.t.pax]
(ra-evil %radio-no-party)
pa-abet:(~(pa-listen pa i.t.pax u.pur) her t.t.pax)
::
++ ra-think :: publish/review
|= [pub=? her=ship tiz=(list thought)]
^+ +>
?~ tiz +>
$(tiz t.tiz, +> (ra-consume pub her i.tiz))
::
++ ra-consume :: consume thought
|= [pub=? her=ship tip=thought]
=+ aud=`(list (pair station delivery))`(~(tap by q.tip) ~)
|- ^+ +>.^$
?~ aud +>.^$
$(aud t.aud, +>.^$ (ra-conduct pub her p.i.aud tip))
::
++ ra-conduct :: thought to station
|= [pub=? her=ship tay=station tip=thought]
^+ +>
?- -.tay
%& ?: pub
=. her our.hid :: XX security!
?: =(her p.p.tay)
(ra-record q.p.tay p.p.tay tip)
(ra-transmit p.tay tip)
?: =(our.hid q.p.tay)
+>
(ra-record q.p.tay p.p.tay tip)
%| ?. pub +>
?- -.p.tay
%twitter
~& [%conduct-twitters]
=+ ^= msg
?+ -.q.r.tip !!
%say "@{(trip p.p.tay)} {<her>}: {(trip p.q.r.tip)}"
%own "@{(trip p.p.tay)} {<her>} {(trip p.q.r.tip)}"
==
?< (gth (lent msg) 140)
%+ ra-emit ost
:+ %pass /tweet/(scot %ud ost)
[%e [%them ~ (post:ti (crip msg))]]
== ==
::
++ ra-record :: add to party
|= [man=span gam=telegram]
^+ +>
=+ pur=(~(get by parties) man)
?~ pur
~& [%no-party man]
+>.$
pa-abet:(~(pa-learn pa man u.pur) gam)
::
++ ra-transmit :: send to neighbor
|= [cuz=cousin tip=thought]
^+ +>
=. +>
%+ ra-emit ost
:* %pass
/repeat/(scot %ud p.outbox)/(scot %p p.cuz)/[q.cuz]
%g
%mess
[p.cuz /rodeo]
our.hid
[%radio-command !>(`command`[%review tip ~])]
==
+>(p.outbox +(p.outbox), q.outbox (~(put by q.outbox) p.outbox tip))
::
++ pa :: party core
|_ $: man=span
party
==
++ pa-abet
^+ +>
+>(parties (~(put by parties) man `party`+<+))
::
++ pa-admire :: accept from
|= her=ship
^- ?
::?- -.cordon.shape
:: %& (~(has in p.cordon.shape) her)
:: %| !(~(has in p.cordon.shape) her)
::==
&
::
++ pa-watch :: watch presence
|= her=ship
?. (pa-admire her)
(pa-sauce ost [[%mean ~ %radio-watch-unauthorized ~] ~])
=. viewers (~(put in viewers) ost)
(pa-sauce ost [[%rust %radio-report %group present] ~])
::
++ pa-master :: hear config
|= her=ship
?. (pa-admire her)
(pa-sauce ost [[%mean ~ %radio-master-unauthorized ~] ~])
=. owners (~(put in owners) ost)
(pa-sauce ost [[%rust %radio-report %config shape] ~])
::
++ pa-display :: update presence
=+ vew=viewers
|- ^+ +>
?~ vew +>
=. +> $(vew l.vew)
=. +> $(vew r.vew)
(pa-sauce n.vew [[%rust %radio-report %group present] ~])
::
::
++ pa-monitor :: update config
=+ owe=owners
|- ^+ +>
?~ owe +>
=. +> $(owe l.owe)
=. +> $(owe r.owe)
~& [%monitor n.owe]
(pa-sauce n.owe [[%rust %radio-report %config shape] ~])
::
++ pa-friend :: subscribed update
|= sih=sign
^+ +>
?+ sih ~&([%radio-bad-friend sih] !!)
[%g %nice ~]
~& %pa-friend-nice
+>.$
::
[%g %rust %radio-report *]
?+ -.+>+.sih ~&([%radio-odd-friend sih] !!)
%grams
(pa-lesson q.+.+>+.sih)
==
==
::
++ pa-scrub :: pass forward
|= [ost=bone bub=(list (pair path note))]
%_ +>.$
moves
(welp (flop (turn bub |=(a=(pair path note) [ost %pass a]))) moves)
==
::
++ pa-sauce :: send backward
|= [ost=bone gub=(list gift)]
%_ +>.$
moves
(welp (flop (turn gub |=(a=gift [ost %give a]))) moves)
==
::
++ pa-abjure :: unsubscribe move
|= tal=(list station)
%+ pa-scrub 0
%+ turn tal
|= tay=station
?- -.tay
%| !!
%& :- /friend/nuke/[man]
[%g %nuke [p.p.tay /rodeo] our.hid]
==
::
++ pa-acquire :: subscribe to
|= tal=(list station)
%+ pa-scrub 0
%+ turn tal
|= tay=station
=+ num=(fall (~(get by sequence) tay) 0)
?- -.tay
%| !!
%& :- /friend/show/[man]
[%g %show [p.p.tay /rodeo] our.hid /fm/[q.p.tay]/(scot %ud num)]
==
::
++ pa-reform :: reconfigure, ugly
|= cof=config
=+ ^= dif ^- (pair (list station) (list station))
=+ old=`(list station)`(~(tap in sources.shape) ~)
=+ new=`(list station)`(~(tap in sources.cof) ~)
:- (skip new |=(a=station (~(has in sources.shape) a)))
(skip old |=(a=station (~(has in sources.cof) a)))
=. +>.$ (pa-acquire p.dif)
=. +>.$ (pa-abjure q.dif)
pa-monitor
::
++ pa-cancel :: unsubscribe from
^+ .
~& [%pa-cancel ost]
=. guests (~(del in guests) ost)
(pa-sauce ost [[%mean ~] ~])
::
++ pa-notify :: new presence
|= [her=ship per=presence]
^+ +>
pa-display(present (~(put by present) her [per lat.hid *human]))
::
++ pa-start :: start stream
|= riv=river
^+ +>
=- =. +>.$ (pa-sauce ost [[%rust %radio-report %grams q.lab r.lab] ~])
?: p.lab
(pa-sauce ost [[%mean ~] ~])
+>.$(guests (~(put by guests) ost riv))
^= lab
=+ [end=count gaz=grams dun=| zeg=*(list telegram)]
~& [%river riv]
|- ^- (trel ,? ,@ud (list telegram))
?~ gaz [dun end (flop zeg)]
?: ?- -.q.riv :: after the end
%ud (lte p.q.riv end)
%da (lte p.q.riv p.r.q.i.gaz)
==
$(end (dec end), gaz t.gaz)
?: ?- -.p.riv :: before the start
%ud (lth end p.p.riv)
%da (lth p.r.q.i.gaz p.p.riv)
==
[dun end (flop zeg)]
$(end (dec end), gaz t.gaz, zeg [i.gaz zeg])
::
++ pa-listen :: subscribe
|= [her=ship pax=path]
^+ +>
?. (pa-admire her)
(pa-sauce ost [[%mean ~ %radio-listen-unauthorized ~] ~])
=+ ^= ruv ^- (unit river)
?: ?=(~ pax)
`[[%ud count] [%da (dec (bex 128))]]
?: ?=([@ ~] pax)
=+ say=(slay i.pax)
?. ?=([~ %$ ?(%ud %da) @] say) ~
`[(point +>.say) [%da (dec (bex 128))]]
?. ?=([@ @ ~] pax) ~
=+ [say=(slay i.pax) den=(slay i.t.pax)]
?. ?=([~ %$ ?(%ud %da) @] say) ~
?. ?=([~ %$ ?(%ud %da) @] den) ~
`[(point +>.say) (point +>.den)]
?~ ruv
(pa-sauce ost [[%mean ~ %radio-malformed ~] ~])
(pa-start u.ruv)
::
++ pa-refresh :: update stream
|= [num=@ud gam=telegram]
~& [%pa-refresh num gam]
=+ ^= moy
|- ^- (pair (list bone) (list move))
?~ guests [~ ~]
=+ lef=$(guests l.guests)
=+ rit=$(guests r.guests)
=+ old=[p=(welp p.lef p.rit) q=(welp q.lef q.rit)]
?: ?- -.q.q.n.guests :: after the end
%ud (lte p.q.q.n.guests num)
%da (lte p.q.q.n.guests p.r.q.gam)
==
[[p.n.guests p.old] [[p.n.guests %give %mean ~] q.old]]
?: ?- -.p.q.n.guests :: before the start
%ud (gth p.p.q.n.guests num)
%da (gth p.p.q.n.guests p.r.q.gam)
==
old
:- p.old
[[p.n.guests %give %rust %radio-report %grams num gam ~] q.old]
=. moves (welp q.moy moves)
|- ^+ +>.^$
?~ p.moy +>.^$
$(p.moy t.p.moy, guests (~(del by guests) i.p.moy))
::
++ pa-lesson :: learn multiple
|= gaz=(list telegram)
^+ +>
?~ gaz +>
$(gaz t.gaz, +> (pa-learn i.gaz))
::
++ pa-learn :: learn message
|= gam=telegram
^+ +>
?. (pa-admire p.gam)
~& %pa-admire-rejected
+>.$
=. q.q.gam (~(put by q.q.gam) [%& our.hid man] %received)
=+ old=(~(get by known) p.q.gam)
?~ old
(pa-append gam)
(pa-revise u.old gam)
::
++ pa-append :: append new
|= gam=telegram
^+ +>
%+ %= pa-refresh
grams [gam grams]
count +(count)
known (~(put by known) p.q.gam count)
==
count
gam
::
++ pa-revise :: revise existing
|= [num=@ud gam=telegram]
=+ way=(sub count num)
=. grams (welp (scag (dec way) grams) [gam (slag way grams)])
(pa-refresh num gam)
--
--
++ peer
|= [ost=bone her=ship pax=path]
^- [(list move) _+>]
:: ~& [%rodeo-peer ost her pax]
ra-abet:(~(ra-subscribe ra ost ~) her pax)
::
++ poke-radio-command
|= [ost=bone her=ship cod=command]
^- [(list move) _+>]
:: ~& [%rodeo-poke-command her cod]
ra-abet:(~(ra-apply ra ost ~) her cod)
::
++ pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
:: ~& [%rodeo-pour ost pax sih]
:: ~& sih=sih
=+ sih=((hard sign) sih)
?+ pax ~& [%rodeo-strange-path pax] !!
[%tweet ^]
?> ?=(%thou +<.sih)
~& ?: =(2 (div p.p.sih 100))
[%tweet-ack p.p.sih]
~! sih
[%tweet-lost [p `(unit ,[@ @t])`r]:[p.sih .]]
[~ +>.$]
[%friend *]
?> ?=([@ @ ~] t.pax)
?. =(%show i.t.pax)
~& [%pour-friend-nuke-nuke pax]
[~ +>.$]
ra-abet:(~(ra-friend ra ost ~) i.t.t.pax sih)
::
[%repeat *]
?> ?=([@ @ @ ~] t.pax)
=+ [num her man]=[(slav %ud i.t.pax) (slav %p i.t.t.pax) i.t.t.t.pax]
ra-abet:(~(ra-repeat ra ost ~) num her man sih)
==
::
++ prep
|= old=(unit (unit house))
^- [(list move) _+>]
?> ?=(^ old)
?^ u.old
~& %rodeo-prep-old
[~ +>(+<+ u.u.old)]
~& %rodeo-prep-new
[~ +:ra-abet:(~(ra-apply ra 0 ~) our.hid %design %main `[~ [%| ~]])]
::
++ pull
|= ost=bone
^- [(list move) _+>]
~& [%rodeo-pull ost]
ra-abet:~(ra-cancel ra ost ~)
--