urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-14 11:08:45 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'upstream/master' into new-stdlib

Browse Source
This commit is contained in:
Elliot Glaysher 2017-11-05 15:43:21 -08:00
commit 9878c0d61b
104 changed files with 16128 additions and 34775 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
LICENSE.txt
View File

@ -1,6 +1,6 @@
The MIT License (MIT)
Copyright (c) 2015 Urbit
Copyright (c) 2017 Urbit
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
@ -18,4 +18,4 @@ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
SOFTWARE.

6
app/ask.hoon
View File

@ -7,7 +7,7 @@
|%
++ card
$% {$diff $sole-effect sole-effect}
{$poke wire {ship $hood} $womb-invite {cord invite}:womb}
{$poke wire {ship $hood} $womb-invite {cord:womb invite:womb}}
==
++ invited ?($new $sent $ignored)
++ email @t
@ -81,7 +81,7 @@
::
++ poke-sole-action
|= act/sole-action
^- (quip {bone card} +>)
^- (quip {bone card} _+>)
=/ som (~(got by sos) ost.bow)
?- -.act
$clr `+>.$
@ -154,7 +154,7 @@
^- card
:^ %poke /invite/(scot %t ask) [(need wom) %hood]
:- %womb-invite
^- {cord invite}:womb
^- [cord:womb invite:womb]
=+ inv=(scot %uv (end 7 1 eny.bow))
[inv [ask 1 0 "You have been invited to Urbit: {(trip inv)}" ""]]
--

2
app/curl.hoon
View File

@ -2,6 +2,8 @@
:::: /hoon/curl/app
::
/? 310
/+ old-zuse
=, old-zuse
::
|_ {{^ ^ ost/@ ^} $~}
++ poke |*(a/{mark *} :_(+> [ost %hiss / `~ %wain a]~))

10
app/dojo.hoon
View File

@ -7,6 +7,7 @@
[. sole]
=, space:userlib
=, format
!:
:: :: ::
:::: :: ::::
:: :: ::
@ -53,6 +54,7 @@
{$ge p/dojo-model} :: generator
{$dv p/path} :: core from source
{$ex p/twig} :: hoon expression
{$sa p/mark} :: example mark value
{$as p/mark q/dojo-source} :: simple transmute
{$do p/twig q/dojo-source} :: gate apply
{$tu p/(list dojo-source)} :: tuple
@ -126,7 +128,7 @@
|= {gol/goal mod/dojo-model} ^- dojo-command
[[%poke gol] [0 [%ge mod(q.p [q.gol q.p.mod])]]]
::
++ dp-command-line ;~(sfix dp-command (just '\0a'))
++ dp-command-line ;~(sfix dp-command (star ace) (just '\0a'))
++ dp-variable :: %verb or %brev
|* {sym/rule src/rule}
%+ cook
@ -269,6 +271,7 @@
==
++ dp-value :: ++dojo-source
;~ pose
(stag %sa ;~(pfix tar pam sym))
(stag %ex dp-twig)
(stag %tu (ifix [sel ser] (most ace dp-source)))
==
@ -360,6 +363,7 @@
?- -.bul
$ex [bul +>.$]
$dv [bul +>.$]
$sa [bul +>.$]
$as =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
$do =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
$ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$])
@ -1137,6 +1141,7 @@
$^ {dy-shown dy-shown}
$% {$ur (unit knot) purl:eyre}
{$dv path}
{$sa mark}
{$as mark dy-shown}
{$do twig dy-shown}
{$ge path (list dy-shown) (map term (unit dy-shown))}
@ -1149,7 +1154,7 @@
=+ `{@ bil/dojo-build}`a
|- ^- dy-shown
?- -.bil
$?($ur $dv) bil
$?($ur $dv $sa) bil
$ex ?. ?=({$cltr *} p.bil) p.bil
|- ^- twig
?~ p.p.bil !!
@ -1315,6 +1320,7 @@
$ge (dy-silk-config (dy-cage p.p.p.bil) q.p.bil)
$dv [/hand [%core he-beak (flop p.bil)]]
$ex [/hand (dy-mare p.bil)]
$sa [/hand [%bunt p.bil]]
$as [/hand [%cast p.bil [%$ (dy-cage p.q.bil)]]]
$do [/hand [%call (dy-mare p.bil) [%$ (dy-cage p.q.bil)]]]
$tu :- /hand

11
app/gh.hoon
View File

@ -19,6 +19,7 @@
::
::
=, html
=, eyre
=> |%
++ move (pair bone card)
++ card
@ -175,7 +176,7 @@
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care *} pax)
?> ?=({care:clay *} pax)
:_ +>.$ :_ ~
(read:connector ost.hid (places %read pax) i.pax t.pax)
::
@ -185,7 +186,7 @@
++ sigh-httr
|= {way/wire res/httr}
^- {(list move) _+>.$}
?. ?=({$read care @ *} way)
?. ?=({$read care:clay @ *} way)
~& res=res
[~ +>.$]
=* style i.way
@ -278,14 +279,14 @@
:* %+ scan
=+ [(trip i.pax) (trip i.t.pax)]
"https://api.github.com/repos/{-<}/{->}/hooks"
auri:urlp
auri:de-purl
%post ~ ~
%- as-octt %- en-json %- pairs:enjs :~
%- as-octt:mimes %- en-json %- pairs:enjs:format :~
name+s+%web
active+b+&
events+a+~[s+event] ::(turn `(list ,@t)`t.t.pax |=(a=@t s/a))
:- %config
%- jobe :~
%- pairs:enjs:format :~
=+ =+ clean-event
"http://107.170.195.5:8443/~/to/gh/gh-{-}.json?anon&wire=/"
[%url s+(crip -)]

74
app/gmail.hoon
View File

@ -41,17 +41,20 @@
==
++ card
$% {$diff subscription-result}
{$hiss wire {$~ $~} $httr {$hiss hiss}}
{$hiss wire {$~ $~} $httr {$hiss hiss:eyre}}
==
++ easy-ot |*({key/@t parser/fist:jo} =+(jo (ot [key parser] ~)))
++ easy-ot
=, dejs-soft:format
|* {key/@t parser/fist}
(ot [key parser] ~)
++ sifo-google
|= a/cord ^- cord
=; fel (crip (scan (sifo a) fel))
(star ;~(pose (cold '-' (just '+')) (cold '_' (just '/')) next))
|= a/cord ^- cord
=; fel (crip (scan (en-base64 a) fel))
(star ;~(pose (cold '-' (just '+')) (cold '_' (just '/')) next))
++ ofis-google
|= a/cord ^- cord
=; fel (ofis (crip (rash a fel)))
(star ;~(pose (cold '+' (just '-')) (cold '/' (just '_')) next))
|= a/cord ^- cord
=; fel (de-base64 (crip (rash a fel)))
(star ;~(pose (cold '+' (just '-')) (cold '/' (just '_')) next))
--
::
=, gall
@ -73,7 +76,7 @@
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care ^} pax) :: assert %u
?> ?=({care:clay ^} pax) :: assert %u
=> (help i.pax i.t.pax t.t.pax)
=> scry
%= make-move
@ -93,11 +96,11 @@
[;~((glue pat) . .)]:(cook crip (plus ;~(less pat next))) :: /[^@]+@[^@]+/
::
(crip tyl)
(of-wain (turn mez crip))
(of-wain:format (turn mez crip))
==
::
++ poke-gmail-req
|= $: method/meth endpoint/path quy/quay
|= $: method/meth:eyre endpoint/path quy/quay:eyre
mes/message:rfc
:: label-req:gmail-label
==
@ -107,13 +110,14 @@
:_ +>.$ :_ ~
^- move
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
^- purl
^- purl:eyre
:+ [& ~ [%& /com/googleapis/www]]
[~ gmail+v1+users+me+`valid-get-endpoint`endpoint]
`quay`[[%alt %json] ~]
`quay:eyre`[[%alt %json] ~]
::
:+ method `math`(malt ~[content-type+['application/json']~])
=+ hoon-json-object=(joba %raw s+(sifo-google (message-to-rfc822:rfc mes)))
:+ method `math:eyre`(malt ~[content-type+['application/json']~])
=/ hoon-json-object
(frond:enjs:format %raw s+(sifo-google (message-to-rfc822:rfc mes)))
=+ request-body=(as-octt (en-json hoon-json-object))
(some request-body)
::(some (en-json label-req-to-json:gmail-label label-req:gmail-label ~)) XX
@ -124,10 +128,10 @@
::
++ sigh-httr
|= {wir/wire res/httr}
|= {wir/wire res/httr:eyre}
^- {(list move) _+>.$}
:: ~& wir+wir
?. ?=({care @ @ @ *} wir)
?. ?=({care:clay @ @ @ *} wir)
:: pokes don't return anything
~& sigh-poke+p.res
[~ +>.$]
@ -137,13 +141,14 @@
:+ ost.hid %diff
?+ i.wir null+~
$x
=, enjs:format
?~ r.res
json+(jobe err+s+%empty-response code+(jone p.res) ~)
json+(pairs err+s+%empty-response code+(numb p.res) ~)
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
json+(jobe err+s+%bad-json code+(jone p.res) body+s+q.u.r.res ~)
json+(pairs err+s+%bad-json code+(numb p.res) body+s+q.u.r.res ~)
?. =(2 (div p.res 100))
json+(jobe err+s+%request-rejected code+(jone p.res) msg+u.jon ~)
json+(pairs err+s+%request-rejected code+(numb p.res) msg+u.jon ~)
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
@ -153,7 +158,8 @@
=+ switch=t.t.t.t.wir
?+ switch [%json `json`u.jon]
{$messages $~}
=+ new-mezes=((ot messages+(ar (ot id+so 'threadId'^so ~)) ~):jo u.jon)
=/ new-mezes
((ot messages+(ar (ot id+so 'threadId'^so ~)) ~):dejs-soft:format u.jon)
::%+ turn new-mezes
::|= id
::?< ?=($~ new-mezes)
@ -173,7 +179,7 @@
~| u.jon
=- (need (reparse u.jon))
^= reparse
=+ jo
=, dejs-soft:format
=+ ^= from-and-subject
|= a/(map @t @t) ^- {@t @t}
[(~(got by a) 'From') (~(got by a) 'Subject')]
@ -193,30 +199,30 @@
::=+ body==+(jo ((ot body+(easy-ot 'body' (easy-ot 'data' so))) parsed-message))
[%message headers]
==
=+ dir=((om:jo some) u.jon)
?~ dir json+(jobe err+s+%no-children ~)
::
=+ dir=((om:dejs-soft:format some) u.jon)
?~ dir json+(pairs:enjs:format err+s+%no-children ~)
=+ new-jon=(~(get by u.dir) i.arg)
`subscription-result`$(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
:: redo with next argument
::
$y
?~ r.res
~& [err+s+%empty-response code+(jone p.res)]
~& [err+s+%empty-response code+(numb:enjs:format p.res)]
arch+*arch
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
~& [err+s+%bad-json code+(jone p.res) body+s+q.u.r.res]
~& [err+s+%bad-json code+(numb:enjs:format p.res) body+s+q.u.r.res]
arch+*arch
?. =(2 (div p.res 100))
~& [err+s+%request-rejected code+(jone p.res) msg+u.jon]
~& [err+s+%request-rejected code+(numb:enjs:format p.res) msg+u.jon]
arch+*arch
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
::
|- ^- subscription-result
=+ dir=((om:jo some) u.jon)
=+ dir=((om:dejs-soft:format some) u.jon)
?~ dir
[%arch `(shax (jam u.jon)) ~]
?~ arg
@ -232,11 +238,11 @@
:_ +>.$ ~
::
++ help
|= {ren/care style/@tas pax/path}
|= {ren/care:clay style/@tas pax/path}
=^ query pax
=+ xap=(flop pax)
?~ xap [~ ~]
=+ query=(rush i.xap ;~(pfix wut yquy:urlp))
=+ query=(rush i.xap ;~(pfix wut yquy:de-purl))
?~ query [~ pax]
[u.query (flop t.xap)]
=^ arg pax ~|(pax [+ -]:(split pax))
@ -251,13 +257,13 @@
::
++ endpoint-to-purl
|= endpoint/path
^- purl
^- purl:eyre
%+ scan
"https://www.googleapis.com/gmail/v1/users/me{<`path`endpoint>}"
auri:urlp
auri:de-purl
:: Send an HTTP req
++ send-http
|= hiz/hiss
|= hiz/hiss:eyre
^+ +>
=+ wir=`wire`[ren (scot %ud count) (scot %uv (jam arg)) style pax]
=+ new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]

12
app/hood.hoon
View File

@ -7,6 +7,7 @@
:: :: ::
:::: :: ::
:: :: ::
!:
=> |% :: module boilerplate
++ hood-old ::
{?($0 $1) lac/(map @tas hood-part-old)} ::
@ -60,7 +61,7 @@
::
++ ably :: save part
|* {(list) hood-part}
[(flop +<-) %_(+> lac (~(put by lac) +<+< `hood-part`+<+))]
[(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))]
:: :: ::
:::: :: ::
:: :: ::
@ -140,6 +141,7 @@
++ poke-helm-send-hi (wrap poke-send-hi):from-helm
++ poke-helm-send-ask (wrap poke-send-ask):from-helm
++ poke-helm-verb (wrap poke-verb):from-helm
++ poke-helm-nuke (wrap poke-nuke):from-helm
++ poke-helm-begin (wrap poke-begin):from-helm
++ poke-helm-spawn (wrap poke-spawn):from-helm
++ poke-hood-sync (wrap poke-sync):from-kiln
@ -156,6 +158,7 @@
++ poke-kiln-sync (wrap poke-sync):from-kiln
++ poke-kiln-syncs (wrap poke-syncs):from-kiln
++ poke-kiln-start-autoload (wrap poke-start-autoload):from-kiln
++ poke-kiln-wipe-ford (wrap poke-wipe-ford):from-kiln
++ poke-kiln-autoload (wrap poke-autoload):from-kiln
++ poke-kiln-overload (wrap poke-overload):from-kiln
++ poke-kiln-unmount (wrap poke-unmount):from-kiln
@ -165,10 +168,15 @@
++ poke-womb-obey (wrap poke-obey):from-womb
++ poke-womb-bonus (wrap poke-bonus):from-womb
++ poke-womb-claim (wrap poke-claim):from-womb
++ poke-womb-do-ticket (wrap poke-do-ticket):from-womb
++ poke-womb-do-claim (wrap poke-do-claim):from-womb
++ poke-womb-rekey (wrap poke-rekey):from-womb
++ poke-womb-report (wrap poke-report):from-womb
++ poke-womb-manage (wrap poke-manage):from-womb
++ poke-womb-recycle (wrap poke-recycle):from-womb
++ poke-womb-manage-old-key (wrap poke-manage-old-key):from-womb
++ poke-womb-release (wrap poke-release):from-womb
++ poke-womb-release-ships (wrap poke-release-ships):from-womb
++ poke-womb-reinvite (wrap poke-reinvite):from-womb
++ poke-womb-replay-log (wrap poke-replay-log):from-womb
++ poke-write-sec-atom (wrap poke-sec-atom):from-write
@ -179,7 +187,7 @@
++ poke-write-plan-account (wrap poke-plan-account):from-write
++ poke-write-tree (wrap poke-tree):from-write
++ poke-write-wipe (wrap poke-wipe):from-write
++ poke-wyll (wrap poke-wyll):from-helm
++ poke-will (wrap poke-will):from-helm
++ quit-drum-phat (wrap quit-phat):from-drum
++ reap-drum-phat (wrap reap-phat):from-drum
++ woot-helm (wrap take-woot):from-helm

98
app/talk.hoon
View File

@ -8,16 +8,18 @@
=, space:userlib
=, format
=, unity
!:
::
::::
::
[. talk sole]
=> |% :: data structures
++ house {$5 house-5} :: full state
++ house {$6 house-6} :: full state
++ house-any :: app history
$% {$3 house-3} :: 3: talk
{$4 house-4} :: 4: talk
{$5 house-5} :: 5: talk
{$6 house-6} :: 5: talk
== ::
++ house-3 ::
%+ cork house-4 |= house-4 :: modern house with
@ -26,6 +28,9 @@
%+ cork house-5 |= house-5 :: modern house with
+<(shells (~(run by shells) shell-4)) :: no settings
++ house-5 ::
%+ cork house-6 |= house-6 :: modern house with
+<(shells (~(run by shells) shell-5)) :: auto-audience
++ house-6 ::
$: stories/(map knot story) :: conversations
general/(set bone) :: meta-subscribe
outbox/(pair @ud (map @ud thought)) :: urbit outbox
@ -55,14 +60,20 @@
man/knot :: mailbox
count/@ud :: messages shown
say/sole-share :: console state
active/(unit (set partner)) :: active targets
passive/(set partner) :: passive targets
active/{$~ u/(set partner)} :: active targets
$passive-deprecated :: passive targets
owners/register :: presence mirror
harbor/(map knot (pair posture cord)) :: stations mirror
system/cabal :: config mirror
settings/(set knot) :: frontend settings
== ::
++ shell-4 (cork shell |=(shell +<(|8 &9.+<))) :: missing settings
++ shell-5 :: has passive
%+ cork shell |= shell ::
%= +< ::
&6 passive=*(set partner) ::
active *(unit (set partner)) ::
== ::
++ shell-4 (cork shell-5 |=(shell-5 +<(|8 &9.+<))):: missing settings
++ river (pair point point) :: stream definition
++ point :: stream endpoint
$% {$ud p/@ud} :: by number
@ -386,9 +397,7 @@
%+ sh-fact %pro
:+ & %talk-line
^- tape
=+ ^= rew ^- (pair (pair @t @t) (set partner))
?~ active.she
[['(' ')'] passive.she]
=/ rew/(pair (pair @t @t) (set partner))
[['[' ']'] u.active.she]
=+ cha=(~(get by nik) q.rew)
?^ cha ~[u.cha ' ']
@ -399,9 +408,10 @@
++ sh-pact :: update active aud
|= lix/(set partner)
^+ +>
=+ act=?~(lix ~ `(sh-pare lix))
?: =(active.she act) +>.$
sh-prod(active.she act)
=+ act=(sh-pare lix)
?~ act ~|(%no-audience !!)
?: =(active.she `act) +>.$
sh-prod(active.she `act)
::
++ sh-pare :: adjust target list
|= paz/(set partner)
@ -416,21 +426,6 @@
(~(has in sources.shape:(~(got by stories) man.she)) `partner`n.paz)
==
::
++ sh-pass :: passive from aud
|= aud/audience
%- sh-poss
%- ~(gas in *(set partner))
(turn ~(tap by aud) |=({a/partner *} a))
::
++ sh-poss :: passive update
|= lix/(set partner)
?^ buf.say.she
+>.$
=+ sap=(sh-pare lix)
?: =(sap passive.she)
+>.$
sh-prod(passive.she sap)
::
++ sh-pest :: report listen
|= tay/partner
^+ +>
@ -438,20 +433,12 @@
=+ sib=(~(get by ham.system.she) `station`p.tay)
?. |(?=($~ sib) !?=($white p.cordon.u.sib))
+>.$
(sh-poss [tay ~ ~])
(sh-pact [tay ~ ~])
::
++ sh-rend :: print on one line
|= gam/telegram
=+ lin=~(tr-line tr man.she settings.she gam)
=+ nom=(scag 7 (cite:title our.hid))
%. q.q.gam
=< sh-pass
%. [%txt lin]
?: ?& (~(has in settings.she) %notify)
(gth (fall (find nom lin) 0) 15)
==
sh-fact:(sh-fact %bel ~)
sh-fact
(sh-fact %txt lin)
::
++ sh-numb :: print msg number
|= num/@ud
@ -974,7 +961,7 @@
++ sh-whom :: current audience
^- audience
%- ~(gas by *audience)
%+ turn ~(tap in ?~(active.she passive.she u.active.she))
%+ turn ~(tap in u.active.she)
|=(a/partner [a *envelope %pending])
::
++ sh-tell :: add command
@ -1091,7 +1078,7 @@
::
++ bind :: %bind
|= {cha/char pan/(unit (set partner))} ^+ ..sh-work
?~ pan $(pan [~ ?~(active.she passive.she u.active.she)])
?~ pan $(pan [~ u.active.she])
=+ ole=(~(get by nik) u.pan)
?: =(ole [~ cha]) ..sh-work
(sh-note:(set-glyph cha u.pan) "bound {<cha>} {<u.pan>}")
@ -1263,7 +1250,7 @@
^+ +>
?- -.act
$det (sh-stir +.act)
$clr (sh-pact ~)
$clr ..sh-sole :: (sh-pact ~) :: XX clear to PM-to-self?
$ret sh-done
==
::
@ -1469,7 +1456,7 @@
|= {man/knot pax/path sup/path txt/@t} ^+ +>
=+ nam=?~(sup "" (trip i.sup)) :: file name
=+ fra=(crip (time-to-id now.hid)) :: url fragment
%^ ra-consume &
%^ ra-consume |
src.hid
:* (shaf %comt eny.hid)
`audience`[[`partner`[%& our.hid man] *envelope %pending] ~ ~]
@ -1545,10 +1532,14 @@
++ ra-console :: console subscribe
|= {her/ship pax/path}
^+ +>
=+ man=`knot`?~(pax (main her) ?>(?=($~ t.pax) i.pax))
=+ ^= she ^- shell
[her man 0 *sole-share ~ [[%& our.hid man] ~ ~] [~ ~] ~ *cabal ~]
sh-abet:~(sh-peer sh ~ she)
=/ man/knot
?+ pax !!
$~ (main her)
{@ta $~} i.pax
==
=/ she/shell
%*(. *shell her her, man man, active `(si:nl [%& our.hid man] ~))
sh-abet:~(sh-peer sh ~ `shell`she)
::
++ ra-subscribe :: listen to
|= {her/ship pax/path}
@ -1702,6 +1693,7 @@
::
++ pa-report-group :: update presence
|= vew/(set bone)
?: [no-presence=&] +>.$
%^ pa-report vew %group
:- %- ~(run by locals)
|=({@ a/status} a)
@ -1945,7 +1937,18 @@
++ pa-revise :: revise existing
|= {num/@ud gam/telegram}
=+ way=(sub count num)
?: =(gam (snag (dec way) grams))
=/ ole (snag (dec way) grams)
=. q.q.gam
::REVIEW let old %received override different "new" states, in an
:: attempt to stem a stale-update loop
::
%- ~(urn by q.q.gam)
|= {a/partner b/{envelope dev/delivery}} ^- {envelope delivery}
?: ?=({$~ ^ $received} (~(get by q.q.ole) a))
b(dev %received)
b
::
?: =(gam ole)
+>.$ :: no change
=. grams (welp (scag (dec way) grams) [gam (slag way grams)])
(pa-refresh num gam)
@ -2393,9 +2396,12 @@
ra-abet:ra-init:ra
|-
?- -.u.old
$5 [~ ..prep(+<+ u.old)]
$6 [~ ..prep(+<+ u.old)]
$5 =< ^$(-.u.old %6, shells.u.old (~(run by shells.u.old) .))
|= shell-5 ^- shell
+<(passive %passive-deprecated, active ?^(active active `passive))
$4 =< ^$(-.u.old %5, shells.u.old (~(run by shells.u.old) .))
|=(shell-4 `shell`+<(system [system settings=*(set knot)]))
|=(shell-4 `shell-5`+<(system [system settings=*(set knot)]))
$3 =< ^$(-.u.old %4, stories.u.old (~(run by stories.u.old) .))
|=(story-3 `story`+<(cabalers [cabalers glyphers=*(set bone)]))
==

2
app/time.hoon
View File

@ -2,6 +2,8 @@
:::: /hoon/time/app
::
/? 310
/+ old-zuse
=, old-zuse
|%
++ card {$wait wire @da}
--

30
app/twit.hoon
View File

@ -39,7 +39,7 @@
++ move {bone card}
++ card :: arvo request
$? gift
$% {$hiss wire (unit iden) api-call} :: api request
$% {$hiss wire (unit user:eyre) api-call} :: api request
{$poke wire app-message} ::
{$wait wire p/@da} :: timeout
== ==
@ -48,7 +48,7 @@
++ response-mark ?($twit-post $twit-feed $twit-cred) :: sigh options
++ app-message
$? {{ship $talk} $talk-command command:talk} :: chat message
{{ship $hood} $write-plan-account iden plan-acct} :: registration
{{ship $hood} $write-plan-account user:eyre plan-acct} :: registration
== ::
++ sign :: arvo response
$% {$e $thou p/httr} :: HTTP result
@ -66,10 +66,10 @@
::
::::
::
|_ {bowl axle}
|_ {bowl:gall axle}
::
++ prep
|= a/(unit axle) ^- (quip move +>)
|= a/(unit axle) ^- (quip move _+>)
?^ a [~ +>(+<+ u.a)]
(peer-scry-x /cred)
::
@ -105,13 +105,13 @@
mof
::
++ poke-twit-do :: recieve request
|= {usr/iden act/command} ^+ done
|= {usr/user:eyre act/command} ^+ done
?- -.act
$post
=. out (~(put by out) p.act %& usr q.act)
%+ wait-new /peer/home/[usr]
=+ req=[%twit-req `endpoint`update+[%status q.act]~ ~]
[ost %hiss post+(dray ~[%uv] p.act) `usr %twit-post req]~
[ost %hiss post+(dray:wired ~[%uv] p.act) `usr %twit-post req]~
==
::
++ wake-peer
@ -145,7 +145,7 @@
::
++ sigh-twit-post-post :: status acknowledged
|= {wir/wire rep/stat} ^+ done
=+ (raid wir mez=%uv ~)
=+ (raid:wired wir mez=%uv ~)
=. out (~(put by out) mez %| rep)
:_ +>.$
=+ pax=/[who.rep]/status/(rsh 3 2 (scot %ui id.rep))
@ -191,12 +191,14 @@
:: [`(slav %ta i.pax) t.pax]
::
::
++ compat |=({usr/(unit iden) req/(unit iden)} ?~(req & =(usr req)))
++ compat
|= {usr/(unit user:eyre) req/(unit user:eyre)}
?~(req & =(usr req))
::
:: .^(twit-feed %gx /=twit=/~/home/urbit_test)
:: .^(twit-stat %gx /=twit=/~./post/0vv0old.0post.hash0.0000)
++ peek
|= {ren/care pax/path} ^- (unit (unit gilt))
|= {ren/care:clay pax/path} ^- (unit (unit gilt))
?> ?=($x ren) :: others unsupported
=+ usr=`~. :: =^ usr pax (user-from-path pax)
?. ?=(twit-path pax)
@ -225,7 +227,7 @@
::
++ peer |=(pax/path :_(+> (pear & `~. pax))) :: accept subscription
++ pear :: poll, possibly returning current data
|= {ver/? usr/(unit iden) pax/path}
|= {ver/? usr/(unit user:eyre) pax/path}
^- (list move)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
@ -249,7 +251,7 @@
|= pax/twit-path ^- $%({$none $~} {$part p/gilt} {$full p/gilt})
?- -.pax
$post
=+ (raid +.pax mez=%uv ~)
=+ (raid:wired +.pax mez=%uv ~)
=+ sta=(~(get by out) mez)
?. ?=({$~ $| *} sta)
[%none ~]
@ -266,7 +268,7 @@
==
::
++ pear-hiss
|= pax/twit-path ^- (unit {(unit iden) api-call})
|= pax/twit-path ^- (unit {(unit user:eyre) api-call})
?- -.pax
$post ~ :: future/unacked
$cred
@ -287,7 +289,7 @@
|= a/knot ^- sd:param
~| [%not-user a]
%+ rash a
;~(pose (stag %user-id dem) (stag %screen-name user:parse))
;~(pose (stag %user-id dem) (stag %screen-name user:parse:twitter))
::
:: ++ pull :: release subscription
:: |= ost/bone
@ -313,5 +315,5 @@
?. =(pax a) ~
(turn b |=(c/gift [ost c]))
::
++ show-url ~(said-url talk `bowl`+<-)
++ show-url ~(said-url talk `bowl:gall`+<-)
--

2
gen/brass.hoon
View File

@ -286,7 +286,7 @@
=/ dat .^(@t %cx pax)
[(met 3 dat) dat]
==
=/ all (~(tap by dir.lon) ~)
=/ all ~(tap by dir.lon)
|- ^- mode:clay
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))

59
gen/cram.hoon Normal file
View File

@ -0,0 +1,59 @@
::
:::: hoon/cram/gen
::
:: test generator for the cram markdown syntax
::
:: todo: integrate with ++sail and embed in hoon compiler
::
:: ++cram is a simple markdown-inspired parser that makes
:: common html tropes easy to type. you can think of ++cram
:: as "rational markdown" or "markdown with syntax errors."
:: a document format should be easy to type and read, but
:: that doesn't mean it can't or have rigorous syntax.
::
:: tldr: ++cram is indent-oriented. indent 2 spaces for
:: a dynamic interpolation, 4 spaces for example code, 6
:: spaces for a blockquote and 8 spaces for verse. separate
:: every semantic block by a blank line. use - for
:: unordered lists, + for ordered lists.
::
:: markdown link syntax works. * means bold, _ means
:: italics, "" inserts smart quotes. all enclosed
:: strings are reparsed; escape the terminator within
:: the string, eg, *star \* in bold text*.
::
:: markdown `literal` syntax is supported, but all hoon
:: constants are automatically marked as code. also, any
:: hoon expression prefixed with # is a code literal.
::
:: (++cram is a valid hoon parsing rule, but it does a lot
:: of custom processing internally, since the language is
:: context-sensitive. we use a context-sensitive parser
:: to cut the lines into blocks, then reparse flow blocks
:: with normal hoon rules. multipass parsing is the tax
:: humans have to pay for simple but human-friendly syntax.)
::
::|= inp/cord
::=< (steam-marl (rash inp apex:(sail &)))
=< |=(pax/path (test pax))
|% ::
++ test :: test text parsing
|= pax/path
^- tape
::
:: src: text file as (list cord)
:: txt: source as tape with newlines
:: vex: parsing result
::
=/ src .^(wain %cx pax)
=. src ['---' src]
=/ txt (zing (turn src |=(@t (weld (rip 3 +<) `tape`~[`@`10]))))
=/ vex (cram:vast [1 1] txt)
::
:: print result as error or xml text
?~ q.vex
"syntax error: line {(scow %ud p.p.vex)}, column {(scow %ud q.p.vex)}"
?: [freeze=|] (poxo (snag 1 ~(shut ap p.u.q.vex)))
(poxo ;;(manx q:(slap !>(..zuse) p.u.q.vex)))
::
--

2
gen/glass.hoon
View File

@ -124,7 +124,7 @@
?. ?=({$hoon *} tyl) hav
:_(hav [(flop `path`t.tyl) [%hoon .^(@t %cx pax)]])
::
=/ all (~(tap by dir.lon) ~)
=/ all ~(tap by dir.lon)
|- ^+ hav
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))

8
gen/hood/init-auth-basic.hoon
View File

@ -13,13 +13,13 @@
{arg/$@($~ {dom/path $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
^- (sole-result {$write-sec-atom p/host:eyre q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ sole-lo
[%& %oauth-hostname "api hostname: https://"]
%+ sole-go thos:urlp
|= hot/host
%+ sole-go thos:de-purl:html
|= hot/host:eyre
?: ?=($| -.hot)
~|(%ips-unsupported !!)
%+ sole-lo
@ -31,4 +31,4 @@
%+ sole-go (boss 256 (star prn))
|= pas/@t
%+ sole-so %write-sec-atom :: XX typed pair
[hot (crip (sifo (rap 3 usr ':' pas ~)))]
[hot (crip (en-base64:mimes:html (rap 3 usr ':' pas ~)))]

8
gen/hood/init-oauth2.hoon
View File

@ -13,13 +13,13 @@
{arg/$@($~ {dom/path $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
^- (sole-result {$write-sec-atom p/host:eyre q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ sole-lo
[%& %oauth-hostname "api hostname: https://"]
%+ sole-go thos:urlp
|= hot/host
%+ sole-go thos:de-purl:html
|= hot/host:eyre
?: ?=($| -.hot)
~|(%ips-unsupported !!)
%+ sole-lo
@ -31,4 +31,4 @@
%+ sole-go (boss 256 (star prn))
|= cis/@t
%+ sole-so %write-sec-atom :: XX typed pair
[hot (of-wain cid cis ~)]
[hot (of-wain:format cid cis ~)]

9
gen/hood/init-oauth2/google.hoon
View File

@ -4,17 +4,20 @@
::
/? 314
/- sole
/+ old-zuse
=, old-zuse
::
::::
::
=, sole
=, html
=, format
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
{arg/$@($~ {jon/json $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
^- (sole-result {$write-sec-atom p/host:eyre q/@})
%+ sole-yo leaf+"Accepting credentials for https://*.googleapis.com"
=+ hot=[%& /com/googleapis]
=- ?~ arg -
@ -25,6 +28,6 @@
|= jon/json
=+ ~| bad-json+jon
=- `{cid/@t cis/@t}`(need (rep jon))
rep=(ot web+(ot 'client_id'^so 'client_secret'^so ~) ~):jo
rep=(ot web+(ot 'client_id'^so 'client_secret'^so ~) ~):dejs-soft:format
%+ sole-so %write-sec-atom :: XX typed pair
[hot (of-wain cid cis ~)]
[hot (of-wain:format cid cis ~)]

8
gen/hood/invite.hoon
View File

@ -7,11 +7,13 @@
::::
::
/+ womb
=* invite invite:womb
=* reference reference:womb
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{who/@t $~} sta/@}
{{who/@t $~} ref/(unit (each ship mail:womb)) sta/@}
==
:- %womb-invite
^- {cord invite}:womb
^- {cord reference invite}
=+ inv=(scot %uv (end 7 1 eny))
[inv [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]]
[inv ref [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]]

2
gen/hood/merge.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/merge/hood/gen
::
/? 310
/+ *old-zuse
=, old-zuse
::
|%
++ beaky {knot knot knot $~}

13
gen/hood/nuke.hoon Normal file
View File

@ -0,0 +1,13 @@
:: nuke: reject packets from.
::
:::: /hoon/mount/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{him/@p $~} $~}
==
[%helm-nuke him]

13
gen/hood/wipe-ford.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Kiln: wipe ford cache
::
:::: /hoon/wipe-ford/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{arg/$~ $~}
==
[%kiln-wipe-ford ~]

31
gen/moon.hoon
View File

@ -3,18 +3,35 @@
:::: /hoon/moon/gen
::
/? 310
/- sole
[. sole]
::
::::
::
:- %say
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
$~
$~
==
:- %tang :_ ~ :- %leaf
=+ ran=(clan p.bec)
=/ ran (clan p.bec)
?: ?=({?($earl $pawn)} ran)
"can't create a moon from a {?:(?=($earl ran) "moon" "comet")}"
=+ mon=(mix (lsh 5 1 (end 5 1 eny)) p.bec)
=+ tic=.^(@ /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p mon))
"moon: {<`@p`mon>}; ticket: {<`@p`tic>}"
%- sole-so
:- %tang :_ ~
leaf+"can't create a moon from a {?:(?=($earl ran) "moon" "comet")}"
=/ mon (mix (lsh 5 1 (end 5 1 eny)) p.bec)
=/ tic .^(@ /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p mon))
%+ sole-yo
leaf+"(see https://github.com/urbit/arvo/issues/327 for details)"
%+ sole-yo
:- %leaf
;: weld
"WARNING: linking a moon to your "
?-(ran $czar "galaxy", $king "star", $duke "planet")
" can cause networking bugs"
==
%+ sole-lo
[& %$ "enter y/yes to continue: "]
|= inp/tape
?. |(=("y" inp) =("yes" inp))
(sole-so [%tang leaf+"canceled" ~])
(sole-so [%tang leaf+"moon: {<`@p`mon>}; ticket: {<`@p`tic>}" leaf+"" ~])

69
gen/mud.hoon Normal file
View File

@ -0,0 +1,69 @@
:: Compile arvo as a pill noun, for compiler changes;
:: usage
::
:: .urbit/pill +mud
::
:::: /hoon/mud/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{$~ $~}
==
:- %noun
=+ ^= must
:: virtualize, running in a nested memory ring
::
|* taq/_|.(**)
=+ muz=(mule taq)
?- -.muz
$& p.muz
$| (mean p.muz)
==
=+ top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
=+ pax=`path`(weld top `path`[%hoon ~])
=+ arp=`path`(weld top `path`[%ovra ~])
~& %mud-start
=+ txt=.^(@t %cx (weld pax `path`[%hoon ~]))
=+ rax=.^(@t %cx (weld arp `path`[%hoon ~]))
~& %mud-loaded
=+ gen=(must |.((rain pax txt)))
~& %mud-parsed
=+ one=(must |.((~(mint ut %noun) %noun gen)))
~& %mud-compiled
=+ gat=`vase`[p.one .*(0 q.one)]
~& %mud-done-hoon
=+ kyr=`(pair vase vase)`[(slap ked [%limb %p]) (slap ked [%limb %q])]
~& %mud-next-arvo
=+
%- must |.
(slam gat (slop p.kyr `vase`[[%atom %t ~] rax]))
~& %mud-done-arvo
=+ ayr=`(pair vase vase)`[(slap arv [%limb %p]) (slap arv [%limb %q])]
=+ ken=[7 q.q.kyr q.q.ayr]
~& [%mud-recompiled `@ux`(mug ken)]
:- ken
=+ all=.*(0 ken)
=+ ^= vay ^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%f /vane/ford]
[%c /vane/clay]
[%g /vane/gall]
[%a /vane/ames]
[%b /vane/behn]
[%d /vane/dill]
[%e /vane/eyre]
==
|- ^+ all
?~ vay all
=+ pax=(weld top q.i.vay)
=+ txt=.^(@ %cx (weld pax `path`[%hoon ~]))
=+ sam=[now `ovum`[[%gold ~] [%veer p.i.vay pax txt]]]
~& [%solid-veer i.vay]
=+ gat=.*(all .*(all [0 42]))
=+ nex=+:.*([-.gat [sam +>.gat]] -.gat)
$(vay t.vay, all nex)

42
gen/solid.hoon
View File

@ -1,41 +1,53 @@
:: Compile arvo as a pill noun, usage .urbit/pill +solid
:: Compile arvo as a pill noun, without compiler changes.
:: usage
::
:: .urbit/pill +solid
::
:::: /hoon/solid/gen
::
/? 310
::
::::
::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{$~ $~}
==
:- %noun
=+ top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/arvo
=+ top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
=+ pax=`path`(weld top `path`[%hoon ~])
=+ arp=`path`(weld top `path`[%ovra ~])
~& %solid-start
=+ gen=(reck pax)
=+ txt=.^(@t %cx (weld pax `path`[%hoon ~]))
=+ rax=.^(@t %cx (weld arp `path`[%hoon ~]))
~& %solid-loaded
=+ gen=(rain pax txt)
~& %solid-parsed
=+ ken=q:(~(mint ut %noun) %noun gen)
=+ one=(~(mint ut %noun) %noun gen)
~& %solid-compiled
=+ two=(~(mint ut p.one) %noun (rain arp rax))
~& %solid-arvo
=+ ken=[7 q.one q.two]
~& [%solid-kernel `@ux`(mug ken)]
:- ken
=+ all=.*(0 ken)
=+ ^= vay ^- (list {p/@tas q/@tas})
:~ [%$ %zuse]
[%c %clay]
[%g %gall]
[%f %ford]
[%a %ames]
[%b %behn]
[%d %dill]
[%e %eyre]
=+ ^= vay ^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%f /vane/ford]
[%c /vane/clay]
[%g /vane/gall]
[%a /vane/ames]
[%b /vane/behn]
[%d /vane/dill]
[%e /vane/eyre]
==
|- ^+ all
?~ vay all
=+ pax=(weld top `path`[q.i.vay ~])
=+ pax=(weld top q.i.vay)
=+ txt=.^(@ %cx (weld pax `path`[%hoon ~]))
=+ sam=[now `ovum`[[%gold ~] [%veer p.i.vay pax txt]]]
~& [%solid-veer i.vay]
=+ gat=.*(all .*(all [0 42]))
=+ nex=+:.*([-.gat [sam +>.gat]] -.gat)
$(vay t.vay, all nex)

2
gen/ticket.hoon
View File

@ -11,4 +11,6 @@
{{her/@p $~} $~}
==
:- %noun
~_ leaf+"can't ticket {<her>} (not a child of {<p.bec>})"
?> =(p.bec (sein:title her))
.^(@p /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p her))

3
gen/womb/balances.hoon
View File

@ -11,4 +11,5 @@
==
:- %womb-balance-all
=+ [him=(scot %p ?^(who u.who p.bec)) cas=(scot %da now)]
.^((set {passhash mail}:womb) %gx /[him]/hood/[cas]/womb/balance/womb-balance-all)
=/ balances =>(womb ,(set [passhash mail]))
.^(balances %gx /[him]/hood/[cas]/womb/balance/womb-balance-all)

2
lib/basic-auth.hoon
View File

@ -22,7 +22,7 @@
::
++ add-auth-header
|= a/hiss ^- hiss
~& auth+(earn p.a)
~& auth+(en-purl:html p.a)
%_(a q.q (~(add ja q.q.a) %authorization header:auth))
::
++ standard

7
lib/connector.hoon
View File

@ -10,6 +10,9 @@
:: -- in `++sigh-httr` in the connector app, call `++sigh` in
:: this library to handle the response according to the
:: place.
/+ old-zuse
=, old-zuse
::
|* {move/mold sub-result/mold}
=> |%
:: A place consists of:
@ -108,11 +111,12 @@
$(places t.places)
(?+(ren !! $x read-x.i.places, $y read-y.i.places) pax)
::
:: Handles http responses sent in `++read` by mappig them to
:: Handles http responses sent in `++read` by mapping them to
:: their handling, either `sigh-x` or `sigh-y`, in `places`.
::
++ sigh
=, html
=, eyre
|= {places/(list place) ren/care pax/path res/httr}
^- sub-result
=< ?+(ren ~|([%invalid-care ren] !!) $x sigh-x, $y sigh-y)
@ -164,5 +168,4 @@
arch+*arch
arch+u.-
--
--

2
lib/down-jet/parse.hoon
View File

@ -616,7 +616,7 @@
::
++ proc-inline :: parse inline kids
|= pac/_pars:inli :: cache
|= a/elem
|= a/elem ^+ a
?^ -.a a(q (flop (turn q.a ..$)))
?+ -.a a
$code

54
lib/helm.hoon
View File

@ -30,6 +30,9 @@
++ hood-init :: report init
$: him/ship ::
== ::
++ hood-nuke :: block/unblock
$: him/ship ::
== ::
++ hood-reset :: reset command
$~ ::
++ helm-verb :: reset command
@ -40,17 +43,18 @@
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:gall helm-part} :: main helm work
|= {bowl:gall helm-part} :: main helm work
=+ sez=(fall (~(get by hoc) ost) *helm-session)
=> |% :: arvo structures
++ card ::
$% {$cash wire p/@p q/buck:ames} ::
$% {$cash wire p/@p q/buck:ames} ::
{$conf wire dock $load ship term} ::
{$flog wire flog:dill} ::
{$flog wire flog:dill} ::
{$funk wire @p @p @} ::
{$nuke wire ship} ::
{$serv wire ?(desk beam)} ::
{$poke wire dock pear} ::
{$wont wire sock path *} :: send message
{$want wire sock path *} :: send message
== ::
++ move (pair bone card) :: user-level move
++ pear :: poke fruit
@ -73,10 +77,11 @@
++ poke-begin :: make/send keypair
|= hood-begin =< abet
?> ?=($~ bur)
~& [%poke-begin our his]
=+ buz=(shaz :(mix (jam ges) eny))
=+ loy=(pit:nu:crub:crypto 512 buz)
%- emit(bur `[his [0 sec:ex:loy]~])
[%wont /helm/ticket [our (sein:title his)] /a/ta his tic ges pub:ex:loy]
[%want /helm/ticket [our (sein:title his)] /a/ta his tic ges pub:ex:loy]
::
++ poke-spawn
|= {him/ship key/@pG} =< abet
@ -87,6 +92,10 @@
|= him/ship =< abet
(emit %flog /helm %crud %hax-init leaf+(scow %p him) ~)
::
++ poke-nuke :: initialize
|= him/ship =< abet
(emit %nuke /helm him)
::
++ poke-mass
|= $~ =< abet
(emit %flog /heft %crud %hax-heft ~)
@ -105,7 +114,14 @@
|= top/?(desk beam) =< abet
(emit %serv /helm/serv top)
::
++ poke-hi |=(mes/@t abet:(emit %flog /di %text "< {<src>}: {(trip mes)}"))
++ poke-hi
|= mes/@t
~| %poke-hi-fail
?: =(%fail mes)
~& %poke-hi-fail
!!
abet:(emit %flog /di %text "< {<src>}: {(trip mes)}")
::
++ poke-atom
|= ato/@
=+ len=(scow %ud (met 3 ato))
@ -154,6 +170,28 @@
(said:talk our %helm now eny [%leaf "invited: {<who>} at {(trip myl)}"]~)
::
++ poke-reset :: reset system
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/sys
:- [%flog /reset %vega (weld top /hoon) (weld top /ovra)]
%+ turn
^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%a /vane/ames]
[%b /vane/behn]
[%c /vane/clay]
[%d /vane/dill]
[%e /vane/eyre]
[%f /vane/ford]
[%g /vane/gall]
==
|= {p/@tas q/path}
=+ way=`path`(welp top q)
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
::
++ poke-meset :: reset system (new)
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
@ -179,7 +217,7 @@
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
::
++ poke-wyll :: hear certificate
++ poke-will :: hear certificate
|= wil/(unit wyll:ames)
?> ?=(^ bur)
?> ?=(^ wil)
@ -205,7 +243,7 @@
|= {way/wire chr/@tD tan/tank} =< abet
(emit %flog ~ %text chr ' ' ~(ram re tan))
::
++ take-woot :: result of %wont
++ take-woot :: result of %want
|= {way/wire her/ship cop/coop} =< abet
(emit %flog ~ %text "woot: {<[way cop]>}")
--

12
lib/http.hoon
View File

@ -12,18 +12,18 @@
$: domain/(list cord)
end-point/path
req-type/$?($get {$post p/json})
headers/math
queries/quay
headers/math:eyre
queries/quay:eyre
==
++ send
|= {ost/bone pour-path/wire params/request}
:^ ost %them pour-path
`(unit hiss)`[~ (request-to-hiss params)]
`(unit hiss:eyre)`[~ (request-to-hiss params)]
::
++ request-to-hiss
|= request ^- hiss
|= request ^- hiss:eyre
=- ~& hiss=- -
:- ^- parsed-url/purl
:- ^- parsed-url/purl:eyre
:+ :+ security=%.y
port=~
host=[%.y [path=domain]]
@ -31,5 +31,5 @@
q-strings=queries :: ++quay
?@ req-type
[%get headers ~]
[%post headers ~ (as-octt (en-json p.req-type))]
[%post headers ~ (as-octt:mimes:html (en-json p.req-type))]
--

4
lib/kiln.hoon
View File

@ -192,7 +192,7 @@
|%
++ emit |=(a/card +>(..autoload (^emit a)))
++ tracked-vanes
`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))
@ -260,6 +260,8 @@
|= tym/@dr
abet:(emit %wait /kiln/overload/(scot %dr tym) (add ~s10 now))
::
++ poke-wipe-ford |=($~ abet:(emit %wipe /kiln our ~))
::
++ take |=(way/wire ?>(?=({@ $~} way) (work i.way))) :: general handler
++ take-mere ::
|= {way/wire are/(each (set path) (pair term tang))}

46
lib/oauth1.hoon
View File

@ -12,7 +12,7 @@
$% {$request-token oauth-token/@t token-secret/@t} :: intermediate
{$access-token oauth-token/@t token-secret/@t} :: full
==
++ quay-enc (list tape):quay :: partially rendered query string
++ quay-enc (list tape) :: partially rendered query string
--
::
::::
@ -26,23 +26,26 @@
::
++ joint :: between every pair
|= {a/tape b/wall} ^- tape
?~(b b |-(?~(t.b i.b :(weld i.b a $(b t.b)))))
?~ b b
|- ^- tape
?~ t.b i.b
:(weld i.b a $(b t.b))
::
++ join-urle |=(a/(list tape) (joint "&" (turn a urle)))
++ join-en-urle |=(a/(list tape) (joint "&" (turn a en-urlt:html)))
:: query string in oauth1 'k1="v1", k2="v2"' form
++ to-header
|= a/quay ^- tape
%+ joint ", "
(turn a |=({k/@t v/@t} `tape`~[k '="' v '"'])) :: normalized later
::
:: partial tail:earn for sorting
:: partial tail:en-purl:html for sorting
++ encode-pairs
|= a/quay ^- quay-enc
%+ turn a
|= {k/@t v/@t} ^- tape
:(weld (urle (trip k)) "=" (urle (trip v)))
:(weld (en-urlt:html (trip k)) "=" (en-urlt:html (trip v)))
::
++ parse-pairs :: x-form-urlencoded
++ parse-pairs :: x-form-en-urlt:htmlncoded
|= bod/(unit octs) ^- quay-enc
~| %parsing-body
?~ bod ~
@ -51,21 +54,21 @@
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:earn b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:en-purl:html b))))]
(my content-type+['application/x-www-form-en-urlt:htmlncoded']~ ~)
::
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
=- (mean (flop `tang`[>a< -]))
(turn (to-wain (crip b)) |=(c/cord leaf+(trip c)))
(turn (to-wain:format (crip b)) |=(c/cord leaf+(trip c)))
::
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ quay-keys |-($@(knot {$ $})) :: improper tree
++ grab-quay :: ?=({@t @t @t} (grab-quay r:*httr %key1 %key2 %key3))
|* {a/(unit octs) b/quay-keys}
=+ ~| bad-quay+a
c=(rash q:(need `(unit octs)`a) yquy:urlp)
c=(rash q:(need `(unit octs)`a) yquy:de-purl:html)
~| grab-quay+[c b]
=+ all=(malt c)
%. b
@ -83,7 +86,7 @@
^- {key/@t sec/@t $~}
?. =(~ `@`key)
~| %oauth-bad-keys
((hard {key/@t sec/@t $~}) (to-wain key))
((hard {key/@t sec/@t $~}) (to-wain:format key))
%+ mean-wall %oauth-no-keys
"""
Run |init-oauth1 {<`path`dom>}
@ -102,8 +105,8 @@
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ oauth-callback
~& [%oauth-warning "Make sure this urbit ".
"is running on {(earn our-host `~ ~)}"]
%- crip %- earn
"is running on {(en-purl:html our-host `~ ~)}"]
%- crip %- en-purl:html
%^ into-url:interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
@ -135,7 +138,8 @@
?: =(usr nam) &
=< |
%- %*(. slog pri 1)
(flop p:(mule |.(~|(wrong-user+[req=usr got=nam] !!))))
:: XX cgyarvin should figure out why we need to cast to $~
(flop p:(mule |.(~|(wrong-user+[req=usr got=nam] `$~`!!))))
::
++ check-token-quay
|= a/quay ^+ %&
@ -164,7 +168,7 @@
(encode-pairs (weld auq quy))
=+ bay=(base-string med url qen)
=+ sig=(sign signing-key bay)
=. auq ['oauth_signature'^(crip (urle sig)) auq]
=. auq ['oauth_signature'^(crip (en-urlt:html sig)) auq]
(crip "OAuth {(to-header auq)}")
::
++ computed-query
@ -172,24 +176,24 @@
:~ oauth-consumer-key+consumer-key
oauth-nonce+(scot %uw (shaf %non eny))
oauth-signature-method+'HMAC-SHA1'
oauth-timestamp+(rsh 3 2 (scot %ui (unt now)))
oauth-timestamp+(rsh 3 2 (scot %ui (unt:chrono:userlib now)))
oauth-version+'1.0'
==
++ base-string
|= {med/meth url/purl qen/quay-enc} ^- tape
=. qen (sort qen aor)
%- join-urle
%- join-en-urle
:~ (cuss (trip `@t`med))
(earn url)
(en-purl:html url)
(joint "&" qen)
==
++ sign
|= {key/cord bay/tape} ^- tape
(sifo (swap 3 (hmac key (crip bay))))
(en-base64:mimes:html (swp 3 (hmac:crypto key (crip bay))))
::
++ signing-key
%- crip
%- join-urle :~
%- join-en-urle :~
(trip consumer-secret)
(trip ?^(tok token-secret.tok ''))
==
@ -199,7 +203,7 @@
|= {extra/quay request/{url/purl meth hed/math (unit octs)}}
^- hiss
:: =. url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-header+(earn url.request)
~& add-auth-header+(en-purl:html url.request)
%_ request
hed
(~(add ja hed.request) %authorization (header:auth extra request))

66
lib/oauth2.hoon
View File

@ -2,10 +2,12 @@
::
:::: /hoon/oauth2/lib
::
/+ hep-to-cab, interpolate
/+ hep-to-cab, interpolate, old-zuse
=, old-zuse
=, eyre
=, mimes:html
=, html
=, format
|%
++ parse-url parse-url:interpolate
++ join
@ -16,8 +18,15 @@
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:earn b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:en-purl b))))]
%^ my
:+ %accept
'application/json'
~
:+ %content-type
'application/x-www-form-urlencoded'
~
~
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
@ -26,12 +35,27 @@
::
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ grab-json
|* {a/httr b/fist:jo}
|* {a/httr b/fist:dejs-soft:format}
~| bad-json+r.a
~| (de-json q:(need r.a))
(need (;~(biff de-json b) q:(need r.a)))
--
::
::::
::
:: XX belongs back in zuse
|%
++ pack :: light path encoding
|= {a/term b/path} ^- knot
%+ rap 3 :- (wack a)
(turn b |=(c/knot (cat 3 '_' (wack c))))
::
++ pick :: light path decoding
=+ fel=(most cab (sear wick urt:ab))
|=(a/knot `(unit {p/term q/path})`(rush a fel))
::
--
::
::::
::
|%
@ -44,10 +68,10 @@
::::
::
=+ state-usr=|
|_ {(bale keys) tok/token}
|_ {(bale:eyre keys) tok/token}
++ client-id cid:decode-keys
++ client-secret cis:decode-keys
++ decode-keys :: XX from bale w/ typed %jael
++ decode-keys :: XX from bale:eyre w/ typed %jael
^- {cid/@t cis/@t $~}
?. =(~ `@`key)
~| %oauth-bad-keys
@ -62,7 +86,7 @@
++ auth-url
|= {scopes/(list @t) url/$@(@t purl)} ^- purl
~& [%oauth-warning "Make sure this urbit ".
"is running on {(earn our-host `~ ~)}"]
"is running on {(en-purl our-host `~ ~)}"]
%+ add-query:interpolate url
%- quay:hep-to-cab
:~ state+?.(state-usr '' (pack usr /''))
@ -71,9 +95,15 @@
scope+(join ' ' scopes)
==
::
:: XX duplicated from eyre
++ pack :: light path encoding
|= {a/term b/path} ^- knot
%+ rap 3 :- (wack a)
(turn b |=(c/knot (cat 3 '_' (wack c))))
::
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ redirect-uri
%- crip %- earn
%- crip %- en-purl
%^ into-url:interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
@ -97,15 +127,17 @@
::
++ grab-token
|= a/httr ^- axs/@t
(grab-json a (ot 'access_token'^so ~):jo)
(grab-json a (ot 'access_token'^so ~):dejs-soft:format)
::
++ grab-expiring-token
|= a/httr ^- {axs/@t exp/@u}
(grab-json a (ot 'access_token'^so 'expires_in'^ni ~):jo)
(grab-json a (ot 'access_token'^so 'expires_in'^ni ~):dejs-soft:format)
::
++ grab-both-tokens
|= a/httr ^- {axs/@t exp/@u ref/@t}
(grab-json a (ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~):jo)
%+ grab-json a
=, dejs-soft:format
(ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~)
::
++ auth
?~ tok ~|(%no-bearer-token !!)
@ -118,14 +150,14 @@
|= request/{url/purl meth hed/math (unit octs)}
^+ request
:: =. p.url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-header+(earn url.request)
~& add-auth-header+(en-purl url.request)
request(hed (~(add ja hed.request) %authorization header:auth))
::
++ add-auth-query
|= {token-name/cord request/{url/purl meth math (unit octs)}}
^+ request
:: =. p.url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-query+(earn url.request)
~& add-auth-query+(en-purl url.request)
request(r.url [[token-name query:auth] r.url.request])
::
++ re
@ -255,7 +287,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
:: ++ out
:: %+ out-add-header:aut scope=/full
@ -279,7 +311,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++ aut ~(. oauth2 bal tok)
:: ++ out :: add header
:: =+ aut
@ -316,7 +348,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2 ref/refresh:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2 ref/refresh:oauth2}
:: ++ aut
:: %^ ~(standard-refreshing oauth2 bal tok) . ref
:: |=({tok/token ref/refresh}:oauth2 +>(tok tok, ref ref))
@ -343,7 +375,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) axs/token:oauth2 ref/refresh:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) axs/token:oauth2 ref/refresh:oauth2}
:: ++ aut ~(. oauth2 bal axs)
:: ++ exchange-url 'https://my-api.com/access_token'
:: ++ out :: refresh or add header

7
lib/old-zuse.hoon
View File

@ -7,10 +7,6 @@
++ fu fu:number :: modulo (mul p q)
++ aes aes:crypto :: aes, all sizes
++ crua crua:crypto :: cryptosuite A (RSA)
++ bruw bruw:suite:crypto :: create keypair
++ haul haul:suite:crypto :: activate public key
++ weur weur:suite:crypto :: activate secret key
++ trua trua:test:crypto :: test rsa
++ crub crub:crypto :: cryptosuite B (Ed)
++ trub trub:test:crypto :: test crub
++ hmac hmac:crypto :: HMAC-SHA1
@ -54,7 +50,6 @@
++ ofis de-base64:mimes:html :: 64-bit decode
++ dray dray:wired :: load tuple into path
++ raid raid:wired :: demand path odors
++ read read:wired :: parse odored path
++ urle en-urlt:html :: URL encode
++ urld de-urlt:html :: URL decode
++ earn en-purl:html :: purl to tape
@ -85,7 +80,7 @@
++ apex !! :: XX deprecated
++ ares ares.is :: possible error
++ bale bale:eyre :: driver state
++ iden !! :: username
++ iden user:eyre :: username
++ sec-move sec-move:eyre :: driver effect
++ ball !! :: XX deprecated
++ bait bait:ames :: fmt nrecvd spec

1823
lib/vast2.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

632
lib/womb.hoon
View File

@ -5,50 +5,49 @@
/+ talk, old-phon
=, wired
=, title
=, womb:jael
:: :: ::
:::: :: ::
:: :: ::
:: |%
:: ++ foil :: ship allocation map
:: |* mold :: entry mold
:: $: min/@u :: minimum entry
:: ctr/@u :: next allocated
:: und/(set @u) :: free under counter
:: ove/(set @u) :: alloc over counter
:: max/@u :: maximum entry
:: box/(map @u +<) :: entries
:: == ::
:: -- ::
|%
++ foil :: ship allocation map
|* a=mold :: entry mold
$: min/@u :: minimum entry
ctr/@u :: next allocated
und/(set @u) :: free under counter
ove/(set @u) :: alloc over counter
max/@u :: maximum entry
box/(map @u a) :: entries
== ::
-- ::
:: ::
:::: ::
:: ::
|% ::
:: ++ managed :: managed plot
:: |* mold ::
:: %- unit :: unsplit
:: %+ each +< :: subdivided
:: mail :: delivered
:: :: ::
:: ++ divided :: get division state
:: |* (managed) ::
:: ?- +< ::
:: $~ ~ :: unsplit
:: {$~ $| *} ~ :: delivered
:: {$~ $& *} (some p.u.+<) :: subdivided
:: == ::
:: :: ::
:: ++ moon (managed _!!) :: undivided moon
:: ::
:: ++ planet :: subdivided planet
:: (managed (lone (foil moon))) ::
:: :: ::
:: ++ star :: subdivided star
:: (managed (pair (foil moon) (foil planet))) ::
:: :: ::
:: ++ galaxy :: subdivided galaxy
:: (managed (trel (foil moon) (foil planet) (foil star)))::
:: :: ::
++ managed :: managed plot
|* mold ::
%- unit :: unsplit
%+ each +< :: subdivided
mail :: delivered
:: ::
++ divided :: get division state
|* (managed) ::
?- +< ::
$~ ~ :: unsplit
{$~ $| *} ~ :: delivered
{$~ $& *} (some p.u.+<) :: subdivided
== ::
:: ::
++ moon (managed _!!) :: undivided moon
::
++ planet :: subdivided planet
(managed (lone (foil moon))) ::
:: ::
++ star :: subdivided star
(managed (pair (foil moon) (foil planet))) ::
:: ::
++ galaxy :: subdivided galaxy
(managed (trel (foil moon) (foil planet) (foil star)))::
:: ::
++ ticket @G :: old 64-bit ticket
++ passcode @uvH :: 128-bit passcode
++ passhash @uwH :: passocde hash
@ -59,11 +58,15 @@
owner/mail :: owner's email
history/(list mail) :: transfer history
== ::
:: ++ property :: subdivided plots
:: $: galaxies/(map @p galaxy) :: galaxy
:: planets/(map @p planet) :: star
:: stars/(map @p star) :: planet
:: == ::
++ client :: per email
$: sta/@ud :: unused star refs
has/(set @p) :: planets owned
== ::
++ property :: subdivided plots
$: galaxies/(map @p galaxy) :: galaxy
planets/(map @p planet) :: star
stars/(map @p star) :: planet
== ::
++ invite ::
$: who/mail :: who to send to
pla/@ud :: planets to send
@ -74,6 +77,10 @@
$: intro/tape :: in invite email
hello/tape :: as talk message
== ::
++ reference :: affiliate credit
(unit (each @p mail)) :: ship or email
:: ::
++ reference-rate 2 :: star refs per star
++ stat (pair live dist) :: external info
++ live ?($cold $seen $live) :: online status
++ dist :: allocation
@ -95,8 +102,9 @@
++ part {$womb $1 pith} :: womb state
++ pith :: womb content
$: boss/(unit ship) :: outside master
:: bureau/(map passhash balance) :: active invitations
:: office/property :: properties managed
bureau/(map passhash balance) :: active invitations
office/property :: properties managed
hotel/(map (each ship mail) client) :: everyone we know
recycling/(map ship @) :: old ticket keys
== ::
-- ::
@ -104,14 +112,6 @@
:::: :: ::
:: :: ::
|% :: arvo structures
++ invite-j {who/mail pla/@ud sta/@ud} :: invite data
++ balance-j {who/mail pla/@ud sta/@ud} :: balance data
++ womb-task :: manage ship %fungi
$% {$claim aut/passcode her/@p tik/ticket} :: convert to %final
{$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode
{$invite tid/passcode inv/invite-j} :: alloc to passcode
{$reinvite aut/passcode tid/passcode inv/invite-j}:: move to another
== ::
++ card ::
$% {$flog wire flog:dill} ::
{$info wire @p @tas nori:clay} :: fs write (backup)
@ -121,7 +121,6 @@
{$next wire p/ring} :: update private key
{$tick wire p/@pG q/@p} :: save ticket
{$knew wire p/ship q/wyll:ames} :: learn will (old pki)
{$jaelwomb wire task:womb} :: manage rights
== ::
++ pear ::
$% {$email mail tape wall} :: send email
@ -134,17 +133,19 @@
{$womb-balance balance} ::
{$womb-balance-all (map passhash mail)} ::
{$womb-stat stat} ::
:: {$womb-stat-all (map ship stat)} ::
{$womb-stat-all (map ship stat)} ::
{$womb-ticket-info passcode ?($fail $good $used)} ::
==
++ move (pair bone card) :: user-level move
::
++ transaction :: logged poke
$% {$report her/@p wyl/wyll:ames}
{$release gal/@ud sta/@ud}
{$release-ships (list ship)}
{$claim aut/passcode her/@p}
{$recycle who/mail him/knot tik/knot}
{$bonus tid/cord pla/@ud sta/@ud}
{$invite tid/cord inv/invite}
{$invite tid/cord ref/reference inv/invite}
{$reinvite aut/passcode inv/invite}
==
--
@ -169,8 +170,86 @@
=+ d=(b q.c)
?~(d ~ (some [p.c u.d]))
::
++ unsplit
|= a/(map ship (managed)) ^- (list {ship *})
%+ skim ~(tap by a)
|=({@ a/(managed)} ?=($~ a))
::
++ issuing
|* a/(map ship (managed))
^- (list [ship _(need (divided (~(got by a))))])
(sort ~(tap by (murn-by a divided)) lor)
::
++ issuing-under
|* {a/bloq b/ship c/(map @u (managed))}
^- (list [ship _(need (divided (~(got by c))))])
%+ turn (sort ~(tap by (murn-by c divided)) lor)
|*(d/{@u *} [(rep a b -.d ~) +.d])
++ cursor (pair (unit ship) @u)
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
::
:: Create new foil of size
++ fo-init
|= a/bloq :: ^- (foil *)
[min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~]
::
++ fo
|_ (foil $@($~ *))
++ nth :: index
|= a/@u ^- (pair (unit @u) @u)
?: (lth a ~(wyt in und))
=+ out=(snag a (sort ~(tap in und) lth))
[(some out) 0]
=. a (sub a ~(wyt in und))
|- ^- {(unit @u) @u}
?: =(ctr +(max)) [~ a]
?: =(0 a) [(some ctr) a]
$(a (dec a), +<.nth new)
::
+- fin +< :: abet
++ new :: alloc
?: =(ctr +(max)) +<
=. ctr +(ctr)
?. (~(has in ove) ctr) +<
new(ove (~(del in ove) ctr))
::
+- get :: nullable
|= a/@p ^+ ?~(box ~ q.n.box)
(fall (~(get by box) (neis a)) ~)
::
+- put
|* {a/@u b/*} ^+ fin :: b/_(~(got by box))
~| put+[a fin]
?> (fit a)
=; adj adj(box (~(put by box) a b))
?: (~(has in box) a) fin
?: =(ctr a) new
?: (lth a ctr)
?. (~(has in und) a) fin
fin(und (~(del in und) a))
?. =(a ctr:new) :: heuristic
fin(ove (~(put in ove) a))
=+ n=new(+< new)
n(und (~(put in und.n) ctr))
::
++ fit |=(a/@u &((lte min a) (lte a max))) :: in range
++ gud :: invariant
?& (fit(max +(max)) ctr)
(~(all in und) fit(max ctr))
(~(all in ove) fit(min ctr))
(~(all in box) |=({a/@u *} (fit a)))
|- ^- ?
?: =(min max) &
=- &(- $(min +(min)))
%+ gte 1 :: at most one of
;: add
?:(=(min ctr) 1 0)
?:((~(has in und) min) 1 0)
?:((~(has in ove) min) 1 0)
?:((~(has by box) min) 1 0)
==
==
--
--
:: :: ::
:::: :: ::
@ -193,6 +272,32 @@
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
::
++ take-n :: compute range
|= {{index/@u count/@u} get/$-(@u cursor)}
^- (list ship)
?~ count ~
%+ biff p:(get index)
|= a/ship ^- (list ship)
[a ^$(index +(index), count (dec count))]
::
++ available :: enumerate free ships
|= all/(map ship (managed)) ^- $-(@u cursor)
=+ pur=(sort (turn (unsplit all) head) lth)
=+ len=(lent pur)
|=(a/@u ?:((gte a len) [~ (sub a len)] [(some (snag a pur)) a]))
::
:: foil cursor to ship cursor, using sized parent
++ prefix
|= {a/bloq b/@p {c/(unit @u) d/@u}} ^- cursor
?~ c [c d]
[(some (rep a b u.c ~)) d]
::
++ in-list :: distribute among options
|* {a/(list) b/@u} ^+ [(snag *@ a) b]
=+ c=(lent a)
[(snag (mod b c) a) (div b c)]
::
++ ames-last-seen :: last succesful ping
|= a/ship ~+ ^- (unit time)
?: =(a our) (some now)
@ -201,25 +306,113 @@
%+ ames-grab %rue
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
::
++ jael-scry
|* {typ/mold pax/path} ^- typ
.^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax))
++ neighboured :: filter for connectivity
|* a/(list {ship *}) ^+ a
%+ skim a
|= {b/ship *}
?=(^ (ames-last-seen b))
::
++ jael-pas-balance
|= pas/passcode ^- (unit balance)
%+ bind (jael-scry (unit balance-j) /balance/(scot %uv pas)/womb-balance)
|= a/balance-j ^- balance
=/ hiz/(list mail) ~ :: XX track history in jael
[pla.a sta.a who.a hiz]
++ shop-galaxies (available galaxies.office) :: unassigned %czar
::
:: Stars can be either whole or children of galaxies
++ shop-stars :: unassigned %king
|= nth/@u ^- cursor
=^ out nth %.(nth (available stars.office))
?^ out [out nth]
%+ shop-star nth
(neighboured (issuing galaxies.office))
::
++ shop-star :: star from galaxies
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
(prefix 3 who.sel (~(nth fo r.sel) nth))
::
++ shop-planets :: unassigned %duke
|= nth/@u ^- cursor
=^ out nth %.(nth (available planets.office))
?^ out [out nth]
=^ out nth
%+ shop-planet nth
(neighboured (issuing stars.office))
?^ out [out nth]
(shop-planet-gal nth (issuing galaxies.office))
::
++ shop-planet :: planet from stars
|= {nth/@u sta/(list {who/@p * q/(foil planet)})} ^- cursor
?: =(~ sta) [~ nth]
=^ sel nth (in-list sta nth)
(prefix 4 who.sel (~(nth fo q.sel) nth))
::
++ shop-planet-gal :: planet from galaxies
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
%+ shop-planet nth
(neighboured (issuing-under 3 who.sel box.r.sel))
::
++ peek-x-shop :: available ships
|= tyl/path ^- (unit (unit {$ships (list @p)}))
=; a ~& peek-x-shop+[tyl a] a
=; res/(list ship) (some (some [%ships res]))
:: XX redundant parse?
=+ [typ nth]=~|(bad-path+tyl (raid tyl /[typ=%tas]/[nth=%ud]))
(jael-scry (list ship) /shop/[typ]/(scot %ud nth)/ships)
=; res (some (some [%ships res]))
=+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
:: =. nth (mul 3 nth)
?+ typ ~|(bad-type+typ !!)
$galaxies (take-n [nth 3] shop-galaxies)
$planets (take-n [nth 3] shop-planets)
$stars (take-n [nth 3] shop-stars)
==
::
++ get-managed-galaxy ~(got by galaxies.office) :: office read
++ mod-managed-galaxy :: office write
|= {who/@p mod/$-(galaxy galaxy)} ^+ +>
=+ gal=(mod (get-managed-galaxy who))
+>.$(galaxies.office (~(put by galaxies.office) who gal))
::
++ get-managed-star :: office read
|= who/@p ^- star
=+ (~(get by stars.office) who)
?^ - u
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-star+(sein who) !!)
(fall (~(get by box.r.p.u.gal) (neis who)) ~)
::
++ mod-managed-star :: office write
|= {who/@p mod/$-(star star)} ^+ +>
=+ sta=(mod (get-managed-star who)) :: XX double traverse
?: (~(has by stars.office) who)
+>.$(stars.office (~(put by stars.office) who sta))
%+ mod-managed-galaxy (sein who)
|= gal/galaxy ^- galaxy
?> ?=({$~ $& *} gal)
gal(r.p.u (~(put fo r.p.u.gal) (neis who) sta))
::
++ get-managed-planet :: office read
|= who/@p ^- planet
=+ (~(get by planets.office) who)
?^ - u
?: (~(has by galaxies.office) (sein who))
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-galaxy+(sein who) !!)
(~(get fo q.p.u.gal) who)
=+ sta=(get-managed-star (sein who))
?. ?=({$~ $& *} sta) ~|(unavailable-star+(sein who) !!)
(~(get fo q.p.u.sta) who)
::
++ mod-managed-planet :: office write
|= {who/@p mod/$-(planet planet)} ^+ +>
=+ pla=(mod (get-managed-planet who)) :: XX double traverse
?: (~(has by planets.office) who)
+>.$(planets.office (~(put by planets.office) who pla))
?: (~(has by galaxies.office) (sein who))
%+ mod-managed-galaxy (sein who)
|= gal/galaxy ^- galaxy
?> ?=({$~ $& *} gal)
gal(q.p.u (~(put fo q.p.u.gal) (neis who) pla))
%+ mod-managed-star (sein who)
|= sta/star ^- star
?> ?=({$~ $& *} sta)
sta(q.p.u (~(put fo q.p.u.sta) (neis who) pla))
::
++ get-live :: last-heard time ++live
|= a/ship ^- live
@ -227,39 +420,88 @@
?~ rue %cold
?:((gth (sub now u.rue) ~m5) %seen %live)
::
++ stat-any :: unsplit status
|= {who/@p man/(managed _!!)} ^- stat
:- (get-live who)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned p.u.man]
::
++ stat-planet :: stat of planet
|= {who/@p man/planet} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
=+ pla=u:(divided man)
:- %split
%- malt
%+ turn ~(tap by box.p.pla)
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::
++ stat-star :: stat of star
|= {who/@p man/star} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
=+ sta=u:(divided man)
:- %split
%- malt
%+ welp
%+ turn ~(tap by box.p.sta)
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
%+ turn ~(tap by box.q.sta)
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
++ stat-galaxy :: stat of galaxy
|= {who/@p man/galaxy} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
=+ gal=u:(divided man)
:- (get-live who)
:- %split
%- malt
;: welp
%+ turn ~(tap by box.p.gal)
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::
%+ turn ~(tap by box.q.gal)
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
%+ turn ~(tap by box.r.gal)
|=({a/@u b/star} =+((rep 3 who a ~) [- (stat-star - b)]))
==
::
++ stats-ship :: inspect ship
|= who/@p ^- stat
:- (get-live who)
=/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned u.man]
?- (clan who)
$pawn !!
$earl !!
$duke (stat-planet who (get-managed-planet who))
$king (stat-star who (get-managed-star who))
$czar (stat-galaxy who (get-managed-galaxy who))
==
::
++ peek-x-stats :: inspect ship/system
|= tyl/path
?^ tyl
?> |(=(our src) =([~ src] boss)) :: privileged info
:: XX redundant parse?
=+ who=~|(bad-path+tyl (raid tyl /[who=%p]))
``womb-stat+(stats-ship who)
!! :: XX meaningful and/or useful in sein-jael model?
:: ^- (unit (unit {$womb-stat-all (map ship stat)}))
:: =. stat-no-email & :: censor adresses
:: :^ ~ ~ %womb-stat-all
:: %- ~(uni by (~(urn by planets.office) stat-planet))
:: %- ~(uni by (~(urn by stars.office) stat-star))
:: (~(urn by galaxies.office) stat-galaxy)
``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
^- (unit (unit {$womb-stat-all (map ship stat)}))
=. stat-no-email & :: censor adresses
:^ ~ ~ %womb-stat-all
%- ~(uni by (~(urn by planets.office) stat-planet))
%- ~(uni by (~(urn by stars.office) stat-star))
(~(urn by galaxies.office) stat-galaxy)
::
++ peek-x-balance :: inspect invitation
|= tyl/path
?~ tyl
?> |(=(our src) =([~ src] boss)) :: priveledged
``[%womb-balance-all (~(run by bureau) |=(balance owner))]
^- (unit (unit {$womb-balance balance}))
:: XX redundant parse?
=+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv]))
=+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~))
%- some
%+ bind (jael-pas-balance pas)
|=(a/balance [%womb-balance a])
%+ bind (~(get by bureau) (shaf %pass pas))
|=(bal/balance [%womb-balance bal])
::
:: ++ old-phon ;~(pfix sig fed:ag:hoon151) :: library
++ parse-ticket
|= {a/knot b/knot} ^- {him/@ tik/@}
[him=(rash a old-phon) tik=(rash b old-phon)]
@ -282,7 +524,7 @@
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:- pas
?. gud %fail
?^ (jael-pas-balance pas) %used
?: (~(has by bureau) (shaf %pass pas)) %used
%good
::
++ peer-scry-x :: subscription like .^
@ -306,6 +548,7 @@
:: /stats general stats dump
:: /stats/@p what we know about @p
$stats (peek-x-stats +.tyl)
:: /balance all invitations
:: /balance/passcode invitation status
$balance (peek-x-balance +.tyl)
:: /ticket/ship/ticket check ticket usability
@ -318,6 +561,29 @@
?> |(=(our src) =([~ src] boss)) :: privileged
.(recycling (~(put by recycling) a b))
::
++ poke-manage :: add to property
|= a/(list ship)
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
|-
?~ a .
?+ (clan i.a) ~|(bad-size+(clan i.a) !!)
$duke
?. (~(has by planets.office) i.a)
$(a t.a, planets.office (~(put by planets.office) i.a ~))
~|(already-managing+i.a !!)
::
$king
?. (~(has by stars.office) i.a)
$(a t.a, stars.office (~(put by stars.office) i.a ~))
~|(already-managing+i.a !!)
::
$czar
?. (~(has by galaxies.office) i.a)
$(a t.a, galaxies.office (~(put by galaxies.office) i.a ~))
~|(already-managing+i.a !!)
==
::
++ email :: send email
|= {wir/wire adr/mail msg/tape} ^+ +>
?: replay +> :: dont's send email in replay mode
@ -344,8 +610,10 @@
$bonus (teba (poke-bonus +.pok.i.a))
$invite (teba (poke-invite +.pok.i.a))
$report (teba (poke-report +.pok.i.a))
$release (teba (poke-release +.pok.i.a))
$recycle (teba (poke-recycle +.pok.i.a))
$reinvite (teba (poke-reinvite +.pok.i.a))
$release-ships (teba (poke-release-ships +.pok.i.a))
==
==
::
@ -355,25 +623,47 @@
=. log-transaction (log-transaction %bonus +<)
?> |(=(our src) =([~ src] boss)) :: priveledged
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
(emit %jaelwomb / %bonus pas pla sta)
%_ .
bureau
%+ ~(put by bureau) (shaf %pass pas)
=/ bal ~|(%bad-passcode (~(got by bureau) (shaf %pass pas)))
bal(planets (add pla planets.bal), stars (add sta stars.bal))
==
::
++ poke-invite :: create invitation
|= {tid/cord inv/invite}
|= {tid/cord ref/reference inv/invite}
=< abet
=. log-transaction (log-transaction %invite +<)
=. hotel
?~ ref hotel
?~ sta.inv hotel
%+ ~(put by hotel) u.ref
=+ cli=(fall (~(get by hotel) u.ref) *client)
cli(sta +(sta.cli))
(invite-from ~ tid inv)
::
++ invite-from :: traced invitation
|= {hiz/(list mail) tid/cord inv/invite} ^+ +>
?> |(=(our src) =([~ src] boss)) :: priveledged
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
=. emit (emit %jaelwomb / %invite pas [who pla sta]:inv)
?: (~(has by bureau) (shaf %pass pas))
~|([%duplicate-passcode pas who.inv replay=replay] !!)
=. bureau (~(put by bureau) (shaf %pass pas) [pla.inv sta.inv who.inv hiz])
(email /invite who.inv intro.wel.inv)
::
:: ++ coup-invite :: invite sent
::
++ poke-reinvite :: split invitation
|= {aut/passcode inv/invite} :: further invite
=< abet
=. log-transaction (log-transaction %reinvite +<)
?> =(src src) :: self-authenticated
=/ pas/@uv (end 7 1 (shaf %pass eny))
=. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv)
(email /invite who.inv intro.wel.inv)
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
=. stars.bal (sub stars.bal sta.inv)
=. planets.bal (sub planets.bal pla.inv)
=. bureau (~(put by bureau) (shaf %pass aut) bal)
=+ tid=(scot %uv (end 7 1 (shaf %pass eny)))
(invite-from [owner.bal history.bal] tid inv)
::
++ poke-obey :: set/reset boss
|= who/(unit @p)
@ -406,6 +696,47 @@
?> =(src src) :: self-authenticated
(emit %knew /report her wyl)
::
++ use-reference :: bonus stars
|= a/(each @p mail) ^- (unit _+>)
?. (~(has by hotel) a) ~
=+ cli=(~(get by hotel) a)
?~ cli ~
?. (gte sta.u.cli reference-rate) ~
=. sta.u.cli (sub sta.u.cli reference-rate)
`+>.$(hotel (~(put by hotel) a u.cli))
::
++ poke-do-ticket :: issue child ticket
|= her/ship
=< abet
?> =(our (sein her))
?> |(=(our src) =([~ src] boss)) :: privileged
=+ tik=.^(@p %a /(scot %p our)/tick/(scot %da now)/(scot %p her))
:: =. emit (emit /tick %tick tik her)
(emit %poke /womb/tick [src %hood] [%womb-do-claim her tik]) :: XX peek result
::
++ needy
|* a/(each * tang)
?- -.a
$& p.a
$| ((slog (flop p.a)) (mean p.a))
==
::
++ poke-do-claim :: deliver ticket
|= {her/ship tik/@p}
=< abet
^+ +>
?> =(src (sein her)) :: from the parent which could ticket
=+ sta=(stats-ship her)
?> ?=($cold p.sta) :: a ship not yet started
?- -.q.sta
$free !! :: but allocated
$owned :: to an email
(email /ticket p.q.sta "Ticket for {<her>}: {<`@pG`tik>}")
::
$split :: or ship distribution
%.(+>.$ (slog leaf+"Ticket for {<her>}: {<`@pG`tik>}" ~)) :: XX emit via console formally?
==
::
++ poke-recycle :: save ticket as balance
|= {who/mail him-t/knot tik-t/knot}
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
@ -415,14 +746,10 @@
=+ [him tik]=(parse-ticket him-t tik-t)
?> (need (check-old-ticket him tik))
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:: ?^ (scry-womb-invite (shaf %pass pas))
:: ~|(already-recycled+[him-t tik-t] !!)
=/ inv/{pla/@ud sta/@ud}
?+((clan him) !! $duke [0 1], $king [1 0])
(emit %jaelwomb / %invite pas who inv)
::
::
:: ++ jael-claimed 'Move email here if an ack is necessary'
?: (~(has by bureau) (shaf %pass pas))
~|(already-recycled+[him-t tik-t] !!)
=+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~])
.(bureau (~(put by bureau) (shaf %pass pas) bal))
::
++ poke-claim :: claim plot, req ticket
|= {aut/passcode her/@p}
@ -430,9 +757,100 @@
=< abet
=. log-transaction (log-transaction %claim +<)
?> =(src src)
=/ bal ~|(%bad-invite (need (jael-pas-balance aut)))
=/ tik/ticket (end 6 1 (shas %tick eny))
=. emit (emit %jaelwomb / %claim aut her tik)
:: XX event crashes work properly yes?
(email /ticket owner.bal "Ticket for {<her>}: {<`@pG`tik>}")
(claim-any aut her)
::
++ claim-any :: register
|= {aut/passcode her/@p}
=; claimed
:: =. claimed (emit.claimed %wait $~) :: XX delay ack
(emit.claimed %poke /womb/tick [(sein her) %hood] [%womb-do-ticket her])
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
?+ (clan her) ~|(bad-size+(clan her) !!)
$king
=; all (claim-star.all owner.bal her)
=+ (use-reference &+src)
?^ - u :: prefer using references
=+ (use-reference |+owner.bal)
?^ - u
=. stars.bal ~|(%no-stars (dec stars.bal))
+>.$(bureau (~(put by bureau) (shaf %pass aut) bal))
::
$duke
=. planets.bal ~|(%no-planets (dec planets.bal))
=. bureau (~(put by bureau) (shaf %pass aut) bal)
(claim-planet owner.bal her)
==
::
++ claim-star :: register
|= {who/mail her/@p} ^+ +>
%+ mod-managed-star her
|= a/star ^- star
?^ a ~|(impure-star+[her ?:(-.u.a %owned %split)] !!)
(some %| who)
::
++ claim-planet :: register
|= {who/mail her/@p} ^+ +>
=. hotel
%+ ~(put by hotel) |+who
=+ cli=(fall (~(get by hotel) |+who) *client)
cli(has (~(put in has.cli) her))
%+ mod-managed-planet her
|= a/planet ^- planet
?^ a ~|(impure-planet+[her ?:(-.u.a %owned %split)] !!)
(some %| who)
::
++ poke-release-ships :: release specific
|= a/(list ship)
=< abet ^+ +>
=. log-transaction (log-transaction %release-ships +<)
?> =(our src) :: privileged
%+ roll a
=+ [who=*@p res=+>.$]
|. ^+ res
?+ (clan who) ~|(bad-size+(clan who) !!)
$king (release-star who res)
$czar (release-galaxy who res)
==
::
++ poke-release :: release to subdivide
|= {gal/@ud sta/@ud} ::
=< abet ^+ +>
=. log-transaction (log-transaction %release +<)
?> =(our src) :: privileged
=. +>
?~ gal +>
=+ all=(take-n [0 gal] shop-galaxies)
?. (gth gal (lent all))
(roll all release-galaxy)
~|(too-few-galaxies+[want=gal has=(lent all)] !!)
^+ +>
?~ sta +>
=+ all=(take-n [0 sta] shop-stars)
~& got-stars+all
%- (slog leaf+"For issuing to proceed smoothly, immediately upon boot, ".
"each should |obey {<our>} to honor ticket requests." ~)
?. (gth sta (lent all))
(roll all release-star)
~|(too-few-stars+[want=sta has=(lent all)] !!)
::
++ release-galaxy :: subdivide %czar
=+ [who=*@p res=.]
|. ^+ res
%+ mod-managed-galaxy:res who
|= gal/galaxy ^- galaxy
~& release+who
?^ gal ~|(already-used+who !!)
(some %& (fo-init 5) (fo-init 4) (fo-init 3))
::
++ release-star :: subdivide %king
=+ [who=*@p res=.]
|. ^+ res
=. res
%- emit.res
[%poke /womb/tick [(sein who) %hood] [%womb-do-ticket who]]
%+ mod-managed-star:res who
|= sta/star ^- star
~& release+who
?^ sta ~|(already-used+[who u.sta] !!)
(some %& (fo-init 5) (fo-init 4))
--

5
lib/write.hoon
View File

@ -53,8 +53,11 @@
|= dif/plan-diff ^+ abet
?. =(our src)
~|(foreign-write+[our=our src=src] !!)
=/ sev
=+ .^(path %e /(scot %p our)/serv/(scot %da now))
?>(?=({@tas @tas *} -) -)
=; sob/soba:clay
?~(sob abet abet:(emit %info write+~ our `toro:clay`[q.byk %& sob]))
?~(sob abet abet:(emit %info write+~ our `toro:clay`[i.t.sev %& sob]))
=+ pax=`path`/web/plan
=+ paf=(en-beam beak-now (flop pax))
?~ [fil:.^(arch %cy paf)]

2
mar/json.hoon
View File

@ -12,7 +12,7 @@
::
++ grow :: convert to
|%
++ mime [/application/json (as-octs:mimes txt)] :: convert to %mime
++ mime [/application/json (as-octs:mimes txt)] :: convert to %mime
++ txt (crip (en-json jon))
--
++ grab

11
mar/noun.hoon Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hoon/noun/mar
::
/? 310
!:
:::: A minimal noun mark
|_ non/*
++ grab |%
++ noun *
--
--

3
mar/plan.hoon
View File

@ -44,7 +44,8 @@
(malt (turn t.t.a |=(b/cord (rash b account))))
::
++ user ;~(pfix (jest 'User ') (cook crip (star prn)))
++ knot (sear (flit |=(a/^knot !=('' a))) urs:ab)
++ knot %+ cook crip
(plus ;~(pose nud low hig hep dot sig cab))
++ location ;~(pfix (jest 'Location ') (cook crip (star prn)))
++ account
;~ plug

11
mar/sole/action.hoon
View File

@ -27,11 +27,18 @@
|= c/json %. c
?.(=(%a -.c) b (pe -.a (ar +.a)))
::
++ change (ot ler+(at ni ni ~) ted+(cu |*(a/* [0v0 a]) edit) ~)
++ ke :: callbacks
|* {gar/* sef/(trap fist)}
|= jon/json ^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ change (ot ler+(at ni ni ~) ted+(pe 0v0 edit) ~)
++ char (cu turf so)
++ edit
%+ ke *sole-edit |. ~+
%+ fo %nop
%+ ra mor+|=(json (edit +<))
%+ ra mor+edit
(of del+ni set+(cu tuba sa) ins+(ot at+ni cha+char ~) ~)
--
::

5
mar/talk/telegrams.hoon
View File

@ -87,6 +87,7 @@
fat+(ot tor+tors taf+spec ~)
ext+(ot nom+so txe+blob ~)
non+ul
mor+(ar spec)
:: inv+(ot ship+(su fed:ag) party+(su urs:ab) ~)
==
++ tors
@ -161,6 +162,10 @@
$fat (jobe tor+(tors p.a) taf+$(a q.a) ~)
$ext (jobe nom+[%s p.a] txe+(jape (sifo (jam +.a))) ~)
$non ~
$mor :- %a
|- ^- (list json)
?~ p.a ~
[^$(a i.p.a) $(p.a t.p.a)]
:: $inv (jobe ship+(jope p.a) party+[%s q.a] ~)
==
::

24
mar/umd.hoon Normal file
View File

@ -0,0 +1,24 @@
::
:::: /hoon/umd/mar
::
/? 310
::
|_ mud/@t
++ grow
|%
++ mime [/text/x-unmark (taco mud)]
++ txt
(lore mud)
++ elem
^- manx
[/div ~(shut ap %xml (rash mud fenced:cram:vast))]
--
++ grab
|%
++ mime |=({p/mite q/octs} q.q)
++ noun @t
++ txt role
--
++ grad %txt
++ garb /down
--

11
mar/will.hoon Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hoon/will/mar
::
/? 310
|_ wyl/(unit wyll:ames)
::
++ grab :: convert from
|%
++ noun (unit wyll:ames) :: clam from %noun
--
--

11
mar/womb/do-claim.hoon Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hoon/do-claim/womb/mar
::
/? 310
|_ {her/ship tik/@p}
::
++ grab :: convert from
|%
++ noun {ship @p} :: clam from %noun
--
--

11
mar/womb/do-ticket.hoon Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hoon/do-ticket/womb/mar
::
/? 310
|_ her/ship
::
++ grab :: convert from
|%
++ noun @p :: clam from %noun
--
--

7
mar/womb/invite.hoon
View File

@ -6,12 +6,14 @@
::
:::: ~fyr
::
=* invite invite:womb
=* reference reference:womb
=, old-zuse
|_ {cord invite}:womb
|_ {cord reference invite}
::
++ grab :: convert from
|%
++ noun {cord invite}:womb :: clam from %noun
++ noun {cord reference invite} :: clam from %noun
++ json
%+ corl need
=> jo
@ -22,6 +24,7 @@
==
%- ot :~
tid+so
ref+(mu (su (pick ;~(pfix (jest '0v') viz:ag) mail)))
inv+(ot who+(su mail) pla+ni sta+ni wel+(ot intro+sa hello+sa ~) ~)
==
--

10847
neo/hoon.hoon
View File

File diff suppressed because it is too large Load Diff

1099
neo/lull.hoon
View File

File diff suppressed because it is too large Load Diff

2229
neo/van/ames.hoon
View File

File diff suppressed because it is too large Load Diff

225
neo/van/behn.hoon
View File

@ -1,225 +0,0 @@
!: :: %behn, just a timer
!? 164
::::
=, behn
|= pit/vase
=> =~
|%
++ sqeu |* {a/_* b/_*} :: binary skew queno
$: r/@u :: rank+depth
k/a :: priority
n/b :: value
c/(broq a b) :: children
== ::
++ broq |* {a/_* b/_*} :: brodal skew qeu
(list (sqeu a b)) ::
++ move {p/duct q/(wind note gift:able)} :: local move
++ note $~ :: out request $->
++ sign $~ :: in result $<-
++ clok (broq @da duct) :: stored timers
--
::
|%
++ raze
|= tym/{p/clok q/clok}
^+ tym
?~ p.tym tym
?~ q.tym tym
?: (gth p:~(get up p.tym) p:~(get up q.tym)) :: killed nonexisting
~& [%snooze-lost del=p:~(get up q.tym) top=p:~(get up p.tym)]
$(q.tym ~(pop up q.tym))
?: =(~(get up p.tym) ~(get up q.tym))
$(tym [~(pop up p.tym) ~(pop up q.tym)])
tym
::
++ up :: priority queue
=+ [key=@da val=duct]
=+ cmp=lte :: lte=min, gte=max
=> |%
++ link
|= {p/(sqeu key val) q/(sqeu key val)} :: link eq rank
^- (sqeu key val)
?> =(r.p r.q)
?: (cmp k.p k.q)
[r=+(r.p) k=k.p n=n.p c=[i=q t=c.p]]
[r=+(r.q) k=k.q n=n.q c=[i=p t=c.q]]
::
++ sink :: skew link
|= {p/(sqeu key val) q/(sqeu key val) r/(sqeu key val)}
^- (sqeu key val)
?: &((cmp k.q k.p) (cmp k.q k.r))
[r=+(r.q) k=k.q n=n.q c=[i=p t=[i=r t=c.q]]]
?: &((cmp k.r k.p) (cmp k.r k.q))
[r=+(r.r) k=k.r n=n.r c=[i=p t=[i=q t=c.r]]]
[r=+(r.q) k=k.p n=n.p c=[i=q t=[i=r t=~]]]
::
++ sert :: internal ins op
|= {p/(sqeu key val) q/(broq key val)}
^- (broq key val)
?~ q [p ~]
?> (lte r.p r.i.q)
?: (lth r.p r.i.q)
[i=p t=q]
$(p (link p i.q), q t.q)
::
++ uniq :: remove init dup
|= q/(broq key val)
?~ q ~
(sert i.q t.q)
::
++ meek :: unique meld
|= {p/(broq key val) q/(broq key val)}
^- (broq key val)
?~ p q
?~ q p
?: (lth r.i.p r.i.q)
[i.p $(p t.p)]
?: (lth r.i.q r.i.p)
[i.q $(q t.q)]
(sert (link i.p i.q) $(p t.p, q t.q))
::
++ mini :: getmin
|= q/(broq key val)
^- p/{(sqeu key val) (broq key val)}
?~ q ~|(%fatal-mini-empty !!)
?~ t.q [i=i.q t=~]
=+ [l r]=$(q t.q)
?: (cmp k.i.q k.l)
[i.q t.q]
[l [i.q r]]
::
++ spit :: split
|= {p/(broq key val) q/(list {k/key n/val}) r/(broq key val)}
^- {t/(broq key val) x/(list {k/key n/val})}
?~ r
[t=p x=q]
?: =(0 r.i.r)
$(q [[k=k.i.r n=n.i.r] q], r t.r)
$(p [i.r p], r t.r)
--
|_ a/(broq key val) :: public interface
++ put :: insert element
|= {k/key n/val}
^+ a
?~ a [i=[r=0 k=k n=n c=~] t=~]
?~ t.a [i=[r=0 k=k n=n c=~] t=a]
?: =(r.i.a r.i.t.a)
[i=(sink [r=0 k=k n=n c=~] i.a i.t.a) t=t.t.a]
[i=[r=0 k=k n=n c=~] t=a]
::
++ pop :: remove top
^+ a
=+ ?~ a ~|(%empty-broq-pop !!)
[l r]=(mini a)
=+ [t x]=(spit ~ ~ c.l)
=. a r
=. a (uni t)
(gas x)
::
++ gas
|= b/(list {k/key n/val})
^+ a
(roll b |=({{k/key n/val} q/_a} (put(a q) k n)))
::
++ tap
^- (list {k/key n/val})
?~ a ~
[get tap(a pop)]
::
++ get :: retrieve top
^- {p/key q/val}
?~ a ~|(%empty-broq-peek !!)
?~ t.a [k n]:i.a
=+ m=get(a t.a)
?.((cmp k.i.a p.m) m [k n]:i.a)
::
++ uni :: merge
|= q/(broq key val)
^+ a
(meek (uniq a) (uniq q))
--
--
. ==
=| $: $0 ::
tym/{p/clok q/clok} :: positive+negative
== ::
|= {now/@da eny/@ ski/sley} :: current invocation
^?
|% :: poke+peek pattern
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
==
^- {p/(list move) q/_..^$}
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=($soft -.q.hic)
:: ~& [%behn-call-soft (,@tas `*`-.p.q.hic)]
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%behn-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
==
=^ mof tym
?- -.q.hic
$rest
=. q.tym (~(put up q.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
::
$wait
=. p.tym (~(put up p.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
::
$wake
|- ^+ [*(list move) tym]
=. tym (raze tym)
?: =([~ ~] tym) [~ tym] :: XX TMI
?: =(~ p.tym)
~& %weird-wake [~ tym]
=+ nex=~(get up p.tym)
?: (lte now p.nex) [~ tym]
=^ mof tym $(p.tym ~(pop up p.tym))
[[`move`[q.nex %give %wake ~] mof] tym]
::
$wegh
:_ tym :_ ~
:^ hen %give %mass
:- %behn
:- %|
:~ tym+[%& tym]
==
==
[mof ..^$]
::
++ doze
|= {now/@da hen/duct}
^- (unit @da)
?~ p.tym ~
(some p:[~(get up p.tym)])
::
++ load
|= old/{$0 tym/{clok clok}}
^+ ..^$
..^$(tym tym.old)
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
^- (unit (unit cage))
?. ?=($& -.why) ~
=* who p.why
=+ ^= liz
|- ^- (list {@da duct})
=. tym (raze tym)
?~ p.tym ~
[~(get up p.tym) $(p.tym ~(pop up p.tym))]
[~ ~ %tank !>(>liz<)]
::
++ stay [%0 tym]
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
!!
--

3726
neo/van/clay.hoon
View File

File diff suppressed because it is too large Load Diff

537
neo/van/dill.hoon
View File

@ -1,537 +0,0 @@
!:
:: dill (4d), terminal handling
::
|= pit/vase
=, dill
=> |% :: interface tiles
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ all-axle ?(old-axle axle) ::
++ old-axle :: all dill state
$: $2 ::
ore/(unit ship) :: identity once set
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
== ::
++ axle ::
$: $3 ::
ore/(unit ship) :: identity once set
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
$= hef :: other weights
$: a/(unit mass) ::
b/(unit mass) ::
c/(unit mass) ::
e/(unit mass) ::
f/(unit mass) ::
g/(unit mass) ::
== ::
== ::
++ axon :: dill per duct
$: ram/term :: console program
tem/(unit (list dill-belt)) :: pending, reverse
wid/_80 :: terminal width
pos/@ud :: cursor position
see/(list @c) :: current line
== ::
-- => ::
|% :: protocol outward
++ mess ::
$% {$dill-belt p/(hypo dill-belt)} ::
== ::
++ move {p/duct q/(wind note gift:able)} :: local move
++ note-ames :: weird ames move
$% {$make p/(unit @t) q/@ud r/@ s/?} ::
{$sith p/@p q/@uw r/?} ::
== ::
++ note-clay ::
$% {$merg p/@p q/@tas r/@p s/@tas t/case u/germ:clay}:: merge desks
{$warp p/sock q/riff:clay} :: wait for clay hack
== ::
++ note-dill :: note to self, odd
$% {$crud p/@tas q/(list tank)} ::
{$heft $~} ::
{$init p/ship} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: reboot by path
{$velo p/@t q/@t} :: reboot by path
{$verb $~} :: verbose mode
== ::
++ note-gall ::
$% {$conf dock $load ship desk} ::
{$deal p/sock q/cush:gall} ::
== ::
++ note :: out request $->
$? {?($a $b $c $e $f $g) $wegh $~} ::
$% {$a note-ames} ::
{$c note-clay} ::
{$d note-dill} ::
{$g note-gall} ::
== == ::
++ sign-ames ::
$% {$nice $~} ::
{$init p/ship} ::
== ::
++ sign-clay ::
$% {$mere p/(each (set path) (pair term tang))} ::
{$note p/@tD q/tank} ::
{$writ p/riot:clay} ::
== ::
++ sign-dill ::
$% {$blit p/(list blit)} ::
== ::
++ sign-gall ::
$% {$onto p/(each suss:gall tang)} ::
{$unto p/cuft:gall} ::
== ::
++ sign :: in result $<-
$? {?($a $b $c $e $f $g) $mass p/mass} ::
$% {$a sign-ames} ::
{$c sign-clay} ::
{$d sign-dill} ::
{$g sign-gall} ::
== == ::
:::::::: :: dill tiles
--
=| all/axle
|= {now/@da eny/@ ski/sley} :: current invocation
=> |%
++ as :: per cause
|_ $: {moz/(list move) hen/duct our/ship}
axon
==
++ abet :: resolve
^- {(list move) axle}
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
++ call :: receive input
|= kyz/task:able
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
$flow +>
$harm +>
$hail (send %hey ~)
$belt (send `dill-belt`p.kyz)
$text (from %out (tuba p.kyz))
$crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
$blew (send %rez p.p.kyz q.p.kyz)
$heft heft
$tick =+ ^= ges ^- gens:ames
:- %en
=+ can=(clan:title p.kyz)
?- can
$czar [%czar ~]
$duke [%duke %anon ~]
$earl [%earl (scot %p p.kyz)]
$king [%king (scot %p p.kyz)]
$pawn [%pawn ~]
==
=+ yen=(scot %p (shax :(mix %ticket eny now)))
=+ ^= beg ^- {his/@p tic/@p yen/@t ges/gens:ames}
[p.kyz q.kyz yen ges]
=+ cmd=[%hood %poke `cage`[%helm-begin !>(beg)]]
%= +>.$
moz
:_(moz [hen %pass ~ %g %deal [our our] cmd])
==
$veer (dump kyz)
$vega (dump kyz)
$velo (dump kyz)
$verb (dump kyz)
==
::
++ crud
|= {err/@tas tac/(list tank)}
=+ ^= wol ^- wall
:- (trip err)
(zing (turn (flop tac) |=(a/tank (~(win re a) [0 wid]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (from %out (tuba i.wol)))
::
++ dump :: pass down to hey
|= git/gift:able
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
::
++ done :: return gift
|= git/gift:able
+>(moz :_(moz [hen %give git]))
::
++ from :: receive belt
|= bit/dill-blit
^+ +>
?: ?=($mor -.bit)
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
?: ?=($out -.bit)
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=($klr -.bit)
%+ done %blit
:~ [%lin (cvrt:ansi p.bit)]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=($pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
?: ?=($pom -.bit)
=. see (cvrt:ansi p.bit)
(done %blit [[%lin see] [%hop pos] ~])
?: ?=($hop -.bit)
(done(pos p.bit) %blit [bit ~])
?: ?=($qit -.bit)
(dump %logo ~)
(done %blit [bit ~])
::
++ ansi
|%
++ cvrt :: stub to (list @c)
|= a/stub :: with ANSI codes
^- (list @c)
%- zing %+ turn a
|= a/(pair stye (list @c))
^- (list @c)
;: weld
?: =(0 ~(wyt in p.p.a)) ~
`(list @c)`(zing (turn (~(tap in p.p.a)) ef))
(bg p.q.p.a)
(fg q.q.p.a)
q.a
?~(p.p.a ~ (ef ~))
(bg ~)
(fg ~)
==
::
++ ef |=(a/^deco (scap (deco a))) :: ANSI effect
::
++ fg |=(a/^tint (scap (tint a))) :: ANSI foreground
::
++ bg :: ANSI background
|= a/^tint
%- scap
=>((tint a) [+(p) q]) :: (add 10 fg)
::
++ scap :: ANSI escape seq
|= a/$^((pair @ @) @)
%- (list @c)
:+ 27 '[' :: "\033[{a}m"
?@(a :~(a 'm') :~(p.a q.a 'm'))
::
++ deco :: ANSI effects
|= a/^deco ^- @
?- a
$~ '0'
$br '1'
$un '4'
$bl '5'
==
::
++ tint :: ANSI colors (fg)
|= a/^tint
^- (pair @ @)
:- '3'
?- a
$k '0'
$r '1'
$g '2'
$y '3'
$b '4'
$m '5'
$c '6'
$w '7'
$~ '9'
==
--
::
++ heft
%_ .
moz
:* [hen %pass /heft/ames %a %wegh ~]
[hen %pass /heft/behn %b %wegh ~]
[hen %pass /heft/clay %c %wegh ~]
[hen %pass /heft/eyre %e %wegh ~]
[hen %pass /heft/ford %f %wegh ~]
[hen %pass /heft/gall %g %wegh ~]
moz
==
==
::
++ init :: initialize
~& [%dill-init our ram]
=+ myt=(flop (need tem))
=+ can=(clan:title our)
=. tem ~
=. moz :_(moz [hen %pass / %c %merg our %home our %base da+now %init])
=. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]])
=. +> ?: ?=(?($czar $pawn) can) +>
(sync %base (sein:title our) %kids)
=. +> ?: ?=(?($czar $pawn) can)
(sync %home our %base)
(init-sync %home our %base)
=. +> ?. ?=(?($duke $king $czar) can) +>
(sync %kids our %base)
=. +> autoload
=. +> peer
|- ^+ +>+
?~ myt +>+
$(myt t.myt, +>+ (send i.myt))
::
++ into :: preinitialize
|= gyl/(list gill)
%_ +>
tem `(turn gyl |=(a/gill [%yow a]))
moz
:_ moz
:* hen
%pass
/
%c
[%warp [our our] %base `[%sing %y [%ud 1] /]]
==
==
::
++ send :: send action
|= bet/dill-belt
?^ tem
+>(tem `[bet u.tem])
%_ +>
moz
:_ moz
[hen %pass ~ %g %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
==
++ peer
%_ .
moz
:_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum])
==
::
++ sync
|= syn/{desk ship desk}
%_ +>.$
moz
:_ moz
:* hen %pass /sync %g %deal [our our]
ram %poke %hood-sync -:!>(syn) syn
==
==
::
++ init-sync
|= syn/{desk ship desk}
%_ +>.$
moz
:_ moz
:* hen %pass /init-sync %g %deal [our our]
ram %poke %hood-init-sync -:!>(syn) syn
==
==
::
++ autoload
%_ .
moz
:_ moz
:* hen %pass /autoload %g %deal [our our]
ram %poke %kiln-start-autoload [%atom %n `~] ~
==
==
::
++ pump :: send diff ack
%_ .
moz
:_(moz [hen %pass ~ %g %deal [our our] ram %pump ~])
==
::
++ take :: receive
|= sih/sign
^+ +>
?- sih
{?($a $b $c $e $f $g) $mass *}
(wegt -.sih p.sih)
::
{$a $nice *}
:: ~& [%take-nice-ames sih]
+>
::
{$a $init *}
+>(moz :_(moz [hen %give +.sih]))
::
{$c $mere *}
?: ?=($& -.p.sih)
+>.$
(mean:error:userlib >%dill-mere-fail< >p.p.p.sih< q.p.p.sih)
::
{$g $onto *}
:: ~& [%take-gall-onto +>.sih]
?- -.+>.sih
$| (crud %onto p.p.+>.sih)
$& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
{$g $unto *}
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
$coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
$quit peer
$reap ?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
$diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
$doff !!
==
::
{$c $note *}
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
{$c $writ *}
init
::
{$d $blit *}
(done +.sih)
==
::
++ wegh
^- mass
:- %dill
:- %|
:~ all+[%& [ore hey dug]:all]
==
::
++ wegt
|= {lal/?($a $b $c $e $f $g) mas/mass}
^+ +>
=. hef.all
?- lal
$a ~?(?=(^ a.hef.all) %double-mass-a hef.all(a `mas))
$b ~?(?=(^ b.hef.all) %double-mass-b hef.all(b `mas))
$c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas))
$e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas))
$f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas))
$g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
==
?. ?& ?=(^ a.hef.all)
?=(^ b.hef.all)
?=(^ c.hef.all)
?=(^ e.hef.all)
?=(^ f.hef.all)
?=(^ g.hef.all)
==
+>.$
%+ done(hef.all [~ ~ ~ ~ ~ ~])
%mass
=> [hef.all d=wegh]
[%vanes %| ~[u.a u.c d u.e u.f u.g u.b]]
--
::
++ ax :: make ++as
|= {hen/duct kyz/task:able} ::
?~ ore.all ~
=+ nux=(~(get by dug.all) hen)
?^ nux
(some ~(. as [~ hen u.ore.all] u.nux))
?. ?=($flow -.kyz) ~
%- some
%. q.kyz
%~ into as
:- [~ hen u.ore.all]
:* p.kyz
[~ ~]
80
0
(tuba "<awaiting {(trip p.kyz)}, this may take a few minutes>")
== ==
--
|% :: poke+peek pattern
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
==
^+ [p=*(list move) q=..^$]
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=($soft -.q.hic)
:: ~& [%dill-call-soft (@tas `*`-.p.q.hic)]
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%dill-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
==
?: ?=($boot -.q.hic)
:_(..^$ [hen %pass ~ (note %a p.q.hic)]~)
?: ?=($flog -.q.hic)
:: ~& [%dill-flog +.q.hic]
?: ?=({$crud $hax-init {$leaf *} $~} p.q.hic)
=+ him=(slav %p (crip p.i.q.p.q.hic))
:_(..^$ ?~(hey.all ~ [u.hey.all %give %init him]~))
?: ?=({$crud $hax-heft $~} p.q.hic)
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d %heft ~]~))
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~))
=. hey.all ?^(hey.all hey.all `hen)
?: ?=($init -.q.hic)
:: ~& [%cnhp-init hen]
?: =(ore.all `p.q.hic)
[[hen %give q.hic]~ ..^$]
=: ore.all `p.q.hic
dug.all ~
==
=^ moz all abet:(need (ax (need hey.all) [%flow %hood ~]))
?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.q.hic]) ..^$]
=+ nus=(ax hen q.hic)
?~ nus
~& [%dill-no-flow q.hic]
[~ ..^$]
=^ moz all abet:(call:u.nus q.hic)
[moz ..^$]
::
++ doze
|= {now/@da hen/duct}
^- (unit @da)
~
::
++ load :: trivial
|= old/all-axle
?: ?=($2 -.old)
$(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old)
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
^- (unit (unit cage))
?. ?=($& -.why) ~
=* his p.why
[~ ~]
::
++ stay all
::
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
?: =(~ ore.all)
?: ?=({$a $init *} q.hin)
:: ~& [%take-init hen]
=. hey.all ?^(hey.all hey.all `hen)
[[[hen %give +.q.hin] ~] ..^$]
:: [~ ..^$]
~& [%take-back q.hin]
[~ ..^$]
?. (~(has by dug.all) hen)
~& [%take-weird-sign q.hin]
~& [%take-weird-hen hen]
[~ ..^$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
[moz ..^$]
--

2188
neo/van/eyre.hoon
View File

File diff suppressed because it is too large Load Diff

1988
neo/van/ford.hoon
View File

File diff suppressed because it is too large Load Diff

1327
neo/van/gall.hoon
View File

File diff suppressed because it is too large Load Diff

2155
neo/van/jael.hoon
View File

File diff suppressed because it is too large Load Diff

1247
neo/van/xmas.hoon
View File

File diff suppressed because it is too large Load Diff

3562
neo/zuse.hoon
View File

File diff suppressed because it is too large Load Diff

2
ren/rss-xml.hoon
View File

@ -19,7 +19,7 @@
:: urb:front attrs confuse RSS validators, readers
=+ no-meta=|=(a/marl ^+(a ?~(a ~ ?.(?=($meta n.g.i.a) a $(a t.a)))))
::
%- crip %- print
%- crip %- en-xml
;rss(version "2.0")
;channel
;title: *{hed.sum}

12
ren/tree/body.hoon
View File

@ -8,8 +8,18 @@
==
=, format
=, html
::
|%
++ script-safe
!.
|= a/tape ^- tape
?~ a a
?. ?=({$'<' $'/' *} a) [i.a $(a t.a)]
['<' '\\' '/' $(a t.t.a)]
--
::
^- marl
=/ tree (en-json (pairs:enjs data+dat sein+dat-sen ~))
=/ tree (script-safe (en-json (pairs:enjs data+dat sein+dat-sen ~)))
;= ;script(type "text/javascript"): window.tree = {tree}
;div#tree;
==

5
ren/tree/head.hoon
View File

@ -3,7 +3,7 @@
::
::
/? 310
/= tub /$ |=({bem/beam *} (flop s.bem))
/= tub /$ |=({bem/beam *} (slag (lent /web) (flop s.bem)))
/= aut
/$ %+ cork fuel:html :: after parsing params,
=, title
@ -16,6 +16,8 @@
|= gas/epic:eyre ^- {? ?} :: check if the query
:- (~(has by qix.gas) 'dbg.nopack') :: dictates separate files
(~(has by qix.gas) 'dbg.nomin') :: and/or unminified assets
/= extras /: /===/ren/tree/head/extras :: additional scripts
/^ (map knot cord) /_ /js/
::
|%
++ cdnjs
@ -46,6 +48,7 @@
;script(type "text/javascript", src "{(cdnjs "react/0.14.6/react")}");
;script(type "text/javascript", src "{(cdnjs "react/0.14.6/react-dom")}");
;script(type "text/javascript", src "{(cdnjs "flux/2.1.1/Flux")}");
;* (turn ~(tap by extras) |=({@ a/@t} ;script(type "text/javascript"):"{(trip a)}"))
:: ;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.js");
:: ;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/".
:: "codemirror/4.3.0/mode/markdown/markdown.min.js");

8
ren/tree/json.hoon
View File

@ -19,11 +19,11 @@
++ plist (list {term $@(mark plist)})
++ query
$% {$kids p/(list query)}
{$ktts $t}
{$name $t}
{$path $t}
{$spur $t}
::
{$dtls $t}
{$bump $t}
{$beak $t}
{$comt $j}
{$plan $j}
@ -56,11 +56,11 @@
|= a/query
:- -.a
?- -.a
$ktts (from-type +.a ?^(s.bem i.s.bem q.bem))
$name (from-type +.a ?^(s.bem i.s.bem q.bem))
$beak (from-type +.a (crip (spud (en-beam bem(s /)))))
$path (from-type +.a (crip (spud (flop s.bem))))
$spur (from-type +.a (crip (spud s.bem)))
$dtls (from-type +.a bump.dat)
$bump (from-type +.a bump.dat)
$plan (from-type +.a plan.dat)
$comt (from-type +.a comt.dat)
$head (from-type +.a head.dat)

2
ren/urb/tree.hoon
View File

@ -3,7 +3,7 @@
:::: /hoon/tree/urb/ren
::
/? 310
/= hed /# /% /: /===/ren /tree-head/ :: XX static
/= hed /# /% /tree-head/
/= bod /# /% /tree-body/
^- {hed/{@uvH marl} bod/{@uvH marl}}
[hed bod]

2
sec/com/asana.hoon
View File

@ -13,7 +13,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.

2
sec/com/digitalocean.hoon
View File

@ -13,7 +13,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.

2
sec/com/dropboxapi.hoon
View File

@ -13,7 +13,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.

6
sec/com/facebook.hoon
View File

@ -13,7 +13,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) access-token/token:oauth2}
|_ {bal/(bale:eyre keys:oauth2) access-token/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
@ -29,12 +29,12 @@
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
::
++ receive-auth-response
|= a/httr ^- core-move:aut
|= a/httr:eyre ^- core-move:aut
?: (bad-response:aut p.a)
[%give a] :: [%redo ~] :: handle 4xx?
=+ `{access-token/@t expires-in/@u}`(grab-expiring-token:aut a)
?. (lth expires-in ^~((div ~d7 ~s1))) :: short-lived token
[[%redo ~] ..bak(access-token access-token)]
[[%redo ~] +>.$(access-token access-token)]
:- %send
%^ request-token:aut exchange-url
grant-type='fb_exchange_token'

2
sec/com/github.hoon
View File

@ -4,7 +4,7 @@
::
/+ basic-auth
::
|_ {bal/(bale keys:basic-auth) $~}
|_ {bal/(bale:eyre keys:basic-auth) $~}
++ aut ~(standard basic-auth bal ~)
++ filter-request out-adding-header:aut
--

6
sec/com/googleapis.hoon
View File

@ -16,14 +16,14 @@
==
::
++ auth-usr
|= usr/iden
|= usr/user:eyre
=+ lon=(fall (slaw %t usr) usr)
%+ add-query:interpolate 'https://accounts.google.com/o/oauth2/v2/auth'
%- quay:hep-to-cab
:~ login-hint+?~(lon '' (crip (rash lon suffix-email)))
access-type+%offline
response-type+%code
prompt+%clhpent
prompt+%consent
==
++ scopes
:~ 'https://mail.google.com'
@ -36,7 +36,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) own/user-state}
|_ {bal/(bale:eyre keys:oauth2) own/user-state}
:: ++auth is a "standard refreshing oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.

2
sec/com/instagram.hoon
View File

@ -13,7 +13,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.

2
sec/com/slack.hoon
View File

@ -6,7 +6,7 @@
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.

2
sec/com/twitter.hoon
View File

@ -6,7 +6,7 @@
::
::::
::
|_ {bal/(bale keys:oauth1) tok/token:oauth1}
|_ {bal/(bale:eyre keys:oauth1) tok/token:oauth1}
:: ++aut is a "standard oauth1" core, which implements the
:: most common handling of oauth1 semantics. see lib/oauth1 for more details,
:: and examples at the bottom of the file.

4
sur/sole.hoon
View File

@ -86,8 +86,8 @@
{$get $-((sole-args) (sole-request (cask)))} :: scraper
== ::
++ sole-args :: generator arguments
|* _[* *] ::
{{now/@da eny/@uvJ bek/beak} {+<- +<+}} ::
|* _[* *] ::
{{now/@da eny/@uvJ bek/beak} {,+<- ,+<+}} ::
:: ::
:: ::
++ sole-so :: construct result

6
sur/twitter.hoon
View File

@ -63,9 +63,9 @@
++ endpoint (normalize (fork-clams (heads doc-data)))
++ heads |*(a/(pole) ?~(a a [-<.a (heads +.a)]))
++ fork-clams
|* a/{_{term *} (pole _{term *})} :: ^- _{term *}
?~ +.a -.a
?(-.a (fork-clams +.a))
|* a/(pair _{term *} (pole _{term *})) :: ^- _{term *}
?~ q.a p.a
?(p.a (fork-clams q.a))
::
++ normalize :: XX smarter pretty-printing
|* a/_{@ *} :: ^+ a

4
sys/arvo.hoon
View File

@ -498,7 +498,7 @@
++ peek :: external inspect
|= {now/@da hap/path}
^- (unit)
?~ hap [~ hoon]
?~ hap [~ hoon-version]
=+ rob=((sloy ~(beck (is vil eny mast niz) now)) [151 %noun] hap)
?~ rob ~
?~ u.rob ~
@ -573,7 +573,7 @@
::
:: find the hoon version number of the new kernel
::
=+ nex=(@ .*(cop q:(~(mint ut p.raw) %noun [%limb %hoon])))
=+ nex=(@ .*(cop q:(~(mint ut p.raw) %noun [%limb %hoon-version])))
?> |(=(nex hoon) =(+(nex) hoon))
::
:: if we're upgrading language versions, recompile the compiler

777
sys/hoon.hoon
View File

@ -1,16 +1,15 @@
:: ::
:::: /sys/hoon ::
:: ::
~> %slog.[0 leaf+"hoon-assembly"]
=< ride
=> %143 =>
:: ::
:::: 0: version stub ::
:: ::
~% %k.143 ~ ~ ::
!:
|%
++ foo 0
++ hoon +
++ hoon-version +
-- =>
:: ::
:::: 1: layer one ::
@ -21,13 +20,12 @@
::
~% %one + ~
|%
++ foo 0
:: ::
:::: 1a: unsigned arithmetic ::
::
++ add :: unsigned addition
~/ %add
|= {a/@ b/@}
|= [a=@ b=@]
^- @
?: =(0 a) b
$(a (dec a), b +(b))
@ -207,7 +205,6 @@
::
~% %two + ~
|%
++ foo 0
:: ::
:::: 2a: unit logic ::
:: ::
@ -1542,15 +1539,12 @@
:: ::
::
++ ly :: list from raw noun
|* a/*
le:nl
::
++ my :: map from raw noun
|* a/*
my:nl
::
++ sy :: set from raw noun
|* a/*
si:nl
::
++ nl
@ -1634,6 +1628,17 @@
=+ gol=(han fud)
?.(=(gol fud) ~ [~ gol])
::
++ slog :: deify printf
=| pri/@ :: priority level
|= a/tang ^+ same :: .= ~&(%a 1)
?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1)
:: ::
++ mean :: crash with trace
|= a/tang
^+ !!
?~ a !!
~_(i.a $(a t.a))
::
++ tail |*(^ ,:+<+) :: get tail
++ test |=(^ =(+<- +<+)) :: equality
::
@ -1769,7 +1774,6 @@
:: ::
~% %tri + ~
|%
++ foo 0
::
:::: 3a: signed and modular ints ::
:: ::
@ -3490,7 +3494,6 @@
%show show
==
|%
++ foo 0
::
:::: 4a: exotic bases
::
@ -5692,7 +5695,6 @@
%ut ut
==
|%
++ foo 0
::
:::: 5a: compiler utilities
::
@ -6808,8 +6810,8 @@
::
{$zpwt *}
?: ?: ?=(@ p.gen)
(lte hoon p.gen)
&((lte hoon p.p.gen) (gte hoon q.p.gen))
(lte hoon-version p.gen)
&((lte hoon-version p.p.gen) (gte hoon-version q.p.gen))
q.gen
~_(leaf+"hoon-version" !!)
::
@ -8508,7 +8510,6 @@
::
ref/span
==
~+
:: :span: subject refurbished to reference namespace
::
^- span
@ -8587,8 +8588,8 @@
?=(?($noun $void {?($atom $core) *}) ref)
==
done
~_ (dunk 'redo: dext: sut')
~_ (dunk(sut ref) 'redo: dext: ref')
:: ~_ (dunk 'redo: dext: sut')
:: ~_ (dunk(sut ref) 'redo: dext: ref')
?- sut
?($noun $void {?($atom $core) *})
:: reduce reference and reassemble leaf
@ -8660,8 +8661,8 @@
=/ lov
=/ lov dear
?~ lov
~_ (dunk 'redo: dear: sut')
~_ (dunk(sut ref) 'redo: dear: ref')
:: ~_ (dunk 'redo: dear: sut')
:: ~_ (dunk(sut ref) 'redo: dear: ref')
~& [%wec wec]
!!
(need lov)
@ -9205,16 +9206,9 @@
%^ cat 3
%~ rent co
:+ %$ %ud
|- ^- @
?- q.s.q.sut
$~ 0
{* $~ $~} 1
{* $~ *} +($(q.s.q.sut r.q.s.q.sut))
{* * $~} +($(q.s.q.sut l.q.s.q.sut))
{* * *} .+ %+ add
$(q.s.q.sut l.q.s.q.sut)
$(q.s.q.sut r.q.s.q.sut)
== ==
%- ~(rep by (~(run by q.s.q.sut) |=(tomb ~(wyt by q))))
|=([[@ a=@u] b=@u] (add a b))
==
%^ cat 3
?-(p.q.sut $gold '.', $iron '|', $lead '?', $zinc '&')
=+ gum=(mug q.s.q.sut)
@ -9881,6 +9875,671 @@
?~ sim [i.reb $(reb t.reb, sim ~)]
[;/((flop sim)) i.reb $(reb t.reb, sim ~)]
--
::
++ cram :: parse unmark
=> |%
++ item (pair mite marl:twig) :: xml node generator
++ colm @ud :: column
++ flow marl:twig :: node or generator
++ mite :: context
$? $down :: outer embed
$rule :: horizontal ruler
$list :: unordered list
$lime :: list item
$lord :: ordered list
$poem :: verse
$bloc :: blockquote
$code :: preformatted code
$head :: heading
$expr :: dynamic expression
== ::
++ trig :: line style
$: col/@ud :: start column
sty/trig-style :: style
== ::
++ trig-style :: type of parsed line
$? $done :: end of input
$rule :: --- horizontal ruler
$lint :: + line item
$lite :: - line item
$head :: # heading
$bloc :: > block-quote
$expr :: ;sail expression
$text :: anything else
== ::
++ graf :: paragraph element
$% {$bold p/(list graf)} :: *bold*
{$talc p/(list graf)} :: _italics_
{$quod p/(list graf)} :: "double quote"
{$code p/tape} :: code literal
{$text p/tape} :: text symbol
{$link p/(list graf) q/tape} :: URL
{$expr p/tuna:twig} :: interpolated hoon
==
--
=< apex
|%
++ apex
=; fel |=(nail (fel +<))
:(stag %xray [%div ~] fenced)
::
++ fenced
::
:: top: original indentation level
::
|= {{@u top/@u} tape}
%+ pfix (hrul:parse +<)
|= nail ^- (like marl:twig)
~($ main top +<)
::
++ main
::
:: state of the parsing loop. we maintain a construction
:: stack for elements and a line stack for lines in the
:: current block. a blank line causes the current block
:: to be parsed and thrown in the current element. when
:: the indent column retreats, the element stack rolls up.
::
:: err: error position
:: col: current control column
:: hac: stack of items under construction
:: cur: current item under construction
:: lub: current block being read in
::
=| err/(unit hair)
=| col/@ud
=| hac/(list item)
=/ cur/item [%down ~]
=| lub/(unit (pair hair (list tape)))
|_ {top/@ud naz/hair los/tape}
::
++ $ :: resolve
^- (like flow)
=> line
::
:: if error position is set, produce error
?. =(~ err) [+.err ~]
::
:: all data was consumed
=- [naz `[- [naz los]]]
=> made
|- ^- flow
::
:: fold all the way to top
?~ hac fine
$(..^$ fold)
::
::+|
::
++ cur-indent
?- p.cur
$down 2
$rule 0
$head 0
$expr 2
$list 0
$lime 2
$lord 0
$poem 8
$code 4
$bloc 2
==
::
++ back :: column retreat
|= luc/@ud
^+ +>
?: =(luc col) +>
::
:: nex: next backward step that terminates this context
=/ nex/@ud cur-indent ::REVIEW code and poem blocks are handled elsewhere
?: (gth nex (sub col luc))
::
:: indenting pattern violation
::~& indent-pattern-violation+[p.cur nex col luc]
..^$(col luc, err `[p.naz luc])
=. ..^$ fold
$(col (sub col nex))
::
++ fine :: item to flow
^- flow
?: ?=(?($down $head $expr) p.cur)
(flop q.cur)
=- [[- ~] (flop q.cur)]~
?- p.cur
$rule %hr
$list %ul
$lord %ol
$lime %li
$code %pre
$poem %div ::REVIEW actual container element?
$bloc %blockquote
==
::
++ fold ^+ . :: complete and pop
?~ hac .
%= .
hac t.hac
cur [p.i.hac (concat-code (weld fine q.i.hac))]
==
::
++ concat-code :: merge continuous pre
|= a/flow
?~ a a
?. ?=({$pre *} -.i.a) a
|-
?~ t.a a
?. ?=({$pre $~} -.i.t.a) a
:: add blank line between blocks
$(t.a t.t.a, c.i.a (welp c.i.t.a ;/("\0a") c.i.a))
::
++ snap :: capture raw line
=| nap/tape
|- ^+ [nap +>]
::
:: no unterminated lines
?~ los
::~& %unterminated-line
[~ +>(err `naz)]
?. =(`@`10 i.los)
?: (gth col q.naz)
?. =(' ' i.los)
::~& expected-indent+[col naz los]
[~ +>(err `naz)]
$(los t.los, q.naz +(q.naz))
::
:: save byte and repeat
$(los t.los, q.naz +(q.naz), nap [i.los nap])
::
:: consume newline
:_ +>(los t.los, naz [+(p.naz) 1])
::
:: trim trailing spaces
|- ^- tape
?: ?=({$' ' *} nap)
$(nap t.nap)
(flop nap)
::
++ skip :: discard line
|- ^+ +
::
:: no unterminated lines
?~ los
::~& %unterminated-line
+(err `naz)
?. =(`@`10 i.los)
::
:: eat byte and repeat
$(los t.los)
::
:: consume newline
+(los t.los, naz [+(p.naz) 1])
::
++ look :: inspect line
^- (unit trig)
(wonk (look:parse naz los))
::
++ made :: compose block
^+ .
::
:: empty block, no action
?~ lub .
::
:: if block is preformatted code
?: ?=($code p.cur)
=- fold(lub ~, q.cur (weld - q.cur), col (sub col 4))
%+ turn q.u.lub
|= tape ^- mars
::
:: each line is text data with its newline
;/("{+<}\0a")
::
:: if block is verse
?: ?=($poem p.cur)
::
:: add break between stanzas
=. q.cur ?~(q.cur q.cur [[[%br ~] ~] q.cur])
=- fold(lub ~, q.cur (weld - q.cur), col (sub col 8))
%+ turn q.u.lub
|= tape ^- manx
::
:: each line is a paragraph
:- [%p ~]
:_ ~
;/("{+<}\0a")
::
:: yex: block recomposed, with newlines
=/ yex/tape
(zing (turn (flop q.u.lub) |=(a/tape (runt [(dec col) ' '] "{a}\0a"))))
::
:: vex: parse of paragraph
=/ vex/(like marl:twig)
::
:: either a one-line header or a paragraph
%. [p.u.lub yex]
%- full
?- p.cur
$rule =<(;~(pfix (punt whit) hrul) parse)
$expr expr:parse
$head head:parse
@ para:parse
==
::
:: if error, propagate correctly
?~ q.vex ..$(err `p.vex)
::
:: finish tag if it's a header or rule
=< ?:(?=(?($head $rule) p.cur) fold ..$)
::
:: save good result, clear buffer
..$(lub ~, q.cur (weld p.u.q.vex q.cur))
::
++ line ^+ . :: body line loop
::
=. col ?~(col top col)
::
:: abort after first error
?: !=(~ err) .
::
:: pic: profile of this line
=/ pic look
::
:: if line is blank
?~ pic
::
:: break section
line:made:skip
::
:: line is not blank
=> .(pic u.pic)
::
:: if end of input, complete
?: |(?=($done sty.pic) (lth col.pic top))
..$(q.naz col.pic)
::
:: bal: inspection copy of lub, current section
=/ bal lub
::
:: if within section
?~ bal (new-container pic)
::
:: detect unspaced new containers
?: ?& ?=(?($down $lime $bloc) p.cur)
|(!=(%text sty.pic) (gth col.pic col))
==
(new-container:made pic)
::
:: first line of container is legal
?~ q.u.bal
=^ nap ..$ snap
line(lub bal(q.u [nap q.u.bal]))
::
:: detect bad block structure
?. ?- p.cur
::
:: can't(/directly) contain text
?($lord $list) ~|(bad-leaf-container+p.cur !!)
::
:: only one line in a header/break
?($head $rule) |
::
:: literals need to end with a blank line
?($code $poem $expr) (gte col.pic col)
::
:: text flows must continue aligned
?($down $list $lime $lord $bloc) =(col.pic col)
==
::~& bad-block-structure+[p.cur col col.pic]
..$(err `[p.naz col.pic])
::
:: accept line and continue
=^ nap ..$ snap
line(lub bal(q.u [nap q.u.bal]))
::
++ new-container :: enter list/quote
|= pic/trig
::
:: if column has retreated, adjust stack
=. +>.$ ?. (lth col.pic col) +>.$ (back col.pic)
::
:: dif: columns advanced
:: erp: error position
::
=/ dif (sub col.pic col)
=/ erp [p.naz col.pic]
=. col col.pic
::
:: execute appropriate paragraph form
=< line:abet:apex
|%
::
++ abet :: accept line
::
:: nap: take first line
..$(lub `[naz ~])
::
++ apex ^+ . :: by column offset
?+ dif fail ::
$0 apse :: unindented forms
$4 (push %code) :: code literal
$8 (push %poem) :: verse literal
==
::
++ apse ^+ . :: by prefix style
?- sty.pic
$done !! :: blank
$rule (push %rule) :: horizontal ruler
$head (push %head) :: heading
$bloc (entr %bloc) :: blockquote line
$expr (entr %expr) :: hoon expression
$lite (lent %list) :: unnumbered list
$lint (lent %lord) :: numbered list
$text text :: anything else
==
::
++ fail .(err `erp) :: set error position
++ push |=(mite +>(hac [cur hac], cur [+< ~])):: push context
++ entr :: enter container
|= typ/mite
^+ +>
::
:: indent by 2
=. col (add 2 col)
::
:: "parse" marker
=. los (slag (sub col q.naz) los)
=. q.naz col
::
(push typ)
::
++ lent :: list entry
|= ord/?($lord $list)
^+ +>
:: can't switch list types
?: =(?-(ord $list %lord, $lord %list) p.cur)
fail
::
:: push list item
=< (entr %lime)
::
:: push list context, unless we're in list
?:(=(ord p.cur) ..push (push ord))
::
++ text :: plain text
^+ .
::
:: only in lists, fold
?. ?=(?($list $lord) p.cur) .
.(^$ fold)
--
--
::
++ parse :: individual parsers
|%
++ look :: classify line
%+ cook |=(a/(unit trig) a)
;~ pfix (star ace)
%+ here
|=({a/pint b/?($~ trig-style)} ?~(b ~ `[q.p.a b]))
;~ pose
(full (easy %done)) :: end of input
(cold ~ (just `@`10)) :: blank line
(cold %rule ;~(plug hep hep hep)) :: --- horizontal ruler
(cold %head ;~(plug (star hax) ace)) :: # heading
(cold %lite ;~(plug hep ace)) :: - line item
(cold %lint ;~(plug lus ace)) :: + line item
(cold %bloc ;~(plug gar ace)) :: > block-quote
(cold %expr sem) :: ;sail expression
(easy %text) :: anything else
==
==
::
++ cash :: escaped fence
|* tem/rule
%- echo
%- star
;~ pose
whit
;~(plug bas tem)
;~(less tem prn)
==
::
++ cool :: reparse
|* $: :: fex: primary parser
:: sab: secondary parser
::
fex/rule
sab/rule
==
|= {naz/hair los/tape}
^+ *sab
::
:: vex: fenced span
=/ vex/(like tape) (fex naz los)
?~ q.vex vex
::
:: hav: reparse full fenced text
=/ hav ((full sab) [naz p.u.q.vex])
::
:: reparsed error position is always at start
?~ q.hav [naz ~]
::
:: the complete span with the main product
:- p.vex
`[p.u.q.hav q.u.q.vex]
::
::REVIEW surely there is a less hacky "first or after space" solution
++ easy-sol :: parse start of line
|* a/*
|= b/nail
?: =(1 q.p.b) ((easy a) b)
(fail b)
::
++ echo :: hoon literal
|* sab/rule
|= {naz/hair los/tape}
^- (like tape)
::
:: vex: result of parsing wide twig
=/ vex (sab naz los)
::
:: use result of expression parser
?~ q.vex vex
=- [p.vex `[- q.u.q.vex]]
::
:: but replace payload with bytes consumed
|- ^- tape
?: =(q.q.u.q.vex los) ~
?~ los ~
[i.los $(los +.los)]
::
++ word :: flow parser
%+ knee *(list graf) |. ~+
%+ cook |=(a/?(graf (list graf)) ?+(a a {@ *} [a]~))
;~ pose
::
:: ordinary word
::
%+ stag %text
;~(plug ;~(pose low hig) (star ;~(pose nud low hig hep)))
::
:: naked \escape
::
(stag %text ;~(pfix bas (cook trip ;~(less ace prn))))
::
:: *bold literal*
::
(stag %bold (ifix [tar tar] (cool (cash tar) work)))
::
:: _italic literal_
::
(stag %talc (ifix [cab cab] (cool (cash cab) work)))
::
:: "quoted text"
::
(stag %quod (ifix [doq doq] (cool (cash doq) work)))
::
:: `classic markdown quote`
::
(stag %code (ifix [tec tec] (cash tec)))
::
:: ++arm
::
(stag %code ;~(plug lus lus low (star ;~(pose nud low hep))))
::
:: [arbitrary *content*](url)
::
%+ stag %link
;~ (glue (punt whit))
(ifix [sel ser] (cool (cash ser) work))
(ifix [pel per] (cash per))
==
::
:: #twig
::
;~ plug
(stag %text ;~(pose (cold " " whit) (easy-sol ~)))
(stag %code ;~(pfix hax (echo wide)))
;~(simu whit (easy ~))
==
::
:: direct hoon constant
::
;~ plug
(stag %text ;~(pose (cold " " whit) (easy-sol ~)))
::
%+ stag %code
%- echo
;~ pose
::REVIEW just copy in 0x... parsers directly?
;~(simu ;~(plug (just '0') alp) bisk:so)
::
tash:so
;~(pfix dot perd:so)
;~(pfix sig ;~(pose twid:so (easy [%$ %n 0])))
;~(pfix cen ;~(pose sym buc pam bar qut nuck:so))
==
::
;~(simu whit (easy ~))
==
::
:: whitespace
::
(stag %text (cold " " whit))
::
:: {interpolated} sail
::
(stag %expr inline-embed:(sail |))
::
:: just a byte
::
(stag %text (cook trip ;~(less ace prn)))
==
::
++ work (cook zing (star word)) :: indefinite flow
::
++ down :: parse inline flow
%+ knee *flow |. ~+
=- (cook - work)
::
:: collect raw flow into xml tags
|= gaf/(list graf)
^- flow
=< main
|%
++ main
^- flow
?~ gaf ~
?. ?=($text -.i.gaf)
(weld (item i.gaf) $(gaf t.gaf))
::
:: fip: accumulate text blocks
=/ fip/(list tape) [p.i.gaf]~
|- ^- flow
?~ t.gaf [;/((zing (flop fip))) ~]
?. ?=($text -.i.t.gaf)
[;/((zing (flop fip))) ^$(gaf t.gaf)]
$(gaf t.gaf, fip :_(fip p.i.t.gaf))
::
++ item
|= nex/graf
^- flow ::CHECK can be tuna:twig?
?- -.nex
$text !! :: handled separately
$expr [p.nex]~
$bold [[%b ~] ^$(gaf p.nex)]~
$talc [[%i ~] ^$(gaf p.nex)]~
$code [[%code ~] ;/(p.nex) ~]~
$quod ::
:: smart quotes
%= ^$
gaf
:- [%text (tufa ~-~201c. ~)]
%+ weld p.nex
`(list graf)`[%text (tufa ~-~201d. ~)]~
==
$link [[%a [%href q.nex] ~] ^$(gaf p.nex)]~
==
--
::
++ hrul :: empty besides fence
(cold ~ ;~(plug hep hep hep (star hep) (just '\0a')))
::
++ para :: paragraph
%+ cook
|=(a/flow ?~(a ~ [[%p ~] a]~))
;~(pfix (punt whit) down)
::
++ expr :: expression
%+ ifix [(punt whit) (punt whit)] :: whitespace surround
=> (sail &) :: tall-form
(cook drop-top top-level) :: list of tags
::
::
++ whit :: whitespace
(cold ' ' (plus ;~(pose (just ' ') (just '\0a'))))
::
++ head :: parse heading
%+ cook
|= a/manx:twig ^- marl:twig
=. a.g.a :_(a.g.a [%id (sanitize-to-id c.a)])
[a]~
::
;~ plug
::
:: # -> 1 -> %h1, ### -> 3 -> %h3, etc
:(cook |=(a/@u /(crip "h{<a>}")) lent (stun [1 6] hax))
::
;~(pfix whit down)
==
::
++ sanitize-to-id :: # text into elem id
|= a/(list tuna:twig) ^- tape
=; raw/tape
%+ turn raw
|= @tD
^- @tD
?: ?| &((gte +< 'a') (lte +< 'z'))
&((gte +< '0') (lte +< '9'))
==
+<
?: &((gte +< 'A') (lte +< 'Z'))
(add 32 +<)
'-'
::
:: collect all text in header flow
|- ^- tape
?~ a ~
%+ weld
^- tape
?- i.a
{{$$ {$$ *} $~} $~} :: text node contents
(murn v.i.a.g.i.a |=(a/beer:twig ?^(a ~ (some a))))
{^ *} $(a c.i.a) :: concatenate children
{@ *} ~ :: ignore interpolation
==
$(a t.a)
--
--
++ scab
%+ cook
|= a/(list wing) ^- twig
@ -9896,6 +10555,8 @@
:~
:- '_'
;~(pfix cab (stag %bccb wide))
:- ','
;~(pfix com (stag %bcsm wide))
:- '$'
;~ pose
;~ pfix buc
@ -9939,13 +10600,13 @@
(stag %bcwt ;~(pfix wut (ifix [pel per] (most ace wyde))))
(cold [%base %bean] wut)
==
:- '~'
(cold [%base %null] sig)
:- '^'
;~ pose
scab
(cold [%base %cell] ket)
==
:- '.'
scab
:- ['a' 'z']
;~ pose
(stag %bcts ;~(plug sym ;~(pfix ;~(pose fas tis) wyde)))
@ -9960,8 +10621,8 @@
:~
:- ','
;~ pose
;~(pfix com wyde)
(stag %wing rope)
;~(pfix com (stag %ktsg wide))
==
:- '!'
;~ pose
@ -10007,10 +10668,10 @@
:- '('
(stag %cnhp (ifix [pel per] (most ace wide)))
:- '{'
(stag %bccl (ifix [kel ker] (most ace wide)))
(stag %bccl (ifix [kel ker] (most ace wyde)))
:- '*'
;~ pose
(stag %bunt ;~(pfix tar wide))
(stag %bunt ;~(pfix tar wyde))
(cold [%base %noun] tar)
==
:- '@'
@ -10059,7 +10720,7 @@
(stag %dtts ;~(pfix tis (ifix [pel per] ;~(glam wide wide))))
:- '?'
;~ pose
(stag %bcwt ;~(pfix wut (ifix [pel per] (most ace wide))))
(stag %bcwt ;~(pfix wut (ifix [pel per] (most ace wyde))))
(cold [%base %bean] wut)
==
:- '['
@ -10078,7 +10739,7 @@
;~ pfix tar
(stag %kthp (stag [%base %noun] ;~(pfix tec wide)))
==
(stag %kthp ;~(plug wide ;~(pfix tec wide)))
(stag %kthp ;~(plug wyde ;~(pfix tec wide)))
(stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tec wide))))
(cook |=(a/twig [[%rock %n ~] a]) wide)
==
@ -10189,7 +10850,7 @@
['.' (runo dot %brdt [~ ~] expa)]
['-' (runo hep %brhp [~ ~] expa)]
['^' (runo ket %brkt [~ ~] expx)]
['~' (runo sig %brsg [~ ~] expb)]
['~' (runo sig %brsg [~ ~] exqc)]
['*' (runo tar %brtr [~ ~] exqc)]
['=' (runo tis %brts [~ ~] exqc)]
['?' (runo wut %brwt [~ ~] expa)]
@ -10199,15 +10860,15 @@
;~ pfix buc
%- stew
^. stet ^. limo
:~ ['@' (rune pat %bcpt expb)]
:~ ['@' (rune pat %bcpt exqb)]
['_' (rune cab %bccb expa)]
[':' (rune col %bccl exps)]
['%' (rune cen %bccn exps)]
['^' (rune ket %bckt expb)]
['-' (rune hep %bchp expb)]
['=' (rune tis %bcts expg)]
['?' (rune wut %bcwt exps)]
[';' (rune sem %bcsm expa)]
[':' (rune col %bccl exqs)]
['%' (rune cen %bccn exqs)]
['^' (rune ket %bckt exqb)]
['-' (rune hep %bchp exqb)]
['=' (rune tis %bcts exqg)]
['?' (rune wut %bcwt exqs)]
[';' (rune sem %bcsm exqa)]
==
==
:- '%'
@ -10510,7 +11171,7 @@
%+ sear ::
|= a/(map @ tomb) ::
^- (unit (map @ tomb)) ::
=* fir (~(got by a) 0) ::
=+ fir=(~(got by a) 0) ::
?: (~(has by q.fir) %$) :: %$ in first chapter
~ ::
[~ u=a] ::
@ -10519,6 +11180,7 @@
++ expz |.(loaf(bug &)) :: twig with tracing
:: root contents
::
++ exqa |.(loan) :: one twig
++ exqb |.(;~(gunk loan loan)) :: two roots
++ exqc |.(;~(gunk loan loaf)) :: root then twig
++ exqs |.((butt hunk)) :: closed gapped roots
@ -10696,15 +11358,19 @@
apex:docs
fel
apse:docs
==
++ tall %+ knee *twig :: full tall form
|.(~+((wart (wrap ;~(pose (norm | &) long lute apex:(sail &))))))
++ till %+ knee *root :: full tall form
|.(~+((wart (wrap ;~(pose (norm & &) scad)))))
++ wide %+ knee *twig :: full wide form
|.(~+((wart ;~(pose (norm | |) long apex:(sail |)))))
++ wyde %+ knee *root :: full wide form
|.(~+((wart ;~(pose (norm & |) scad))))
==
++ tall :: full tall form
%+ knee *twig
|.(~+((wart (wrap ;~(pose (norm | &) cram long lute apex:(sail &))))))
++ till :: mold tall form
%+ knee *root
|.(~+((wart (wrap ;~(pose (norm & &) scad)))))
++ wide :: full wide form
%+ knee *twig
|.(~+((wart ;~(pose (norm | |) long apex:(sail |)))))
++ wyde :: mold wide form
%+ knee *root
|.(~+((wart ;~(pose (norm & |) scad))))
++ wart
|* zor/rule
%+ here
@ -10716,7 +11382,6 @@
++ vest
~/ %vest
|= tub/nail
~| %vest
^- (like twig)
%. tub
%- full

614
sys/ovra.hoon Normal file
View File

@ -0,0 +1,614 @@
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: Postface ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
=> +7
~> %slog.[0 leaf+"%arvo-assembly"]
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: volume 3, Arvo models and skeleton ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
=>
~% %hex + ~
|%
++ arch {fil/(unit @uvI) dir/(map @ta $~)} :: fundamental node
++ arvo (wind {p/term q/mill} mill) :: arvo card
++ beam {{p/ship q/desk r/case} s/path} :: global name
++ beak {p/ship q/desk r/case} :: garnish with beak
++ bone @ud :: opaque duct
++ case :: version
$% {$da p/@da} :: date
{$tas p/@tas} :: label
{$ud p/@ud} :: sequence
== ::
++ desk @tas :: ship desk case spur
++ cage (cask vase) :: global metadata
++ cask |*(a/mold (pair mark a)) :: global data
++ cuff :: permissions
$: p/(unit (set monk)) :: can be read by
q/(set monk) :: caused or created by
== ::
++ curd {p/@tas q/*} :: spanless card
++ duct (list wire) :: causal history
++ hypo |*(a/mold (pair span a)) :: span associated
++ hobo |* a/mold :: kiss wrapper
$? $% {$soft p/*} ::
== ::
a ::
== ::
++ kirk (unit (set monk)) :: audience
++ lens :: observation core
$_ ^? ::
|% ++ u *(unit (unit $~)) :: existence
++ v *(unit (unit cage)) :: full history
++ w *(unit (unit (unit cage))) :: latest diff
++ x *(unit (unit cage)) :: data at path
++ y *(unit (unit arch)) :: directory
++ z *(unit (unit cage)) :: current subtree
-- ::
++ marc :: structured mark
$@ mark :: plain mark
$% {$tabl p/(list (pair marc marc))} :: map
== ::
++ mark @tas :: content span
++ mash |=(* (mass +<)) :: producing mass
++ mass (pair cord (each noun (list mash))) :: memory usage
++ mill (each vase milt) :: vase+metavase
++ milt {p/* q/*} :: metavase
++ monk (each ship {p/@tas q/@ta}) :: general identity
++ muse {p/@tas q/duct r/arvo} :: sourced move
++ move {p/duct q/arvo} :: arvo move
++ ovum {p/wire q/curd} :: spanless ovum
++ pane (list {p/@tas q/vase}) :: kernel modules
++ pone (list {p/@tas q/vise}) :: kernel modules old
++ ship @p :: network identity
++ sink (trel bone ship path) :: subscription
++ sley $- {* (unit (set monk)) term beam} :: namespace function
(unit (unit cage)) ::
++ slyd $- {* (unit (set monk)) term beam} :: super advanced
(unit (unit (cask))) ::
++ slyt $-({* *} (unit (unit))) :: old namespace
++ vile :: reflexive constants
$: typ/span :: -:!>(*span)
duc/span :: -:!>(*duct)
pah/span :: -:!>(*path)
mev/span :: -:!>([%meta *vase])
== ::
++ wind :: new kernel action
|* {a/mold b/mold} :: forward+reverse
$% {$pass p/path q/a} :: advance
{$slip p/a} :: lateral
{$give p/b} :: retreat
== ::
++ wire path :: event pretext
++ sloy
!:
|= sod/slyd
^- slyt
|= {ref/* raw/*}
=+ pux=((soft path) raw)
?~ pux ~
?. ?=({@ @ @ @ *} u.pux) ~
=+ :* hyr=(slay i.u.pux)
fal=(slay i.t.u.pux)
dyc=(slay i.t.t.u.pux)
ved=(slay i.t.t.t.u.pux)
tyl=t.t.t.t.u.pux
==
?. ?=({$~ $$ $tas @} hyr) ~
?. ?=({$~ $$ $p @} fal) ~
?. ?=({$~ $$ $tas @} dyc) ~
?. ?=(^ ved) ~
=+ ron=q.p.u.hyr
=+ bed=[[q.p.u.fal q.p.u.dyc (case p.u.ved)] (flop tyl)]
=+ bop=(sod ref ~ ron bed)
?~ bop ~
?~ u.bop [~ ~]
[~ ~ +.q.u.u.bop]
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 3bE, Arvo core ::
::
++ vent :: vane core
|= {lal/@tas vil/vile bud/vase sew/(pair worm vase)}
~% %vent +>+ ~
|%
++ ruck :: update vase
|= {pax/path txt/@ta}
^+ +>
=- ?:(?=($| -.res) ((slog p.res) +>.$) p.res)
^= res %- mule |.
=+ arg=[~2000.1.1 0 =>(~ |~(* ~))]
=+ rig=(slym q.sew arg)
=+ rev=(slym (slap bud (rain pax txt)) bud)
=+ syg=(slym rev arg)
~| %load-lost
+>.^$(q.sew (slam (slap syg [%limb %load]) (slap rig [%limb %stay])))
::
++ wink :: deploy
|= {now/@da eny/@ ski/slyd}
=+ rig=(slym q.sew +<) :: activate vane
~% %wink +>+> ~
|%
++ doze
|= {now/@da hen/duct}
^- (unit @da)
((hard (unit @da)) q:(slym (slap rig [%limb %doze]) +<))
::
++ slid
|= {hed/mill tal/mill}
^- mill
?: &(?=($& -.hed) ?=($& -.tal))
[%& (slop p.hed p.tal)]
[%| [%cell p.p.hed p.p.tal] [q.p.hed q.p.tal]]
::
++ slix
|= hil/mill
^- mill
?- -.hil
$& [%& (slop [typ.vil p.p.hil] p.hil)]
$| [%| [%cell typ.vil p.p.hil] p.hil]
==
::
++ slur :: call gate on
|= {gat/vase hil/mill}
^- (unit (pair vase worm))
=+ sam=(slot 6 gat)
=+ ^= hig
?- -.hil
$& (~(nest wa p.sew) p.sam p.p.hil)
$| (~(nets wa p.sew) p.sam p.p.hil)
==
?.(-.hig ~ `[(slym gat +>.hil) +.hig])
::
++ slur-a ~/(%slur-a |=({gat/vase hil/mill} =+(%a (slur gat hil))))
++ slur-b ~/(%slur-b |=({gat/vase hil/mill} =+(%b (slur gat hil))))
++ slur-c ~/(%slur-c |=({gat/vase hil/mill} =+(%c (slur gat hil))))
++ slur-d ~/(%slur-d |=({gat/vase hil/mill} =+(%d (slur gat hil))))
++ slur-e ~/(%slur-e |=({gat/vase hil/mill} =+(%e (slur gat hil))))
++ slur-f ~/(%slur-f |=({gat/vase hil/mill} =+(%f (slur gat hil))))
++ slur-g ~/(%slur-g |=({gat/vase hil/mill} =+(%g (slur gat hil))))
++ slur-z ~/(%slur-z |=({gat/vase hil/mill} =+(%z (slur gat hil))))
::
++ slur-pro :: profiling slur
~/ %slur-pro
|= {lal/@tas gat/vase hil/mill}
?+ lal (slur-z gat hil)
$a (slur-a gat hil)
$b (slur-b gat hil)
$c (slur-c gat hil)
$d (slur-d gat hil)
$e (slur-e gat hil)
$f (slur-f gat hil)
$g (slur-g gat hil)
==
::
++ song :: reduce metacard
~/ %song ::
|= mex/vase :: mex: vase of card
^- (unit (pair mill worm)) ::
=^ hip p.sew (~(nell wa p.sew) p.mex) ::
?. hip ~ :: a card is a cell
?. ?=($meta -.q.mex) `[[%& mex] p.sew] :: ordinary card
=^ tiv p.sew (~(slot wa p.sew) 3 mex) ::
=^ hip p.sew (~(nell wa p.sew) p.tiv) ::
?. hip ~ :: a vase is a cell
=^ vax p.sew (~(slot wa p.sew) 2 tiv) ::
=^ hip p.sew (~(nest wa p.sew) typ.vil p.vax) ::
?. hip ~ :: vase head is span
%+ biff ::
=+ mut=(milt q.tiv) :: card span, value
|- ^- (unit (pair milt worm)) ::
?. ?=({$meta p/* q/milt} q.mut) `[mut p.sew] :: ordinary metacard
=^ hip p.sew (~(nets wa p.sew) mev.vil p.mut)::
?. hip ~ :: meta-metacard
$(mut +.q.mut) :: descend into meta
|=(a/(pair milt worm) `[[%| p.a] q.a]) :: milt to mill
::
++ sump :: vase to move
~/ %sump
|= wec/vase
^- (unit (pair move worm))
%+ biff ((soft duct) -.q.wec)
|= a/duct
%+ bind
=- ?- -.har
$| ~& [%dead-card p.har] ~ :: XX properly log?
$& (some p.har)
==
^= har ^- (each (pair arvo worm) term)
=^ caq p.sew (~(spot wa p.sew) 3 wec)
?+ q.caq [%| (cat 3 %funk (@tas q.caq))]
::
{$pass p/* q/@tas r/{p/@tas q/*}}
%- (bond |.([%| p.r.q.caq]))
%+ biff ((soft @) q.q.caq)
|= lal/@tas
?. ((sane %tas) lal) ~
%+ biff ((soft path) p.q.caq)
|= pax/path
=^ yav p.sew (~(spot wa p.sew) 15 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%pass pax lal hil] vel]
::
{$give p/{p/@tas q/*}}
%- (bond |.([%| p.p.q.caq]))
=^ yav p.sew (~(spot wa p.sew) 3 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%give hil] vel]
::
{$slip p/@tas q/{p/@tas q/*}}
%- (bond |.([%| p.q.q.caq]))
%+ biff ((soft @) p.q.caq)
|= lal/@tas
?. ((sane %tas) lal) ~
=^ yav p.sew (~(spot wa p.sew) 7 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%slip lal hil] vel]
==
|=(b/(pair arvo worm) [`move`[a p.b] q.b])
::
++ said :: vase to (list move)
|= vud/vase
|- ^- (pair (list move) worm)
?: =(~ q.vud) [~ p.sew]
=^ hed p.sew (~(slot wa p.sew) 2 vud)
=^ tal p.sew (~(slot wa p.sew) 3 vud)
=^ mov p.sew (need (sump hed))
=^ moz p.sew $(vud tal)
[[mov moz] p.sew]
::
++ scry :: read namespace
~/ %scry
|= $: fur/(unit (set monk))
ren/@t
bed/beam
==
^- (unit (unit (cask)))
:: ~& [%arvo-scry ren bed]
=+ ^= old
:* fur
ren
[%& p.bed]
q.bed
`coin`[%$ r.bed]
(flop s.bed)
==
^- (unit (unit (cask)))
=+ pro=(slym (slap rig [%limb %scry]) old)
?~ q.pro ~
?~ +.q.pro [~ ~]
=+ dat=(slot 7 pro)
[~ ~ (mark -.q.dat) +.q.dat]
::
++ soar :: scrub vane
|= sev/vase
^- vase
?: &(=(-.q.q.sew -.q.sev) =(+>.q.q.sew +>.q.sev))
q.sew :: unchanged, use old
sev(+<.q [*@da *@ =>(~ |~(* ~))]) :: clear to stop leak
::
++ swim
~/ %swim
|= $: org/@tas
pux/(unit wire)
hen/duct
hil/mill
==
^- {{p/(list move) q/worm} q/vase}
:: ~& [%swim-wyt `@ud`~(wyt in p.sew)]
=+ ^= pru
?~ pux
~| [%swim-call-vane lal ({term $~} +.p.hil)]
=^ vax p.sew (~(slap wa p.sew) rig [%limb %call])
%^ slur-pro lal vax
(slid [%& duc.vil hen] (slix hil))
~| [%swim-take-vane lal ({term $~} +.p.hil)]
=^ vax p.sew (~(slap wa p.sew) rig [%limb %take])
%^ slur-pro lal vax
;: slid
[%& pah.vil u.pux]
[%& duc.vil hen]
(slix (slid [%& [%atom %tas `org] org] hil))
==
?~ pru
~& [%swim-lost lal (@tas +>-.hil)]
[[~ p.sew] q.sew]
=^ pro p.sew (need pru)
=^ moz p.sew (~(slap wa p.sew) pro [%limb %p])
=^ vem p.sew (~(slap wa p.sew) pro [%limb %q])
[(said moz) (soar vem)]
--
--
::
++ vint :: create vane
|= {lal/@tas vil/vile bud/vase pax/path txt/@ta} ::
=- ?:(?=($| -.res) ((slog p.res) ~) (some p.res))
^= res %- mule |.
(vent lal vil bud *worm (slym (slap bud (rain pax txt)) bud))
::
++ viol :: vane tools
|= but/span
^- vile
=+ pal=|=(a/@t ^-(span (~(play ut but) (vice a))))
:* typ=(pal '*span')
duc=(pal '*duct')
pah=(pal '*path')
mev=(pal '*{$meta $vase}')
==
::
++ is :: operate in time
|= {vil/vile eny/@ bud/vase niz/(pair worm (list {p/@tas q/vase}))}
|_ now/@da
++ beck
^- slyd
|= {* fur/(unit (set monk)) ron/term bed/beam}
^- (unit (unit (cask)))
=> .(fur ?^(fur fur `[[%& p.bed] ~ ~])) :: XX heinous
=+ lal=(end 3 1 ron)
=+ ren=(@t (rsh 3 1 ron))
|- ^- (unit (unit (cask)))
?~ q.niz ~
?. =(lal p.i.q.niz) $(q.niz t.q.niz)
%- scry:(wink:(vent lal vil bud p.niz q.i.q.niz) now (shax now) ..^$)
[fur ren bed]
::
++ dink :: vase by char
|= din/@tas ^- vase
?~(q.niz !! ?:(=(din p.i.q.niz) q.i.q.niz $(q.niz t.q.niz)))
::
++ dint :: input routing
|= hap/path ^- @tas
?+ hap !!
{@ $ames *} %a
{@ $boat *} %c
{@ $newt *} %a
{@ $sync *} %c
{@ $term *} %d
{@ $http *} %e
{@ $behn *} %b
==
::
++ doos :: sleep until
|= hap/path ^- (unit @da)
=+ lal=(dint hap)
(doze:(wink:(vent lal vil bud p.niz (dink lal)) now 0 beck) now [hap ~])
::
++ hurl :: start loop
|= {lac/? ovo/ovum}
~? &(!lac !=(%belt -.q.ovo)) [%unix -.q.ovo p.ovo]
^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
?> ?=(^ p.ovo)
%+ kick lac
:~ :* i.p.ovo
~
:^ %pass t.p.ovo
(dint p.ovo)
:+ %&
[%cell [%atom %tas `%soft] %noun]
[%soft q.ovo]
==
==
::
++ race :: take
|= {org/@tas lal/@tas pux/(unit wire) hen/duct hil/mill ves/vase}
^- {p/{p/(list move) q/worm} q/vase}
=+ ven=(vent lal vil bud [p.niz ves])
=+ win=(wink:ven now (shax now) beck)
(swim:win org pux hen hil)
::
++ fire :: execute
|= {org/term lal/term pux/(unit wire) hen/duct hil/mill}
?: &(?=(^ pux) ?=($~ hen))
[[[[lal u.pux] (curd +>.hil)]~ ~] niz]
=+ naf=q.niz
|- ^- {{p/(list ovum) q/(list muse)} _niz}
?~ naf [[~ ~] [p.niz ~]]
?. =(lal p.i.naf)
=+ tuh=$(naf t.naf)
[-.tuh [+<.tuh [i.naf +>.tuh]]]
=+ fiq=(race org lal pux hen hil q.i.naf)
[[~ (turn p.p.fiq |=(a/move [lal a]))] [q.p.fiq [[p.i.naf q.fiq] t.naf]]]
::
++ jack :: dispatch card
|= {lac/? gum/muse}
^- {{p/(list ovum) q/(list muse)} _niz}
:: =. lac |(lac ?=(?(%g %f) p.gum))
:: =. lac &(lac !?=($b p.gum))
%+ fire
p.gum
?- -.r.gum
$pass
~? &(!lac !=(%$ p.gum))
:^ %pass [p.gum p.q.r.gum]
[(@tas +>-.q.q.r.gum) p.r.gum]
q.gum
[p.q.r.gum ~ [[p.gum p.r.gum] q.gum] q.q.r.gum]
::
$give
?> ?=(^ q.gum)
?. ?=(^ i.q.gum)
~& [%jack-bad-duct q.gum]
~& [%jack-bad-card +>-.p.r.gum]
!!
~? &(!lac |(!=(%blit +>-.p.r.gum) !=(%d p.gum)))
[%give p.gum (@tas +>-.p.r.gum) `duct`q.gum]
[i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum]
::
$slip
~? !lac [%slip p.gum (@tas +>-.q.p.r.gum) q.gum]
[p.p.r.gum ~ q.gum q.p.r.gum]
==
::
++ kick :: new main loop
|= {lac/? mor/(list muse)}
=| ova/(list ovum)
|- ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
?~ mor [(flop ova) niz]
=^ nyx niz (jack lac i.mor)
$(ova (weld p.nyx ova), mor (weld q.nyx t.mor))
--
--
=+ pit=`vase`!>(.) ::
=+ bud=pit :: becomes tang
=+ vil=(viol p.bud) :: cached reflexives
=| $: lac/? :: laconic bit
eny/@ :: entropy
niz/(pair worm (list {p/@tas q/vase})) :: modules
== ::
=< |%
++ come |= {@ (list ovum) pone} :: 11
^- {(list ovum) _+>}
~& %hoon-come
=^ rey +>+ (^come +<)
[rey +>.$]
++ keep |=(* (^keep ((hard {@da path}) +<))) :: 4
++ load |= {@ (list ovum) pane} :: 86
^- {(list ovum) _+>}
~& %hoon-load
=^ rey +>+ (^load +<)
[rey +>.$]
++ peek |=(* (^peek ((hard {@da path}) +<))) :: 87
++ poke |= * :: 42
^- {(list ovum) *}
=> .(+< ((hard {now/@da ovo/ovum}) +<))
?: =(%verb -.q.ovo)
[~ +>.$(lac !lac)]
?: ?=($veer -.q.ovo)
[~ +>.$(+ (veer now q.ovo))]
=^ ova +>+ (^poke now ovo)
|- ^- {(list ovum) *}
?~ ova
[~ +>.^$]
?: ?=($verb -.q.i.ova)
$(ova t.ova, lac !lac)
?: ?=($veer -.q.i.ova)
$(ova t.ova, +>+.^$ (veer now q.i.ova))
?: ?=($vega -.q.i.ova)
%+ fall
(vega now t.ova (path +<.q.i.ova) (path +>.q.i.ova))
[~ +>.^$]
?: ?=($mass -.q.i.ova)
=+ avo=$(ova t.ova)
:_ +.avo
:_ -.avo
%= i.ova
q.q
:- %userspace
:- %|
:~ hoon+`pit
zuse+`bud
hoon-cache+`p.niz
q.q.i.ova
dot+`.
==
==
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
++ wish |=(* (^wish ((hard @ta) +<))) :: 20
--
|%
++ come :: load incompatible
|= {yen/@ ova/(list ovum) nyf/pone}
^+ [ova +>]
(load yen ova (turn nyf |=({a/@tas b/vise} [a (slim b)])))
::
++ keep :: wakeup delay
|= {now/@da hap/path}
=> .(+< ((hard {now/@da hap/path}) +<))
(~(doos (is vil eny bud niz) now) hap)
::
++ load :: load compatible
|= {yen/@ ova/(list ovum) nyf/pane}
^+ [ova +>]
=: eny yen
q.niz nyf
==
|- ^+ [ova +>.^$]
?~ ova
[~ +>.^$]
?: ?=($verb -.q.i.ova)
$(ova t.ova, lac !lac)
?: ?=($veer -.q.i.ova)
$(ova t.ova, +>.^$ (veer *@da q.i.ova))
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
::
++ peek :: external inspect
|= {now/@da hap/path}
^- (unit)
?~ hap [~ hoon-version]
=+ rob=((sloy ~(beck (is vil eny bud niz) now)) [151 %noun] hap)
?~ rob ~
?~ u.rob ~
[~ u.u.rob]
::
++ poke :: external apply
|= {now/@da ovo/ovum}
=. eny (mix eny (shaz now))
:: ~& [%poke -.q.ovo]
^- {(list ovum) _+>}
=^ zef niz
(~(hurl (is vil eny bud niz) now) lac ovo)
[zef +>.$]
::
++ vega :: reboot kernel
|= {now/@da ova/(list ovum) hap/path zup/path}
^- (unit {p/(list ovum) q/*})
=- ?:(?=($| -.res) ((slog p.res) ~) `p.res)
^= res %- mule |.
=+ pax=(weld hap `path`[%hoon ~])
=+ wax=(weld zup `path`[%hoon ~])
~& [%vega-start-hoon hap]
=+ src=((hard @t) (need (peek now cx+pax)))
=+ arv=((hard @t) (need (peek now cx+wax)))
=+ gen=(rain hap src)
~& %vega-parsed
=+ one=(~(mint ut %noun) %noun gen)
~& %vega-compiled
~& [%vega-arvo zup]
=+ two=(~(mint ut p.one) %noun (rain zup arv))
~& %vega-minted
=+ ken=.*(0 [7 q.one q.two])
~& [%vega-kernel `@ux`(mug ken)]
=+ ^= nex
=+ gat=.*(ken .*(ken [0 87]))
(need ((hard (unit @)) .*([-.gat [[now ~] +>.gat]] -.gat)))
~& [%vega-compiled hoon-version nex]
?> (lte nex hoon-version)
=+ gat=.*(ken .*(ken [0 ?:(=(nex hoon-version) 86 11)]))
=+ sam=[eny ova q.niz]
=+ raw=.*([-.gat [sam +>.gat]] -.gat)
=+ yep=((list ovum) -.raw)
[[[~ %vega hap] yep] +.raw]
::
++ veer :: install vane/tang
|= {now/@da fav/curd}
=> .(fav ((hard {$veer lal/@ta pax/path txt/@t}) fav))
=- ?:(?=($| -.res) ((slog p.res) +>.$) p.res)
^= res %- mule |.
?: =(%$ lal.fav)
~& [%tang pax.fav `@p`(mug txt.fav)]
=+ gen=(rain pax.fav txt.fav)
=+ vax=(slap pit gen)
+>.^$(bud vax)
%_ +>.^$
q.niz
|- ^+ q.niz
?~ q.niz
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
=+ vin=(vint lal.fav vil bud pax.fav txt.fav)
?~ vin
q.niz
[[lal.fav q.sew:u.vin] q.niz]
?. =(lal.fav p.i.q.niz)
[i.q.niz $(q.niz t.q.niz)]
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
:_ t.q.niz
:- p.i.q.niz
q.sew:(ruck:(vent lal.fav vil bud [p.niz q.i.q.niz]) pax.fav txt.fav)
==
::
++ wish :: external compute
|= txt/@
q:(slap bud (ream txt))
--

2276
sys/vane/ames.hoon
View File

File diff suppressed because it is too large Load Diff

80
sys/vane/behn.hoon
View File

@ -1,4 +1,4 @@
!: :: %behn, just a timer
:: :: %behn, just a timer
!? 164
::::
=, behn
@ -141,84 +141,6 @@
^+ a
(meek (uniq a) (uniq q))
--
++ neon
|= our/ship
^- (vane task:able gift:able $~ $~ coke coke)
=| coke
|%
++ load |=(coke +>)
++ stay `coke`+<
++ plow
=| $: now/@da
eny/@e
sky/roof
==
|%
++ doze ~
++ peek
|= $: lyc/(unit (set ship))
car/term
bem/beam
==
^- (unit (unit (cask vase)))
::
:: XX this is old and somewhat retarded
::
=+ ^= liz
|- ^- (list {@da duct})
=. tym (raze tym)
?~ p.tym ~
[~(get up p.tym) $(p.tym ~(pop up p.tym))]
[~ ~ %tank !>(>liz<)]
::
++ spin
=| $: hen/duct
moz/(list (pair duct (wind $~ gift:able)))
==
|%
++ call
|= tac/task:able
^+ +>
=^ mof tym
?- -.tac
$rest
=. q.tym (~(put up q.tym) p.tac hen)
=. tym (raze tym)
[~ tym]
::
$wait
=. p.tym (~(put up p.tym) p.tac hen)
=. tym (raze tym)
[~ tym]
::
$wake
|- ^+ [*(list move) tym]
=. tym (raze tym)
?: =([~ ~] tym) [~ tym] :: XX TMI
?: =(~ p.tym)
~& %weird-wake [~ tym]
=+ nex=~(get up p.tym)
?: (lte now p.nex) [~ tym]
=^ mof tym $(p.tym ~(pop up p.tym))
[[`move`[q.nex %give %wake ~] mof] tym]
::
$wegh
:_ tym :_ ~
:^ hen %give %mass
:- %behn
:- %|
:~ tym+[%& tym]
==
==
+>.$(moz (weld `(list move)`mof moz))
::
++ take
|= {tea/wire $~}
^+ +>
!!
--
--
--
--
. ==
=| $: $0 ::

440
sys/vane/clay.hoon
View File

@ -325,7 +325,7 @@
== ::
++ note :: out request $->
$% $: $a :: to %ames
$% {$wont p/sock q/path r/*} ::
$% {$want p/sock q/path r/*} ::
== == ::
$: $c :: to %clay
$% {$info p/@p q/@tas r/nori} :: internal edit
@ -641,7 +641,7 @@
::
++ send-over-ames
|= {a/duct b/path c/ship d/{p/@ud q/riff}}
(emit a %pass b %a %wont [our c] [%c %question p.q.d (scot %ud p.d) ~] q.d)
(emit a %pass b %a %want [our c] [%c %question p.q.d (scot %ud p.d) ~] q.d)
::
:: Create a request that cannot be filled immediately.
::
@ -3296,15 +3296,17 @@
[mos ..^$]
::
$init
:_ %_ ..^$
fat.ruf
?< (~(has by fat.ruf) p.q.hic)
(~(put by fat.ruf) p.q.hic [-(hun hen)]:[*room .])
==
=+ [bos=(sein:title p.q.hic) can=(clan:title p.q.hic)]
%- zing ^- (list (list move))
:~ ?: =(bos p.q.hic) ~
[hen %pass /init-merge %c %merg p.q.hic %base bos %kids da+now %init]~
::
:: this used to start the initial merge, which is now
:: not a necessary part of the boot sequence.
::
:- ~
%_ ..^$
fat.ruf
?< (~(has by fat.ruf) p.q.hic)
(~(put by fat.ruf) p.q.hic [-(hun hen)]:[*room .])
~
==
::
$into
@ -3665,8 +3667,8 @@
=+ our=(slav %p i.tea)
=+ him=(slav %p i.t.tea)
:_ ..^$
:~ :* hen %pass /writ-wont %a
%wont [our him] [%c %answer t.t.tea]
:~ :* hen %pass /writ-want %a
%want [our him] [%c %answer t.t.tea]
(bind p.+.q.hin rant-to-rand)
==
==
@ -3724,418 +3726,4 @@
?~ -
`[paf %ins %mime -:!>(*mime) u.mim]
`[paf %mut %mime -:!>(*mime) u.mim]
::
++ neon
|= our/ship
^- (vane task:able gift:able sign note raft raft)
=| ruf/raft
|%
++ load |=(raft +>)
++ stay `raft`+<
++ plow
=| $: now/@da
eny/@e
sky/roof
==
|%
++ doze ~
++ peek
|= $: lyc/(unit (set ship))
car/term
bem/beam
==
^- (unit (unit (cask vase)))
=* his p.bem
=+ got=(~(has by fat.ruf) his)
?: =(%$ car)
[~ ~]
=+ run=((soft care) car)
?~ run [~ ~]
=+ den=((de now [/scryduct ~] ruf) [. .]:his q.bem)
=+ (aver:den u.run r.bem s.bem)
?~ - -
?~ u.- -
?: ?=($& -.u.u.-) ``p.u.u.-
~
::
++ spin
=| $: hen/duct
moz/(list (pair duct (wind note gift:able)))
==
|%
++ call
|= tac/task:able
^+ +>
=^ vam +>
^+ [p=*(list move) q=+>]
?- -.tac
$boat
:_ +>.$
[hen %give %hill (turn ~(tap by mon.ruf) head)]~
::
$drop
=^ mos ruf
=+ den=((de now hen ruf) [. .]:p.tac q.tac)
abet:drop-me:den
[mos +>.$]
::
$info
?: =(%$ q.tac)
[~ +>.$]
=^ mos ruf
=+ den=((de now hen ruf) [. .]:p.tac q.tac)
abet:(edit:den now r.tac)
[mos +>.$]
::
$init
:_ %_ +>.$
fat.ruf
?< (~(has by fat.ruf) p.tac)
(~(put by fat.ruf) p.tac [-(hun hen)]:[*room .])
==
=+ [bos=(sein:title p.tac) can=(clan:title p.tac)]
%- zing ^- (list (list move))
:~ ?: =(bos p.tac) ~
:_ ~
:* hen
%pass
/init-merge
%c
%merg
p.tac
%base
bos
%kids
da+now
%init
==
::
~
==
::
$into
=. hez.ruf `hen
:_ +>.$
=+ bem=(~(get by mon.ruf) p.tac)
?: &(?=($~ bem) !=(%$ p.tac))
~|([%bad-mount-point-from-unix p.tac] !!)
=+ ^- bem/beam
?^ bem
u.bem
[[?>(?=(^ fat.ruf) p.n.fat.ruf) %base %ud 1] ~]
=+ rom=(~(get by fat.ruf) p.bem)
?~ rom
~
=+ dos=(~(get by dos.u.rom) q.bem)
?~ dos
~
?: =(0 let.dom.u.dos)
=+ cos=(mode-to-soba ~ s.bem q.tac r.tac)
=+ ^- {one/(list {path miso}) two/(list {path miso})}
%+ skid cos
|= {a/path b/miso}
?& ?=($ins -.b)
?=($mime p.p.b)
?=({$hoon $~} (slag (dec (lent a)) a))
==
:~ [hen %pass /one %c %info p.bem q.bem %& one]
[hen %pass /two %c %info p.bem q.bem %& two]
==
=+ ^= yak
%- ~(got by hut.ran.ruf)
(~(got by hit.dom.u.dos) let.dom.u.dos)
=+ cos=(mode-to-soba q.yak (flop s.bem) q.tac r.tac)
[hen %pass /both %c %info p.bem q.bem %& cos]~
::
$merg :: direct state up
?: =(%$ q.tac)
[~ +>.$]
=^ mos ruf
=+ den=((de now hen ruf) [. .]:p.tac q.tac)
abet:abet:(start:(me:ze:den [r.tac s.tac] ~ &) t.tac u.tac)
[mos +>.$]
::
$mont
=. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~])
=+ pot=(~(get by mon.ruf) p.tac)
?^ pot
~& [%already-mounted pot]
[~ +>.$]
=. mon.ruf
(~(put by mon.ruf) p.tac [p.q.tac q.q.tac r.q.tac] s.q.tac)
=+ yar=(~(get by fat.ruf) p.q.tac)
?~ yar
[~ +>.$]
=+ dos=(~(get by dos.u.yar) q.q.tac)
?~ dos
[~ +>.$]
=^ mos ruf
=+ den=((de now hen ruf) [. .]:p.q.tac q.q.tac)
abet:(mont:den p.tac q.tac)
[mos +>.$]
::
$dirk
?~ hez.ruf
~& %no-sync-duct
[~ +>.$]
?. (~(has by mon.ruf) p.tac)
~& [%not-mounted p.tac]
[~ +>.$]
:- ~[[u.hez.ruf %give %dirk p.tac]]
+>.$
::
$ogre
?~ hez.ruf
~& %no-sync-duct
[~ +>.$]
?@ p.tac
?. (~(has by mon.ruf) p.tac)
~& [%not-mounted p.tac]
[~ +>.$]
:_ +>.$(mon.ruf (~(del by mon.ruf) p.tac))
[u.hez.ruf %give %ogre p.tac]~
:_ %_ +>.$
mon.ruf
%- molt
%+ skip ~(tap by mon.ruf)
(corl (cury test p.tac) tail)
==
%+ turn
(skim ~(tap by mon.ruf) (corl (cury test p.tac) tail))
|= {pot/term bem/beam}
[u.hez.ruf %give %ogre pot]
::
$warp
=^ mos ruf
=+ den=((de now hen ruf) p.tac p.q.tac)
:: =- ~? ?=([~ %sing %w *] q.q.tac)
:: :* %someones-warping
:: rav=u.q.q.tac
:: mos=-<
:: ==
:: -
=< abet
?~ q.q.tac
cancel-request:den
(start-request:den u.q.q.tac)
[mos +>.$]
::
$went
:: this won't happen until we send responses.
!!
::
$west
?: ?=({$question *} q.tac)
=+ ryf=((hard riff) r.tac)
:_ +>.$
:~ [hen %give %mack ~]
:- hen
:^ %pass [(scot %p p.p.tac) (scot %p q.p.tac) t.q.tac]
%c
[%warp [p.p.tac p.p.tac] ryf]
==
?> ?=({$answer @ @ $~} q.tac)
=+ syd=(slav %tas i.t.q.tac)
=+ inx=(slav %ud i.t.t.q.tac)
=^ mos ruf
=+ den=((de now hen ruf) p.tac syd)
abet:(take-foreign-update:den inx ((hard (unit rand)) r.tac))
[[[hen %give %mack ~] mos] +>.$]
::
$wegh
:_ +>.$ :_ ~
:^ hen %give %mass
:- %clay
:- %|
:~ domestic+[%& fat.ruf]
foreign+[%& hoy.ruf]
:- %object-store :- %|
:~ commits+[%& hut.ran.ruf]
blobs+[%& lat.ran.ruf]
==
==
==
+>.$(moz (weld `(list move)`vam moz))
::
++ take
|= {tea/wire hin/sign}
^+ +>
=^ vam +>
^+ [p=*(list move) q=+>]
?: ?=({$merge @ @ @ @ @ $~} tea)
?> ?=(?($writ $made) +<.hin)
=+ our=(slav %p i.t.tea)
=* syd i.t.t.tea
=+ her=(slav %p i.t.t.t.tea)
=* sud i.t.t.t.t.tea
=* sat i.t.t.t.t.t.tea
=+ dat=?-(+<.hin $writ [%& p.hin], $made [%| q.hin])
=+ ^- kan/(unit dome)
%+ biff (~(get by fat.ruf) her)
|= room
%+ bind (~(get by dos) sud)
|= dojo
dom
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:abet:(route:(me:ze:den [her sud] kan |) sat dat)
[mos +>.$]
?: ?=({$blab care @ @ *} tea)
?> ?=($made +<.hin)
?. ?=($& -.q.hin)
~| %blab-fail
~> %mean.|.(?+(-.q.hin -.q.hin $| p.q.hin))
:: interpolate ford fail into stack trace
!!
:_ +>.$ :_ ~
:* hen %give %writ ~
^- {care case @tas}
[i.t.tea ((hard case) +>:(slay i.t.t.tea)) i.t.t.t.tea]
::
`path`t.t.t.t.tea
`cage`p.q.hin
==
?- -.+.hin
::
$send
[[[hen %give +.q.hin] ~] ..^$]
::
$crud
[[[hen %slip %d %flog +.hin] ~] +>.$]
::
$made
?~ tea !!
?+ -.tea !!
$inserting
?> ?=({@ @ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:(take-inserting:den wen q.hin)
[mos +>.$]
::
$diffing
?> ?=({@ @ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:(take-diffing:den wen q.hin)
[mos +>.$]
::
$castifying
?> ?=({@ @ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:(take-castify:den wen q.hin)
[mos +>.$]
::
$mutating
?> ?=({@ @ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:(take-mutating:den wen q.hin)
[mos +>.$]
::
$patching
?> ?=({@ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:(take-patch:den q.hin)
[mos +>.$]
::
$ergoing
?> ?=({@ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
abet:(take-ergo:den q.hin)
[mos +>.$]
::
$foreign-plops
?> ?=({@ @ @ @ $~} t.tea)
=+ our=(slav %p i.t.tea)
=+ her=(slav %p i.t.t.tea)
=* syd i.t.t.t.tea
=+ lem=(slav %da i.t.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [our her] syd)
abet:(take-foreign-plops:den ?~(lem ~ `lem) q.hin)
[mos +>.$]
::
$foreign-x
?> ?=({@ @ @ @ @ *} t.tea)
=+ our=(slav %p i.t.tea)
=+ her=(slav %p i.t.t.tea)
=+ syd=(slav %tas i.t.t.t.tea)
=+ car=((hard care) i.t.t.t.t.tea)
=+ ^- cas/case
=+ (slay i.t.t.t.t.t.tea)
?> ?=({$~ $$ case} -)
->+
=* pax t.t.t.t.t.t.tea
=^ mos ruf
=+ den=((de now hen ruf) [our her] syd)
abet:(take-foreign-x:den car cas pax q.hin)
[mos +>.$]
==
::
$mere
?: ?=($& -.p.+.hin)
~& 'initial merge succeeded'
[~ +>.$]
~> %slog.
:^ 0 %rose [" " "[" "]"]
:^ leaf+"initial merge failed"
leaf+"my most sincere apologies"
>p.p.p.+.hin<
q.p.p.+.hin
[~ +>.$]
::
$note [[hen %give +.hin]~ +>.$]
$wake
~| %why-wakey !!
:: =+ dal=(turn ~(tap by fat.ruf) |=([a=@p b=room] a))
:: =| mos=(list move)
:: |- ^- [p=(list move) q=_..^^$]
:: ?~ dal [mos ..^^$]
:: =+ une=(un i.dal now hen ruf)
:: =^ som une wake:une
:: $(dal t.dal, ruf abet:une, mos (weld som mos))
::
$writ
?> ?=({@ @ *} tea)
~| i=i.tea
~| it=i.t.tea
=+ our=(slav %p i.tea)
=+ him=(slav %p i.t.tea)
:_ +>.$
:~ :* hen %pass /writ-wont %a
%wont [our him] [%c %answer t.t.tea]
(bind p.+.hin rant-to-rand)
==
==
::
$woot
[~ +>.$]
:: ?~ r.hin [~ +>.$]
:: ~& [%clay-lost p.hin r.hin tea]
:: [~ +>.$]
==
+>.$(moz (weld `(list move)`vam moz))
--
--
--
--

93
sys/vane/dill.hoon
View File

@ -1,5 +1,5 @@
^%
!:
::
:: dill (4d), terminal handling
::
|= pit/vase
@ -44,7 +44,7 @@
++ move {p/duct q/(wind note gift:able)} :: local move
++ note-ames :: weird ames move
$% {$make p/(unit @t) q/@ud r/@ s/?} ::
{$sith p/@p q/@uw r/@uw} ::
{$sith p/@p q/@uw r/?} ::
== ::
++ note-clay ::
$% {$merg p/@p q/@tas r/@p s/@tas t/case u/germ:clay}:: merge desks
@ -56,7 +56,7 @@
{$init p/ship} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: reboot by path
{$vega p/path q/path} :: reboot by path
{$velo p/@t q/@t} :: reboot by path
{$verb $~} :: verbose mode
== ::
@ -390,7 +390,6 @@
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
$diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
$doff !!
==
::
{$c $note *}
@ -539,90 +538,4 @@
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
[moz ..^$]
::
++ neon
|= our/ship
^- (vane task:able gift:able sign note axle axle)
=| all/axle
|%
++ load |=(axle +>)
++ stay `axle`+<
++ plow
=| $: now/@da
eny/@e
sky/roof
==
|%
++ doze ~
++ peek
|= $: lyc/(unit (set ship))
car/term
bem/beam
==
^- (unit (unit (cask vase)))
[~ ~]
::
++ spin
=| $: hen/duct
moz/(list (pair duct (wind note gift:able)))
==
|%
++ call
|= tac/task:able
^+ +>
=^ vam +>
?: ?=($boot -.tac)
:_(+>.$ [hen %pass ~ (note %a p.tac)]~)
?: ?=($flog -.tac)
:: ~& [%dill-flog +.tac]
?: ?=({$crud $hax-init {$leaf *} $~} p.tac)
=+ him=(slav %p (crip p.i.q.p.tac))
:_(+>.$ ?~(hey.all ~ [u.hey.all %give %init him]~))
?: ?=({$crud $hax-heft $~} p.tac)
:_(+>.$ ?~(hey.all ~ [u.hey.all %slip %d %heft ~]~))
:_(+>.$ ?~(hey.all ~ [u.hey.all %slip %d p.tac]~))
=. hey.all ?^(hey.all hey.all `hen)
?: ?=($init -.tac)
:: ~& [%cnhp-init hen]
?: =(ore.all `p.tac)
[[hen %give tac]~ +>.$]
=: ore.all `p.tac
dug.all ~
==
=^ moz all abet:(need (ax (need hey.all) [%flow %hood ~]))
?: |((lth p.tac 256) (gte p.tac (bex 64)))
[moz +>.$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.tac]) +>.$]
=+ nus=(ax hen tac)
?~ nus
~& [%dill-no-flow tac]
[~ +>.$]
=^ moz all abet:(call:u.nus tac)
[moz +>.$]
+>.$(moz (weld `(list move)`vam moz))
::
++ take
|= {tea/wire hin/sign}
^+ +>
=^ vam +>
?: =(~ ore.all)
?: ?=({$a $init *} hin)
:: ~& [%take-init hen]
=. hey.all ?^(hey.all hey.all `hen)
[[[hen %give +.hin] ~] +>.$]
:: [~ +>.$]
~& [%take-back hin]
[~ +>.$]
?. (~(has by dug.all) hen)
~& [%take-weird-sign hin]
~& [%take-weird-hen hen]
[~ +>.$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) hin)
[moz +>.$]
+>.$(moz (weld `(list move)`vam moz))
--
--
--
--

904
sys/vane/eyre.hoon
View File

File diff suppressed because it is too large Load Diff

108
sys/vane/ford.hoon
View File

@ -1987,112 +1987,4 @@
==
abet:(~(axon za [our hen [now eny ski] ~] bay) num [van ren bem] q.hin)
[mos ..^$(pol (~(put by pol) our bay))]
::
++ neon !:
|= our/ship
^- (^vane task:able gift:able sign note axle axle)
=| axle
=* lex -
|%
++ load |=(axle +>)
++ stay `axle`+<(pol (~(run by pol) |=(a/baby [tad.a dym.a deh.a ~])))
++ plow
=| $: now/@da
eny/@e
sky/roof
==
|%
++ doze ~
++ peek
|= $: lyc/(unit (set ship))
car/term
bem/beam
==
^- (unit (unit (cask vase)))
[~ ~]
::
++ spin
=| $: hen/duct
moz/(list (pair duct (wind note gift:able)))
==
|%
++ call
|= tac/task:able
^+ +>
=^ vam +>
^+ [p=*(list move) q=+>.$]
?: ?=($wegh -.tac)
:_ +>.$ :_ ~
:^ hen %give %mass
:- %ford
:- %|
%- |= a/(list (list mass)) ^- (list mass)
=+ a2=a
?~ a !!
?~ i.a ~
:_ $(a (turn a2 tail))
:- p.i.i.a
?~ -.q.i.i.a
[%& (turn (turn a2 head) |=(b/mass ?~(-.q.b p.q.b !!)))]
[%| $(a (turn (turn a2 head) |=(b/mass ?~(-.q.b !! p.q.b))))]
%+ turn ~(tap by pol)
|= {@ baby}
:~ =< :+ %cache
%|
(turn `(list term)`/hood/bake/slit/slim/slap/slam .)
=- |=(a/term [a %& (~(get ja dep) a)])
=< `dep/(jar term *)`(~(rep by jav) .)
|=({{* a/{term *}} b/(jar term *)} (~(add ja b) -.a +.a))
::
=< depends+[%| (turn `(list term)`/init/sent/done .)]
=- |=(a/term [a %& (~(get ja dep) a)])
=< `dep/(jar term *)`(~(rep by deh) .)
|=({{@ a/{term *}} b/(jar term *)} (~(add ja b) -.a +.a))
::
tasks+[%& dym tad]
==
=+ our=p.tac
=+ ^= bay ^- baby
=+ buy=(~(get by pol.lex) our)
?~(buy *baby u.buy)
=^ mos bay
?- -.tac
$wipe ~&(%ford-cache-wiped [~ bay(jav ~)])
$wasp
abet:(~(awap za [our hen [now eny ski] ~] bay) q.tac)
$exec
?~ q.tac
abet:~(apax za [our hen [now eny ski] ~] bay)
abet:(~(apex za [our hen [now eny ski] ~] bay) u.q.tac)
==
[mos +>.$(pol (~(put by pol) our bay))]
+>.$(moz (weld `(list move)`vam moz))
::
++ take
|= {tea/wire hin/sign}
^+ +>
=^ vam +>
^+ [p=*(list move) q=+>.$]
?> ?=({@ @ *} tea)
=+ our=(slav %p i.tea)
=+ bay=(~(got by pol.lex) our)
=^ mos bay
=+ dep=(slaw %uv i.t.tea)
?^ dep
=+ bem=(need (de-beam t.t.tea))
=< abet
(~(axun za [our hen [now eny ski] ~] bay) tea u.dep bem hin)
?> ?=({@ @ ^} t.t.tea)
=+ :* num=(slav %ud i.t.tea)
van=((hard vane) i.t.t.tea)
ren=((hard care:clay) i.t.t.t.tea)
bem=(need (de-beam t.t.t.t.tea))
==
=< abet
(~(axon za [our hen [now eny ski] ~] bay) num [van ren bem] hin)
[mos +>.$(pol (~(put by pol) our bay))]
+>.$(moz (weld `(list move)`vam moz))
--
--
--
--

529
sys/vane/gall.hoon
View File

@ -1,19 +1,20 @@
:: :: %gall, agent execution
:: :: %gall, agent execution
!? 163
::::
|= pit/vase
=> =~
=, gall
=> =~
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: rest of arvo
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ volt ?($low $high) :: voltage
++ torc $@(?($ktbr $gold) {$ktwt p/ship}) :: security control
++ torc $@(?($iron $gold) {$lead p/ship}) :: security control
++ roon :: reverse ames msg
$% {$d p/mark q/*} :: diff (diff)
{$x $~} ::
== ::
++ rook :: forward ames msg
$% {$m p/mark q/*} :: message
{$l p/mark q/path} :: "peel" subscribe
{$s p/path} :: subscribe
{$u $~} :: cancel+unsubscribe
== ::
@ -21,23 +22,36 @@
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: local arvo
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ cote :: ++ap note
$% {$meta p/@tas q/vase} ::
{$send p/ship q/cush} ::
$% {$meta p/@tas q/vase} ::
{$send p/ship q/cush} ::
{$hiss p/(unit knot) q/mark r/cage} ::
== ::
++ cove (pair bone (wind cote cuft)) :: internal move
++ move {p/duct q/(wind note-arvo gift:able)} :: typed move
++ move {p/duct q/(wind note-arvo gift-arvo)} :: typed move
-- ::
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: %gall state
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ axle-n ?(axle axle-1) :: upgrade path
++ axle-1 {$1 pol/(map ship mast-1)} ::
++ axle-n ?(axle-1 axle-2 axle-3 axle-4) :: upgrade path
++ axle-1 {$1 pol/(map ship mast-1)} ::
++ mast-1 ::
(cork mast |=(mast +<(bum (~(run by bum) seat-1)))) ::
(cork mast-2 |=(mast-2 +<(bum (~(run by bum) seat-1)))) ::
++ seat-1 ::
(cork seat |=(seat +<+)) ::
(cork seat-2 |=(seat-2 +<+)) ::
++ axle-2 {$2 pol/(map ship mast-2)} ::
++ mast-2 (cork mast-3 |=(mast-3 +<+)) ::
++ seat-2 seat-3 ::
++ axle-3 {$3 pol/(map ship mast-3)} ::
++ mast-3 ::
(cork mast-4 |=(mast-4 +<(bum (~(run by bum) seat-3)))) ::
++ seat-3 ::
(cork seat-4 |=(seat-4 +<+)) ::
++ axle-4 axle ::
++ mast-4 mast ::
++ seat-4 seat ::
:::::::::::::::::::::::::::::::::::::::::::::::::::::: state proper
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ axle :: all state
$: $2 :: state version
$: $4 :: state version
pol/(map ship mast) :: apps by ship
== ::
++ gest :: subscriber data
@ -46,8 +60,9 @@
qel/(map bone @ud) :: queue meter
== ::
++ mast :: ship state
$: sys/duct :: system duct
sap/(map ship scar) :: foreign contacts
$: mak/* :: (deprecated)
sys/duct :: system duct
sap/(map ship scad) :: foreign contacts
bum/(map dude seat) :: running agents
wub/(map dude sofa) :: waiting queue
== ::
@ -56,14 +71,25 @@
q/ship :: attributed to
== ::
++ prey (pair volt ffuc) :: privilege
++ scad :: foreign connection
$: p/@ud :: index
q/(map duct @ud) :: by duct
r/(map @ud duct) :: by index
== ::
++ scar :: opaque input
$: p/@ud :: bone sequence
q/(map duct bone) :: by duct
r/(map bone duct) :: by bone
== ::
== ::
:: ::
:: XX a hack, required to break a subscription loop ::
:: which arises when an invalid mark crashes a diff. ::
:: See usage in ap-misvale. ::
++ misvale-data (set wire) :: subscrs w/ bad marks
++ seat :: agent state
$: vel/worm :: cache
mom/duct :: control duct
$: misvale/misvale-data :: bad reqs
vel/worm :: cache
mom/duct :: control duct
liv/? :: unstopped
toc/torc :: privilege
tyc/stic :: statistics
@ -74,7 +100,7 @@
zam/scar :: opaque ducts
== ::
++ sofa :: queue for blocked
$: kys/(qeu (trel duct prey club)) :: queued tasks
$: kys/(qeu (trel duct prey club)) :: queued kisses
== ::
++ stic :: statistics
$: act/@ud :: change number
@ -94,8 +120,8 @@
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: state machine
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ mo
~% %gall-mo +> ~
|_ $: $: our/@p
~% %gall-mo +> ~
|_ $: $: our/@p
hen/duct
moz/(list move)
==
@ -110,7 +136,7 @@
+<+ (~(got by pol.all) our)
==
::
++ mo-abet :: resolve to
++ mo-abet :: resolve to
^+ [*(list move) +>+]
:_ +>+(pol.all (~(put by pol.all) our +<+))
%- flop
@ -197,8 +223,8 @@
++ mo-bold :: wait for dep
|= {byk/beak dap/dude dep/@uvH}
^+ +>
%+ mo-pass [%sys %dep (scot %p p.byk) q.byk dap ~]
[%f %wasp our dep &]
%+ mo-pass [%sys %dep (scot %p p.byk) q.byk dap ~]
[%f %wasp our dep &]
::
++ mo-boot :: create ship
|= {dap/dude how/?($new $old) byk/beak}
@ -209,7 +235,7 @@
[%f %exec our `[byk %core [byk [dap %app ~]]]]
::
++ mo-away :: foreign request
|= {him/ship caz/cush} ::
|= {him/ship caz/cush} ::
^+ +>
:: ~& [%mo-away him caz]
?: ?=($pump -.q.caz)
@ -221,24 +247,22 @@
:: to this returning pump.
::
+>
?: ?=($peer-not -.q.caz)
:: short circuit error
(mo-give %unto %reap (some p.q.caz))
=^ num +>.$ (mo-bale him)
=+ ^= roc ^- rook
?- -.q.caz
$peel !!
$poke [%m p.p.q.caz q.q.p.q.caz]
$pull [%u ~]
$puff !!
$punk !!
$peel [%l p.q.caz q.q.caz]
$peer [%s p.q.caz]
==
=+ ^= dak
?+ -.q.caz !!
$poke %k
$pull %l
$peer %r
==
%+ mo-pass
[%sys %way ~]
`note-arvo`[%a %wont [our him] [%g dak p.caz ~] [42 roc]]
%+ mo-pass
[%sys %way -.q.caz ~]
`note-arvo`[%a %want [our him] [%g %ge p.caz ~] [num roc]]
::
++ mo-baal :: error convert a
|= art/(unit ares)
@ -252,16 +276,39 @@
`[[%leaf (trip p.u.ars)] q.u.ars]
::
++ mo-awed :: foreign response
|= {him/ship why/?($peer $poke $pull) art/(unit ares)}
|= {him/ship why/?($peer $peel $poke $pull) art/(unit ares)}
^+ +>
:: ~& [%mo-awed him why art]
=+ tug=(mo-baba (mo-baal art))
?- why
$peel (mo-give %unto %reap tug)
$peer (mo-give %unto %reap tug)
$poke (mo-give %unto %coup tug)
$pull +>.$
==
::
++ mo-bale :: assign outbone
|= him/ship
^- {@ud _+>}
=+ sad=(fall (~(get by sap) him) `scad`[1 ~ ~])
=+ nom=(~(get by q.sad) hen)
?^ nom [u.nom +>.$]
:- p.sad
%_ +>.$
sap
%+ ~(put by sap) him
%_ sad
p +(p.sad)
q (~(put by q.sad) hen p.sad)
r (~(put by r.sad) p.sad hen)
==
==
::
++ mo-ball :: outbone by index
|= {him/ship num/@ud}
^- duct
(~(got by r:(~(got by sap) him)) num)
::
++ mo-come :: handle locally
|= {her/ship caz/cush}
^+ +>
@ -314,30 +361,40 @@
==
::
$red :: diff ack
?> ?=({@ @ $~} t.pax)
?> ?=({$a ?($waft $woot) *} sih)
?> ?=({@ @ @ $~} t.pax)
?. ?=({$a $woot *} sih)
~& [%red-went pax]
+>.$
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
=> .(pax `path`[%req t.pax])
?- +<.sih
$waft
~& %red-waft
=+ fay=((hard (unit (pair mark noun))) r.+>.sih)
(mo-give %unto ?~(fay [%quit ~] [%doff u.fay]))
::
$woot
?~ r.+>.sih
(mo-pass [%sys pax] %g %deal [him our] dap %pump ~)
~& [%diff-bad-ack q.+>.sih]
=. +>.$ (mo-pass [%sys pax] %g %deal [him our] dap %pull ~)
(mo-give %rend [%g %r dap ~] ~)
?~ q.+>.sih
(mo-pass [%sys pax] %g %deal [him our] dap %pump ~)
~& [%diff-bad-ack q.+>.sih] :: should not happen
=. +>.$ (mo-pass [%sys pax] %g %deal [him our] dap %pull ~)
(mo-pass [%sys pax] %a %want [our him] [%g %gh dap ~] [num %x ~])
::
$rep :: reverse request
?> ?=({@ @ @ $~} t.pax)
?> ?=({$f $made *} sih)
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
?- -.q.+>.sih
$tabl ~|(%made-tabl !!)
$| (mo-give %mack `p.q.+>.sih) :: XX should crash
$& =. +>.$ (mo-give %mack ~) :: XX pump should ack
(mo-give(hen (mo-ball him num)) %unto %diff `cage`p.q.+>.sih)
==
::
$req :: inbound request
?> ?=({@ @ $~} t.pax)
?> ?=({@ @ @ $~} t.pax)
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
?: ?=({$f $made *} sih)
?- -.q.+>.sih
@ -350,10 +407,11 @@
=+ cuf=`cuft`+>.sih
?- -.cuf
$coup (mo-give %mack p.cuf)
$diff %+ mo-pass [%sys %red t.pax]
[%a %want [our him] [%g %gh dap ~] [num %d p.p.cuf q.q.p.cuf]]
$quit %+ mo-pass [%sys pax]
[%a %want [our him] [%g %gh dap ~] [num %x ~]]
$reap (mo-give %mack p.cuf)
$diff (mo-give %rend [%g %r dap ~] [~ p.p.cuf q.q.p.cuf])
$doff (mo-give %rend [%g %r dap ~] [~ p.cuf q.cuf])
$quit (mo-give %rend [%g %r dap ~] ~)
==
::
$val :: inbound validate
@ -367,24 +425,12 @@
==
::
$way :: outbound request
?> ?=({$a ?($waft $woot) *} sih)
?- +<.sih
$waft
?> ?=({$g $r @ $~} q.+>.sih)
=+ fay=((hard (unit (pair mark noun))) r.+>.sih)
(mo-give %unto ?~(fay [%quit ~] [%doff u.fay]))
::
$woot
?> ?=({$g @ @ $~} q.+>.sih)
%- mo-awed
:* p.+>.sih
?+ i.t.q.+>.sih !!
$k %poke
$r %peer
$l %pull
==
r.+>.sih
==
?> ?=({$a $woot *} sih)
?> ?=({@ $~} t.pax)
%- mo-awed
:* `ship`p.+>.sih
;;(?($peer $peel $poke $pull) i.t.pax)
+>+.sih
==
==
::
@ -396,47 +442,20 @@
!!
=+ dap=`@tas`i.pax
=+ pry=`prey`[%high [~ (slav %p i.t.pax)]]
=+ pap=(ap-abed:ap dap pry)
=+ pap=(ap-abed:ap dap pry)
=+ vax=(slot 3 `vase`hin)
?- i.t.t.pax
$inn ap-abet:(ap-pour:pap t.t.t.pax (slot 3 `vase`hin))
$inn ap-abet:(ap-pour:pap t.t.t.pax (slot 3 `vase`hin))
$cay ?. ?=({$e $sigh *} q.hin)
~& [%mo-cook-weird q.hin]
~& [%mo-cook-weird-path pax]
+>.$
ap-abet:(ap-purr:pap +<.q.hin t.t.t.pax +>.q.hin)
::
$out ?: ?=({$f $made *} q.hin)
?- -.q.+>.q.hin
$tabl ~|(%made-tabl !!)
$& ap-abet:(ap-pout:pap t.t.t.pax %diff +.q.+>.q.hin)
$|
=+ why=p.q.+>.q.hin
=. why (turn why |=(a/tank rose+[~ "! " ~]^[a]~))
~> %slog.`rose+[" " "[" "]"]^[>%mo-cook-fail< (flop why)]
~& [him=q.q.pry our=our pax=pax]
::
:: here we should crash because the right thing
:: for the client to do is to upgrade so that it
:: understands the server's mark, thus allowing
:: the message to proceed. but ames is not quite
:: ready for promiscuous crashes, so instead we
:: send a pull outward and a quit downward.
:: or not... outgoing dap (XXX) is not in the path.
:: =. +>.$ ap-abet:(ap-pout:pap t.t.t.pax %quit ~)
:: %+ mo-pass
:: [%use pax]
:: [%g %deal [q.q.pry our] XXX %pull ~]
!!
==
?. ?=({$g $unto *} q.hin)
$out ?. ?=({$g $unto *} q.hin)
~& [%mo-cook-weird q.hin]
~& [%mo-cook-weird-path pax]
+>.$
?: ?=($doff +>-.q.hin)
%+ mo-pass
[%use pax]
[%f %exec our ~ byk.pap %vale +.p.q.hin]
ap-abet:(ap-pout:pap t.t.t.pax +>.q.hin)
==
::
@ -474,6 +493,8 @@
%+ mo-pass
[%sys %val (scot %p q.q.pry) dap ~]
[%f %exec our ~ (mo-beak dap) %cast p.cub %$ q.cub]
?: ?=($peer-not -.cub)
(mo-give %unto %reap (some p.cub))
ap-abet:(ap-club:(ap-abed:ap dap pry) cub)
::
++ mo-club :: local action
@ -488,25 +509,29 @@
::
++ mo-gawk :: ames forward
|= {him/@p dap/dude num/@ud rok/rook}
=? +> ?=($u -.rok) (mo-give %mack ~)
%+ mo-pass
[%sys %req (scot %p him) dap ~]
=. +> ?.(?=($u -.rok) +> (mo-give %mack ~))
%+ mo-pass
[%sys %req (scot %p him) dap (scot %ud num) ~]
^- note-arvo
?- -.rok
:: %m [%f %exec our ~ (mo-beak dap) %vale p.rok q.rok]
$m [%g %deal [him our] dap %puff p.rok q.rok]
$l [%g %deal [him our] dap %peel p.rok q.rok]
$s [%g %deal [him our] dap %peer p.rok]
$u [%g %deal [him our] dap %pull ~]
==
::
++ mo-gawp :: response ack
|= {him/@p dap/dude cop/coop}
^+ +>
%+ mo-pass
[%sys %req (scot %p him) dap ~]
?~ cop
[%g %deal [him our] dap %pump ~]
[%g %deal [him our] dap %pull ~]
++ mo-gawd :: ames backward
|= {him/@p dap/dude num/@ud ron/roon}
?- -.ron
$d
%+ mo-pass
[%sys %rep (scot %p him) dap (scot %ud num) ~]
[%f %exec our ~ (mo-beak dap) %vale p.ron q.ron]
::
$x =. +> (mo-give %mack ~) :: XX should crash
(mo-give(hen (mo-ball him num)) %unto %quit ~)
==
::
++ ap :: agent engine
~% %gall-ap +> ~
@ -543,7 +568,7 @@
++ ap-abet :: resolve
^+ +>
=> ap-abut
%_ +>
%_ +>
bum (~(put by bum) dap +<+)
moz :(weld (turn zip ap-aver) (turn dub ap-avid) moz)
==
@ -567,11 +592,11 @@
::
++ ap-aver :: cove to move
|= cov/cove
^- move
^- move
:- (~(got by r.zam) p.cov)
?- -.q.cov
$slip !!
$give
?($slip $sick) !!
$give
?< =(0 p.cov)
?. ?=($diff -.p.q.cov)
[%give %unto p.q.cov]
@ -598,12 +623,12 @@
~/ %ap-call
|= {cog/term arg/vase}
^- {(unit tang) _+>}
=. +> ap-bowl
=. +> ap-bowl
=^ arm +>.$ (ap-farm cog)
?: ?=($| -.arm) [`p.arm +>.$]
=^ zem +>.$ (ap-slam cog p.arm arg)
?: ?=($| -.zem) [`p.zem +>.$]
(ap-sake p.zem)
(ap-sake p.zem)
::
++ ap-peek
|= {ren/@tas tyl/path}
@ -616,10 +641,9 @@
=+ cug=(ap-find %peek ren tyl)
?~ cug
((slog leaf+"peek find fail" >tyl< >mar< ~) [~ ~])
=. ..ap-bowl ap-bowl
=^ arm +>.$ (ap-farm q.u.cug)
?: ?=($| -.arm) ((slog leaf+"peek farm fail" p.arm) [~ ~])
=^ zem +>.$ (ap-slam q.u.cug p.arm !>((slag p.u.cug `path`[ren tyl])))
=^ zem +>.$ (ap-slam q.u.cug p.arm !>((slag p.u.cug `path`[ren tyl])))
?: ?=($| -.zem) ((slog leaf+"peek slam fail" p.zem) [~ ~])
?+ q.p.zem ((slog leaf+"peek bad result" ~) [~ ~])
$~ ~
@ -642,13 +666,14 @@
$peer (ap-peer +.cub)
$puff !!
$punk !!
$peer-not !!
$pull ap-pull
$pump ap-fall
==
::
++ ap-diff :: pour a diff
|= {her/ship pax/path cag/cage}
=. q.cag (spec q.cag)
:: =. q.cag (spec q.cag)
=+ cug=(ap-find [%diff p.cag +.pax])
?~ cug
%. [| her +.pax]
@ -659,7 +684,7 @@
[!>(`path`+.pax) !>(cag)]
[!>((slag (dec p.u.cug) `path`+.pax)) q.cag]
=^ cam +>.$ (ap-call q.u.cug arg)
?^ cam
?^ cam
(ap-pump:(ap-lame q.u.cug u.cam) | her pax)
(ap-pump & her pax)
::
@ -674,12 +699,12 @@
^+ .
?. (~(has by sup.ged) ost) .
=+ soy=(~(get by qel.ged) ost)
?: |(?=($~ soy) =(0 u.soy))
?: |(?=($~ soy) =(0 u.soy))
:: ~& [%ap-fill-under [our dap] q.q.pry ost]
+
=. u.soy (dec u.soy)
:: ~& [%ap-fill-sub [[our dap] q.q.pry ost] u.soy]
?: =(0 u.soy)
?: =(0 u.soy)
+(qel.ged (~(del by qel.ged) ost))
+(qel.ged (~(put by qel.ged) ost u.soy))
::
@ -688,7 +713,7 @@
|= cog/term
^- {(each vase tang) _+>}
=+ pyz=(mule |.((~(mint wa vel) p.hav [%limb cog])))
?: ?=($| -.pyz)
?: ?=($| -.pyz)
:_(+>.$ [%| +.pyz])
:_ +>.$(vel `worm`+>.pyz)
=+ ton=(mock [q.hav q.+<.pyz] ap-sled)
@ -712,7 +737,7 @@
=+ dep=0
|- ^- (unit (pair @ud term))
=+ ^= spu
?~ pax ~
?~ pax ~
$(pax t.pax, dep +(dep), cog (ap-hype cog i.pax))
?^ spu spu
?.((ap-fond cog) ~ `[dep cog])
@ -757,11 +782,11 @@
?^ -.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (bone)")])
?@ +.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (card)")])
=+ hun=(~(get by r.zam) -.q.vax)
?. (~(has by r.zam) -.q.vax)
?. (~(has by r.zam) -.q.vax)
:_(+>.$ [%| (ap-suck "move: invalid card (bone {<-.q.vax>})")])
=^ pec vel (~(spot wa vel) 3 vax)
=^ cav vel (~(slot wa vel) 3 pec)
?+ +<.q.vax
?+ +<.q.vax
(ap-move-pass -.q.vax +<.q.vax cav)
$diff (ap-move-diff -.q.vax cav)
$hiss (ap-move-hiss -.q.vax cav)
@ -825,7 +850,7 @@
[%| (ap-suck "mess: malformed path")]
[%& [(scot %p q.q.vax) %out r.q.vax u.pux] q.q.vax r.q.vax]
::
++ ap-move-pass :: pass general move
++ ap-move-pass :: pass general move
|= {sto/bone wut/* vax/vase}
^- {(each cove tang) _+>}
?. &(?=(@ wut) ((sane %tas) wut))
@ -867,6 +892,11 @@
=+ pux=((soft path) +>+.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
[%| (ap-suck "peel: malformed path")]
?: (~(has in misvale) p.p.yep)
=/ err [leaf+"peel: misvalidation encountered"]~
:^ %& sto %pass
:- p.p.yep
[%send q.p.yep r.p.yep %peer-not err]
:^ %& sto %pass
:- p.p.yep
[%send q.p.yep r.p.yep %peel u.mar u.pux]
@ -880,6 +910,11 @@
=+ pux=((soft path) +>.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
[%| (ap-suck "peer: malformed path")]
?: (~(has in misvale) p.p.yep)
=/ err [leaf+"peer: misvalidation encountered"]~
:^ %& sto %pass
:- p.p.yep
[%send q.p.yep r.p.yep %peer-not err]
:^ %& sto %pass
:- p.p.yep
[%send q.p.yep r.p.yep %peer u.pux]
@ -952,23 +987,17 @@
++ ap-peer :: apply %peer
|= pax/path
^+ +>
=. +> (ap-peon pax)
=. sup.ged (~(put by sup.ged) ost [q.q.pry pax])
=+ cug=(ap-find %peer pax)
?~ cug +>.$
=+ old=zip
=. zip ~
=^ cam +>.$
=^ cam +>.$
%+ ap-call q.u.cug
!>(`path`(slag p.u.cug pax))
=. zip (weld zip `(list cove)`[[ost %give %reap cam] old])
?^(cam ap-pule +>.$)
::
++ ap-peon :: add subscriber
|= pax/path
%_ +>.$
sup.ged (~(put by sup.ged) ost [q.q.pry pax])
==
::
++ ap-poke :: apply %poke
|= cag/cage
^+ +>
@ -999,6 +1028,11 @@
+>.$
+>.$
::
++ ap-misvale :: broken vale
|= wir/wire
~& [%ap-blocking-misvale wir]
+>(misvale (~(put in misvale) wir))
::
++ ap-pour :: generic take
|= {pax/path vax/vase}
^+ +>
@ -1039,7 +1073,6 @@
?- -.cuf
$coup (ap-take q.q.pry %coup +.pax `!>(p.cuf))
$diff (ap-diff q.q.pry pax p.cuf)
$doff !!
$quit (ap-take q.q.pry %quit +.pax ~)
$reap (ap-take q.q.pry %reap +.pax `!>(p.cuf))
==
@ -1050,6 +1083,10 @@
=^ gac +>.$ (ap-prop vux)
:- gac
%= +>.$
misvale
~? !=(misvale *misvale-data) misvale-drop+misvale
*misvale-data :: new app might mean new marks
::
dub
:_(dub ?~(gac [%& dap ?~(vux %boot %bump) now] [%| u.gac]))
==
@ -1057,7 +1094,7 @@
++ ap-prop :: install
|= vux/(unit vase)
^- {(unit tang) _+>}
?. (ap-fond %prep)
?. (ap-fond %prep)
?~ vux
`+>.$
=+ [new=p:(slot 13 hav) old=p:(slot 13 u.vux)]
@ -1067,8 +1104,8 @@
=^ tur +>.$
%+ ap-call %prep
?~(vux !>(~) (slop !>(~) (slot 13 u.vux)))
?~ tur
`+>.$
?~ tur
`+>.$
:_(+>.$ `u.tur)
::
++ ap-pule :: silent delete
@ -1087,7 +1124,7 @@
==
=+ cug=(ap-find %pull q.u.wim)
?~ cug +>
=^ cam +>
=^ cam +>
%+ ap-call q.u.cug
!>((slag p.u.cug q.u.wim))
?^ cam (ap-lame q.u.cug u.cam)
@ -1104,7 +1141,7 @@
?~ cug
:: ~& [%ap-take-none cog pax]
+>.$
=^ cam +>.$
=^ cam +>.$
%+ ap-call q.u.cug
=+ den=!>((slag p.u.cug pax))
?~(vux den (slop den u.vux))
@ -1139,7 +1176,7 @@
:- ~
%_ +>.$
zip (weld (flop p.muz) zip)
hav p.sav
hav p.sav
==
::
++ ap-save :: verify core
@ -1177,7 +1214,7 @@
[%leaf (weld "gall: {<dap>}: " msg)]~
::
++ ap-term :: atomic vase
|= {a/@tas b/@}
|= {a/@tas b/@}
^- vase
[[%atom a `b] b]
::
@ -1191,21 +1228,18 @@
$deal `%g
$exec `%f
$flog `%d
$funk `%a
$drop `%c
$info `%c
$merg `%c
$mont `%c
$dirk `%c
$nuke `%a
$ogre `%c
$serv `%e
$them `%e
$wait `%b
$want `%a
$wont `%a :: XX for begin; remove
$warp `%c
$wipe `%f :: XX cache clear
$jaelwomb `%j :: XX name/unpack
==
--
--
@ -1228,45 +1262,40 @@
(mo-away:(mo-abed:mo p.p.q.hic hen) q.p.q.hic q.q.hic)
(mo-come:(mo-abed:mo q.p.q.hic hen) p.p.q.hic q.q.hic)
::
$init
$init
:: ~& [%gall-init p.q.hic]
[~ ..^$(pol.all (~(put by pol.all) p.q.hic [hen ~ ~ ~]))]
::
$went
?. (~(has by pol.all) p.p.q.hic)
~& [%gall-not-ours p.q.hic]
[~ ..^$]
?> ?=({?($k $l $r) @ $~} q.q.hic)
=+ dap=i.t.q.q.hic
=+ our=p.p.q.hic
=+ him=q.p.q.hic
=< mo-abet
(mo-gawp:(mo-abed:mo our hen) him dap s.q.hic)
[~ ..^$(pol.all (~(put by pol.all) p.q.hic %*(. *mast sys hen)))]
::
$west
?. (~(has by pol.all) p.p.q.hic)
~& [%gall-not-ours p.q.hic]
[~ ..^$]
?> ?=({?($k $l $r) @ $~} q.q.hic)
?> ?=({?($ge $gh) @ $~} q.q.hic)
=+ dap=i.t.q.q.hic
=+ our=p.p.q.hic
=+ him=q.p.q.hic
=+ mes=((hard {@ud rook}) s.q.hic)
?: ?=($ge i.q.q.hic)
=+ mes=((hard {@ud rook}) r.q.hic)
=< mo-abet
(mo-gawk:(mo-abed:mo our hen) him dap mes)
=+ mes=((hard {@ud roon}) r.q.hic)
=< mo-abet
(mo-gawk:(mo-abed:mo our hen) him dap mes)
(mo-gawd:(mo-abed:mo our hen) him dap mes)
::
$wegh
:_ ..^$ :_ ~
:^ hen %give %mass
:- %gall
:- %|
%+ turn ~(tap by pol.all) :: XX single-home
%+ turn ~(tap by pol.all) :: XX single-home
|= {our/@ mast} ^- mass
:+ (scot %p our) %|
:~ [%foreign [%& sap]]
[%blocked [%| (sort ~(tap by (~(run by wub) |=(sofa [%& +<]))) aor)]]
[%active [%| (sort ~(tap by (~(run by bum) |=(seat [%& +<]))) aor)]]
==
::
$went !! :: XX fixme
==
::
++ doze :: sleep until
@ -1277,18 +1306,35 @@
++ load :: recreate vane
|= old/axle-n
^+ ..^$
?: ?=($2 -.old) ..^$(all old)
%= $
old => |=(seat-1 `seat`[*worm +<])
=> |=(mast-1 +<(bum (~(run by bum) +>)))
old(- %2, pol (~(run by pol.old) .))
?- -.old
$4 ..^$(all old)
$3
%= $
old ^- axle-4
=> |=(seat-3 `seat-4`[*misvale-data +<])
=> |=(mast-3 +<(bum (~(run by bum) +>)))
old(- %4, pol (~(run by pol.old) .))
==
::
$2
%= $
old ^- axle-3
=> |=(mast-2 [*(unit duct) +<])
old(- %3, pol (~(run by pol.old) .))
==
::
$1
%= $
old ^- axle-2
=> |=(seat-1 `seat-2`[*worm +<])
=> |=(mast-1 +<(bum (~(run by bum) +>)))
old(- %2, pol (~(run by pol.old) .))
==
==
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
|= {fur/(unit (set monk)) ren/@tas who/ship syd/desk lot/coin tyl/path}
^- (unit (unit cage))
?. ?=($& -.why) ~
=* who p.why
?: ?& =(%u ren)
=(~ tyl)
=([%$ %da now] lot)
@ -1313,138 +1359,11 @@
|= {tea/wire hen/duct hin/(hypo sign-arvo)}
^+ [p=*(list move) q=..^$]
~| [%gall-take tea]
?> ?=({@ ?($sys $use) *} tea)
?> ?=({@ ?($sys $use) *} tea)
=+ our=(need (slaw %p i.tea))
=+ mow=(mo-abed:mo our hen)
?: ?=($sys i.t.tea)
mo-abet:(mo-cyst:mow t.t.tea q.hin)
?> ?=($use i.t.tea)
mo-abet:(mo-cook:mow t.t.tea hin)
::
++ neon !:
|= our/ship
^- (vane task:able gift:able sign-arvo note-arvo axle axle)
=| axle
=* lex -
|%
++ load |=(axle +>)
++ stay `axle`+<
++ plow
=| $: now/@da
eny/@e
sky/roof
==
|%
++ doze ~
++ peek
|= $: lyc/(unit (set ship))
car/term
bem/beam
==
^- (unit (unit (cask vase)))
=* who p.bem
?: ?& =(%u car)
=(~ s.bem)
=([%da now] r.bem)
(~(has by pol.all) who)
(~(has by bum:(~(got by pol.all) who)) q.bem)
==
``[%null !>(~)]
?. (~(has by pol.all) who)
~
?. =([%da now] r.bem)
~
?. (~(has by bum:(~(got by pol.all) who)) q.bem)
[~ ~]
?. ?=(^ s.bem)
~
(mo-peek:(mo-abed:mo who *duct) q.bem high+`who car s.bem)
::
++ spin
=| $: hen/duct
moz/(list (pair duct (wind note-arvo gift:able)))
==
|%
++ call
|= tac/task:able
^+ +>
=^ vam ..^^$
^+ [p=*(list move) q=..^^$]
?- -.tac
$conf
?. (~(has by pol.all) p.p.tac)
~& [%gall-not-ours p.p.tac]
[~ ..^^$]
mo-abet:(mo-conf:(mo-abed:mo p.p.tac hen) q.p.tac q.tac)
::
$deal
=< mo-abet
?. (~(has by pol.all) q.p.tac) :: either to us
?> (~(has by pol.all) p.p.tac) :: or from us
(mo-away:(mo-abed:mo p.p.tac hen) q.p.tac q.tac)
(mo-come:(mo-abed:mo q.p.tac hen) p.p.tac q.tac)
::
$init
:: ~& [%gall-init p.tac]
[~ ..^^$(pol.all (~(put by pol.all) p.tac [hen ~ ~ ~]))]
::
$went
?. (~(has by pol.all) p.p.tac)
~& [%gall-not-ours p.tac]
[~ ..^^$]
?> ?=({?($k $l $r) @ $~} q.tac)
=+ dap=i.t.q.tac
=+ our=p.p.tac
=+ him=q.p.tac
=< mo-abet
(mo-gawp:(mo-abed:mo our hen) him dap s.tac)
::
$west
?. (~(has by pol.all) p.p.tac)
~& [%gall-not-ours p.tac]
[~ ..^^$]
?> ?=({?($k $l $r) @ $~} q.tac)
=+ dap=i.t.q.tac
=+ our=p.p.tac
=+ him=q.p.tac
=+ mes=((hard {@ud rook}) s.tac)
=< mo-abet
(mo-gawk:(mo-abed:mo our hen) him dap mes)
::
$wegh
:_ ..^^$ :_ ~
:^ hen %give %mass
:- %gall
:- %|
%+ turn ~(tap by pol.all) :: XX single-home
|= {our/@ mast} ^- mass
:+ (scot %p our) %|
:~ :- %foreign
[%& sap]
:- %blocked
[%| (sort ~(tap by (~(run by wub) |=(sofa [%& +<]))) aor)]
:- %active
[%| (sort ~(tap by (~(run by bum) |=(seat [%& +<]))) aor)]
==
==
+>.$(moz (weld `(list move)`vam moz))
::
++ take
|= {tea/wire hin/sign-arvo}
^+ +>
=^ vam ..^^$
^+ [p=*(list move) q=..^^$]
~| [%gall-take tea]
?> ?=({@ ?($sys $use) *} tea)
=+ our=(need (slaw %p i.tea))
=+ mow=(mo-abed:mo our hen)
?: ?=($sys i.t.tea)
mo-abet:(mo-cyst:mow t.t.tea hin)
?> ?=($use i.t.tea)
=+ vax=!>(hin)
mo-abet:(mo-cook:mow t.t.tea -.vax hin)
+>.$(moz (weld `(list move)`vam moz))
--
--
--
?- i.t.tea
$sys mo-abet:(mo-cyst:mow t.t.tea q.hin)
$use mo-abet:(mo-cook:mow t.t.tea hin)
==
--

344
sys/vane/jael.hoon
View File

@ -22,7 +22,6 @@
=, able:jael
=, title
=, crypto
=* womb womb:jael
=, jael
:: ::::
:::: # models :: data structures
@ -298,7 +297,7 @@
0w0 :: 193, ~duc, Tlon
0w0 :: 194, ~fur, Tlon
0w0 :: 195, ~fex, Tlon
0w0 :: 196, ~nul, Tlon
0w0 :: 196, ~nul, Matthew Liston
0w0 :: 197, ~luc, Tlon
0w0 :: 198, ~len, Tlon
0w0 :: 199, ~ner, Tlon
@ -446,7 +445,7 @@
[n.b ~ ~]
:: :: ++put:py
++ put :: insert
|= b/@ ^- pile
|= b/ship ^- pile
(uni [b b] ~ ~)
:: :: ++sub:py
++ sub :: subtract
@ -469,10 +468,10 @@
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
::
++ tap
=| out/(list @u)
=| out/(list (pair ship ship))
|- ^+ out
?~ a out
$(a l.a, out (welp (gulf n.a) $(a r.a)))
$(a l.a, out [n.a $(a r.a)])
:: :: ++uni:py
++ uni :: merge two piles
|= b/pile
@ -520,7 +519,7 @@
$apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt))
$block ?>(?=($block -.ryt) [~ ~])
$email ?>(?=($email -.ryt) (sable %email p.lef p.ryt))
$final ?>(?=($final -.ryt) (cable %final p.lef p.ryt))
$final ?>(?=($final -.ryt) (table %final p.lef p.ryt))
$fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt))
$guest ?>(?=($guest -.ryt) [~ ~])
$hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt))
@ -530,11 +529,6 @@
$token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt))
$urban ?>(?=($urban -.ryt) (table %urban p.lef p.ryt))
==
:: :: ++cable:dif:ry
++ cable :: diff atom
|* {nut/@tas new/@ old/@}
?: =(new old) [~ ~]
[`[nut new] `[nut old]]
:: :: ++bible:dif:ry
++ bible :: diff pile
|* {nut/@tas new/(map dorm pile) old/(map dorm pile)}
@ -630,7 +624,7 @@
$apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)])
$block ?>(?=($block -.ryt) [%block ~])
$email ?>(?=($email -.ryt) [%email (sable p.lef p.ryt)])
$final ?>(?=($final -.ryt) [%final (cable p.lef p.ryt)])
$final ?>(?=($final -.ryt) [%final (table p.lef p.ryt)])
$fungi ?>(?=($fungi -.ryt) [%fungi (noble p.lef p.ryt)])
$guest ?>(?=($guest -.ryt) [%guest ~])
$hotel ?>(?=($hotel -.ryt) [%hotel (bible p.lef p.ryt)])
@ -640,11 +634,6 @@
$token ?>(?=($token -.ryt) [%token (ruble p.lef p.ryt)])
$urban ?>(?=($urban -.ryt) [%urban (table p.lef p.ryt)])
==
:: :: ++cable:uni:ry
++ cable :: union atom
|= {new/@ old/@}
?> =(new old)
new
:: :: ++bible:uni:ry
++ bible :: union pile
|= {new/(map dorm pile) old/(map dorm pile)}
@ -711,7 +700,7 @@
|= ryt/rite
^- safe
?~ pig
!! :: not found
~
?. =(-.ryt -.n.pig)
?: (gor -.ryt -.n.pig)
[n.pig $(pig l.pig) r.pig]
@ -794,7 +783,7 @@
[%apple (~(run by p.rys) |=(@ (mug +<)))]
::
$final
[%final (mug p.rys)]
[%final (~(run by p.rys) |=(@ (mug +<)))]
::
$login
[%login ~]
@ -852,7 +841,7 @@
(bind instant |=((pair life cert) p))
:: :: ++forward:we
++ forward :: sort oldest first
(collate |=({{a/life *} {b/life *}} (lth a b)))
(collate |=({a/{life *} b/{life *}} (lth -.a -.b)))
:: :: ++instant:we
++ instant :: current cert
^- (unit (pair life cert))
@ -860,7 +849,7 @@
?~(- ~ `i)
:: :: ++reverse:we
++ reverse :: sort latest first
(collate |=({{a/life *} {b/life *}} (gth a b)))
(collate |=({a/{life *} b/{life *}} (gth -.a -.b)))
--
--
:: ::::
@ -912,35 +901,6 @@
++ burb :: per ship
|= who/ship
~(able ~(ex ur urb) who)
::
:: ++read is currently unavailable
:: ++ read-womb
:: =, wired :: XX ":eyre"
:: =, womb
:: |= pax/path ^- (unit scry:womb)
:: ?~ pax ~
:: ?+ i.pax ~
:: $balance
:: %+ bind (read t.pax /[%uv])
:: |=(a/passcode [%balance a])
:: ::
:: $stats
:: %+ bind (read t.pax /[%p])
:: |=(a/ship [%stats a])
:: ::
:: $shop
:: %+ biff (read t.pax /[%tas]/[%ud])
:: |= {typ/term nth/@u}
:: ?. ?=(?($star $planet) typ) ~
:: `[%shop typ nth]
:: ==
:: :: ++scry:of
++ scry :: read
|= {syd/@tas pax/path} ^- (unit gilt)
~
:: ?+ syd ~
:: $womb (biff (read-womb pax) scry-womb:(burb our))
:: ==
:: :: ++call:of
++ call :: invoke
|= $: :: hen: event cause
@ -1010,13 +970,6 @@
$next
(cure abet:abet:(next:(burb our) eny.sys p.tac))
::
::
:: extend our certificate with a new private key
:: {$jaelwomb p/task:womb}
::
$jaelwomb
(cure abet:abet:(jaelwomb:(burb our) p.tac))
::
:: open secure channel
:: {$veil p/ship}
::
@ -1509,8 +1462,6 @@
:: it is the best reference for the semantics of
:: the urbit pki.
::
=* our !!
::
:: it is absolutely verboten to use [our] in ++ur.
::
=| hab/(list change)
@ -1553,6 +1504,73 @@
|= rex/ship
^- (pair life (map life ring))
lean:~(able ex rex)
:: :: ++make:ur
++ make :: initialize urbit
|= $: :: now: date
:: eny: entropy
:: gen: bootstrap ticket
:: nym: self-description
::
now/@da
eny/@e
gen/@pG
nym/arms
==
^+ +>
:: key: generated key
:: bul: initial bull
::
=/ key (ypt:scr (mix our %jael-make) gen)
=* doc `bull`[(sein our) & nym]
::
:: register generator as login secret
::
=. +>.$ abet:(deal:~(able ex our) our [[[%login [gen ~ ~]] ~ ~] ~])
::
:: initialize hierarchical property
::
=. +>.$
=- abet:(deal:~(able ex our) our - ~)
^- safe
%- intern:up
^- (list rite)
=/ mir (clan our)
?+ mir ~
$czar
:~ [%fungi [%usr 255] ~ ~]
[%hotel [[our 3] [1 255] ~ ~] ~ ~]
==
$king
:~ [%fungi [%upl 65.535] ~ ~]
[%hotel [[our 4] [1 65.535] ~ ~] ~ ~]
==
$duke
:~ [%hotel [[our 5] [1 0xffff.ffff] ~ ~] ~ ~]
==
==
::
:: create initial communication secrets
::
?: (lth our 256)
::
:: create galaxy with generator as seed
::
abet:(next:~(able ex our) key doc)
::
:: had: key handle
:: ryt: initial right
::
=/ key (ypt:scr (mix our %jael-make) gen)
=* had (shaf %hand key)
=* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~]
::
:: register initial symmetric key from ticket
::
=. +>.$ abet:(hail:~(able ex (sein our)) our %& [ryt ~ ~])
::
:: create initial private key and certificate
::
abet:(next:~(able ex our) (mix eny key) doc)
:: :: ++meet:ur
++ meet :: calculate merge
|= $: :: vie: authenticated source
@ -1637,72 +1655,6 @@
|= pal/ship
^- safe
=-(?~(- ~ u.-) (~(get by shy) pal))
:: :: ++make:ex:ur
++ make :: initialize urbit
|= $: :: now: date
:: eny: entropy
:: gen: bootstrap ticket
:: nym: self-description
::
now/@da
eny/@e
gen/@pG
nym/arms
==
^+ +>
::
:: register generator as login secret
::
=. +>.$ (deal rex [[[%login [gen ~ ~]] ~ ~] ~])
::
:: initialize hierarchical property
::
=. +>.$
=- (deal rex - ~)
^- safe
%- intern:up
^- (list rite)
=/ mir (clan rex)
?+ mir ~
$czar
:~ [%fungi [%usr 255] ~ ~]
[%hotel [[rex 3] [1 255] ~ ~] ~ ~]
==
$king
:~ [%fungi [%upl 65.535] ~ ~]
[%hotel [[rex 4] [1 65.535] ~ ~] ~ ~]
==
$duke
:~ [%hotel [[rex 5] [1 0xffff.ffff] ~ ~] ~ ~]
==
==
::
:: create initial communication secrets
::
:: key: generated key
:: bul: initial bull
::
=/ key (ypt:scr (mix rex %jael-make) gen)
=* doc `bull`[(sein rex) & nym]
?: (lth rex 256)
::
:: create galaxy with generator as seed
::
(next key doc)
::
:: had: key handle
:: ryt: initial right
::
=* had (shaf %hand key)
=* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~]
::
:: register initial symmetric key from ticket
::
=. ..ex abet:(hail:~(able ex (sein rex)) rex %& [ryt ~ ~])
::
:: create initial private key and certificate
::
(next (mix eny key) doc)
:: :: ++next:ex:ur
++ next :: advance private key
|= {eny/@e doc/bull}
@ -1725,139 +1677,6 @@
=. +>.$ (deal rex [[ryt ~ ~] ~])
=. ..ex (meet [~ ~] hec)
+>.$
::
++ as-hotel :: XX moveme
|= a/ship ^- (map {ship bloq} pile)
=/ b (xeb (xeb a))
=- (my:nl - ~)
:- [(sein a) b]
(put:py (rsh (dec b) 1 a))
::
++ add-rite :: new promise
|=({pal/ship ryt/rite} (deal pal [ryt ~ ~] ~))
::
++ mov-rite :: transfer promise
|= {{pal/ship par/ship} ryt/rite}
^+ +>
=. deal (deal pal ~ [ryt ~ ~])
(deal par [ryt ~ ~] ~)
::
++ del-rite :: dead promise
|=({pal/ship ryt/rite} (deal pal ~ [ryt ~ ~]))
::
++ jaelwomb :: manage ship %fungi
|= taz/task:womb
^+ +>
?- -.taz
::
:: create passcode balance
:: {$invite tid/passcode inv/{who/mail pla/@ud sta/@ud}}
::
$invite
=/ pas/@p (shaf %pass tid.taz)
=* inv inv.taz
?< (~(has by shy) pas)
=. +>.$ (add-rite pas [%email (si:nl who.inv ~)])
%+ mov-rite [rex pas]
[%fungi (my:nl [%upl pla.inv] [%usr sta.inv] ~)]
::
:: increase existing balance
:: {$reinvite aut/passcode pla/@ud sta/@ud}
::
$bonus
=/ pas/@p (shaf %pass tid.taz)
?> (~(has by shy) pas)
%+ mov-rite [rex pas]
[%fungi (my:nl [%upl pla.taz] [%usr sta.taz] ~)]
::
:: split passcode balance
:: {$reinvite aut/passcode tid/passcode inv/{who/mail pla/@ud sta/@ud}}
::
$reinvite
=/ pas/@p (shaf %pass tid.taz)
=* inv inv.taz
?< (~(has by shy) pas)
=. +>.$ (add-rite pas [%email (si:nl who.inv ~)])
:: XX history
=/ ole/@p (shaf %pass aut.taz)
%+ mov-rite [ole pas]
[%fungi (my:nl [%upl pla.inv] [%usr sta.inv] ~)]
::
:: redeem ship invitation
:: {$claim aut/passcode her/@p tik/ticket}
::
$claim
=/ pas/@p (shaf %pass aut.taz)
?> =(rex (sein her.taz)) :: XX deal with foreign ships?
=/ len (xeb (xeb her.taz))
=/ fun ?+((clan her.taz) !! $duke %upl, $king %usr)
=. +>.$
(del-rite pas [%fungi (my:nl [fun 1] ~)])
=. +>.$
(del-rite rex [%hotel (as-hotel her.taz)])
=/ who (need %.(%email ~(expose up (lawn pas))))
=. +>.$ (add-rite her.taz who)
(add-rite her.taz [%final tik.taz])
==
:: :: div-at-most:ex:ur
++ div-at-most :: skip n ships
|= {a/pile b/@u} ^- (pair pile pile)
(fall (~(div py a) b) [a *pile])
:: :: scry-womb:ex:ur
++ scry-womb :: read data
|= req/scry:womb ^- (unit gilt:womb)
?- -.req
::
:: ship details
:: {$stats who/ship}
::
$stats
%+ some %womb-owner
%+ bind (~(get by shy) who.req)
|= a/safe ^- mail:womb
:: XX deal with multiple emails?
=+ (need (~(expose up a) %email))
?> ?=({$email {@ $~ $~}} -)
n.p.-
::
:: invite details
:: {$balance aut/passcode}
::
$balance
%+ some %womb-balance
%+ bind (~(get by shy) (shaf %pass aut.req))
|= a/safe ^- balance:womb
=/ who :: XX deal with multiple emails?
=+ (need (~(expose up a) %email))
?> ?=({$email {@ $~ $~}} -)
n.p.-
=/ fun
=+ (fall (~(expose up a) %fungi) [%fungi p=~])
?> ?=($fungi -.-)
p.-
:+ who=who
pla=(fall (~(get by fun) %earl) 0)
sta=(fall (~(get by fun) %king) 0)
::
:: available ships
:: {$shop typ/?($star $planet) nth/@u}
::
$shop
=* ships-per-shop 3
=* skip-ships (mul nth.req ships-per-shop)
::
%+ some %ships ^- (list ship)
=/ hot
=+ (fall (~(expose up (lawn rex)) %hotel) [%hotel p=~])
?> ?=($hotel -.-)
p.-
=/ syz/bloq ?-(typ.req $star 3, $planet 4)
=/ pyl/pile (fall (~(get by hot) [rex syz]) ~)
=. pyl q:(div-at-most pyl skip-ships)
=/ got p:(div-at-most pyl ships-per-shop)
%+ turn ~(tap py got)
|=(a/@u `ship`(rep syz ~[rex a]))
==
:: :: grow:ex:ur
++ grow :: merge wills
|= $: :: vie: data source
@ -2143,7 +1962,7 @@
==
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task) p.q.hic)))
^- {p/(list move) q/_..^$}
=^ did lex abet:(~(call of [now eny] lex) hen q.hic)
=^ did lex abet:~(call of [now eny] lex)
[did ..^$]
:: :: ++doze
++ doze :: await
@ -2180,12 +1999,7 @@
tyl/spur
==
^- (unit (unit cage))
:: XX security
?. =(lot [%$ %da now]) ~
%- some
?. =(%$ ren) ~
%+ bind (~(scry of [now eny] lex) syd tyl)
|=(a/gilt [-.a (slot 3 (spec !>(a)))])
~
:: :: ++stay
++ stay :: preserve
lex

201
sys/zuse.hoon
View File

@ -93,47 +93,59 @@
++ ames ^?
|%
:: ::
:::: ++able:behn :: (1a1) arvo moves
:::: ++able:ames :: (1a1) arvo moves
:: ::::
++ able ^?
|%
++ card :: out cards
$% {$went p/sack q/path r/@ud s/coop} :: response confirm
{$west p/sack q/path r/@ud s/*} :: network request
== ::
++ note :: out request $->
$? $: $d :: to %dill
$% {$flog p/flog:dill} ::
== == ::
$: $a :: to %ames
$% {$kick p/@da} ::
== == ::
$: $g :: to %gall
$% {$deal p/sock q/cush:gall} ::
== == ::
$: @tas :: to any
$% {$init p/@p} ::
{$west p/sack q/path r/*} ::
== == == ::
++ gift :: out result <-$
$% {$drop $~} :: drop packet
{$hear p/lane q/@} :: receive packet
{$east p/sock q/*} :: network response
$% {$hear p/lane q/@} :: receive packet
{$init p/@p} :: report install
{$mack p/(unit tang)} ::
{$mass p/mass} :: memory usage
{$send p/lane q/@} :: transmit packet
{$waft p/ship q/path r/*} :: response message
{$wart p/sock q/@tas r/path s/*} :: network request
{$went p/ship q/cape} :: reaction message
{$woot p/ship q/path r/coop} :: e2e reaction message
== ::
++ note :: out request $->
$% {$c card} :: to %clay
{$e card} :: to %eyre
{$g card} :: to %gall
{$woot p/ship q/coop} :: reaction message
== ::
++ sign :: in result _<-
$? $: $g :: from %gall
$% {$unto p/cuft:gall} ::
{$mean p/ares} :: XX old clean up
{$nice $~} ::
== == ::
$: @tas ::
$% {$crud p/@tas q/(list tank)} :: by any
{$mack p/(unit tang)} :: message ack
{$woot p/ship q/coop} :: reaction message
== == == ::
++ task :: in request ->$
$% :: {$born p/@p q/@pG r/?} :: ticket birth
{$barn $~} :: new unix process
$% {$barn $~} :: new unix process
{$crud p/@tas q/(list tank)} :: error with trace
{$cash p/@p q/buck} :: civil license
:: {$funk p/@p q/@p r/@} :: symtix from/to/key
{$hear p/lane q/@} :: receive packet
{$halo p/lane q/@ r/ares} :: hole with trace
{$hole p/lane q/@} :: packet failed
{$junk p/@} :: entropy
{$kick p/@da} :: wake up
{$nuke p/@p} :: toggle auto-block
{$make p/(unit @t) q/@ud r/@ s/?} :: wild license
{$sith p/@p q/@uw r/@uw} :: user/ticket/secret
{$sith p/@p q/@uw r/?} :: imperial generator
{$wake $~} :: timer activate
{$want p/sock q/path r/*} :: send message
{$wegh $~} :: report memory
{$wont p/sock q/path r/*} :: e2e send message
{$west p/sack q/path r/*} :: network request
{$want p/sock q/path r/*} :: forward message
== ::
-- ::able
::
@ -164,6 +176,19 @@
-- ::nu ::
-- ::acru ::
++ bait {p/skin q/@ud r/dove} :: fmt nrecvd spec
++ bath :: convo per client
$: sop/shed :: not stalled
raz/(map path race) :: statements inbound
ryl/(map path rill) :: statements outbound
== ::
++ boon :: fort output
$% {$beer p/ship q/@uvG} :: gained ownership
{$cake p/sock q/soap r/coop s/duct} :: e2e message result
{$mead p/lane q/rock} :: accept packet
{$milk p/sock q/soap r/*} :: e2e pass message
{$ouzo p/lane q/rock} :: transmit packet
{$wine p/sock q/tape} :: notify user
== ::
++ bray {p/life q/(unit life) r/ship s/@da} :: our parent us now
++ buck {p/mace q/wyll} :: all security data
++ cake {p/sock q/skin r/@} :: top level packet
@ -177,6 +202,12 @@
qim/(map hand code) :: inbound
== ::
++ code @uvI :: symmetric key
++ corn :: flow by server
$: hen/duct :: admin channel
nys/(map flap bait) :: packets incoming
olz/(map flap cape) :: packets completed
wab/(map ship bath) :: relationship
== ::
++ deyd {p/@ q/step r/?} :: sig stage fake?
++ dore :: foreign contact
$: wod/road :: connection to
@ -189,6 +220,14 @@
$: rtt/@dr :: decaying avg rtt
wid/@ud :: logical wdow msgs
== ::
++ fort :: formal state
$: $0 :: version
gad/duct :: client interface
hop/@da :: network boot date
bad/(set @p) :: bad ships
ton/town :: security
zac/(map ship corn) :: flows by server
== ::
++ gcos :: id description
$% {$czar $~} :: 8-bit ship
{$duke p/what} :: 32-bit ship
@ -209,10 +248,8 @@
++ life @ud :: regime number
++ mace (list {p/life q/ring}) :: private secrets
++ meal :: payload
$% {$back p/cape q/flap r/@dr} :: acknowledgment
{$buck p/coop q/flap r/@dr} :: e2e ack
$% {$back p/coop q/flap r/@dr} :: ack
{$bond p/life q/path r/@ud s/*} :: message
{$bund p/life q/path r/@ud s/*} :: e2e message
{$carp p/@ q/@ud r/@ud s/flap t/@} :: skin+inx+cnt+hash
{$fore p/ship q/(unit lane) r/@} :: forwarded packet
== ::
@ -349,7 +386,7 @@
{$warp p/sock q/riff} :: file request
{$wegh $~} :: report memory
{$went p/sack q/path r/@ud s/coop} :: response confirm
{$west p/sack q/path r/@ud s/*} :: network request
{$west p/sack q/path r/*} :: network request
== ::
-- ::able
::
@ -474,7 +511,7 @@
{$mass p/mass} :: memory usage
{$send p/lane:ames q/@} :: transmit packet
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: old reboot
{$vega p/path q/path} :: old reboot
{$velo p/@t q/@t} :: reboot
{$verb $~} :: verbose mode
== ::
@ -495,7 +532,7 @@
{$talk p/tank} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: old reboot
{$vega p/path q/path} :: old reboot
{$velo p/@t q/@t} :: reboot
{$verb $~} :: verbose mode
== ::
@ -556,7 +593,7 @@
{$heft $~} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: old reboot
{$vega p/path q/path} :: old reboot
{$velo p/@t q/@t} :: reboot
{$verb $~} :: verbose mode
== ::
@ -579,32 +616,30 @@
:: ::::
++ able ^?
|%
++ gift :: out result <-$
$% {$mass p/mass} :: memory usage
{$mack p/(unit tang)} :: message ack
{$sigh p/cage} :: marked http response
{$thou p/httr} :: raw http response
{$thus p/@ud q/(unit hiss)} :: http request+cancel
{$veer p/@ta q/path r/@t} :: drop-through
{$vega p/path} :: drop-through
{$velo p/@t q/@t} :: drop-through
{$mini-jael-gift *}
+= gift :: out result <-$
$% [%mass p=mass] :: memory usage
[%mack p=(unit tang)] :: message ack
[%sigh p=cage] :: marked http response
[%thou p=httr] :: raw http response
[%thus p=@ud q=(unit hiss)] :: http request+cancel
[%veer p=@ta q=path r=@t] :: drop-through
[%vega p=path q=path] :: drop-through
[%velo p=@t q=@t] :: drop-through
== ::
++ task :: in request ->$
$% {$born $~} :: new unix process
{$crud p/@tas q/(list tank)} :: XX rethink
{$hiss p/(unit user) q/mark r/cage} :: outbound user req
{$init p/@p} :: report install
{$serv p/$@(desk beam)} :: set serving root
{$them p/(unit hiss)} :: outbound request
{$they p/@ud q/httr} :: inbound response
{$chis p/? q/clip r/httq} :: IPC inbound request
{$this p/? q/clip r/httq} :: inbound request
{$thud $~} :: inbound cancel
{$wegh $~} :: report memory
{$went p/sack q/path r/@ud s/coop} :: response confirm
{$west p/sack q/{path @ud *}} :: network request
{$mini-jael-task *}
+= task :: in request ->$
$% [%born ~] :: new unix process
[%crud p=@tas q=(list tank)] :: XX rethink
[%hiss p=(unit user) q=mark r=cage] :: outbound user req
[%init p=@p] :: report install
[%serv p=$@(desk beam)] :: set serving root
[%them p=(unit hiss)] :: outbound request
[%they p=@ud q=httr] :: inbound response
[%chis p=? q=clip r=httq] :: IPC inbound request
[%this p=? q=clip r=httq] :: inbound request
[%thud ~] :: inbound cancel
[%wegh ~] :: report memory
[%went p=sack q=path r=@ud s=coop] :: response confirm
[%west p=sack q=[path *]] :: network request
== ::
-- ::able
::
@ -632,10 +667,13 @@
bem/beam :: original path
but/path :: ending
== ::
++ gram :: inter-ship message
$? {{$get $~} p/@uvH q/{? clip httq}} :: remote request
{{$got $~} p/@uvH q/httr} :: remote response
{{$gib $~} p/@uvH} :: remote cancel
+= gram :: inter-ship message
$? [[%lon ~] p=hole] :: login request
[[%aut ~] p=hole] :: login reply
[[%hat ~] p=hole q=hart] :: login redirect
[[%get ~] p=@uvH q=[? clip httq]] :: remote request
[[%got ~] p=@uvH q=httr] :: remote response
[[%gib ~] p=@uvH] :: remote cancel
== ::
++ hart {p/? q/(unit @ud) r/host} :: http sec+port+host
++ hate {p/purl q/@p r/moth} :: semi-cooked request
@ -810,7 +848,7 @@
{$init p/ship} :: set owner
{$deal p/sock q/cush} :: full transmission
{$went p/sack q/path r/@ud s/coop} :: response confirm
{$west p/sack q/path r/@ud s/*} :: network request
{$west p/sack q/path r/*} :: network request
{$wegh $~} :: report memory
== ::
-- ::able
@ -840,11 +878,11 @@
{$pull $~} :: unsubscribe
{$punk p/mark q/cage} :: translated poke
{$pump $~} :: pump yes+no
{$peer-not p/tang} :: poison pill peer
== ::
++ cuft :: internal gift
$% {$coup p/(unit tang)} :: poke result
{$diff p/cage} :: subscription output
{$doff p/mark q/noun} :: untyped diff
{$quit $~} :: close subscription
{$reap p/(unit tang)} :: peer result
== ::
@ -948,21 +986,20 @@
%+ each balance :: complete
action :: change
::
++ task :: in request ->$
$% {$ktsg p/ship q/safe} :: destroy rights
{$hail p/ship q/remote} :: remote update
{$init p/@pG q/arms} :: initialize urbit
{$meet p/(unit (unit ship)) q/farm} :: integrate pki from
{$mint p/ship q/safe} :: create rights
{$move p/ship q/ship r/safe} :: transfer from/to
{$next p/bull} :: update private key
{$nuke $~} :: cancel tracker from
{$veil p/ship} :: view secret channel
{$vein $~} :: view signing keys
{$vest $~} :: view public balance
{$vine $~} :: view secret history
{$jaelwomb p/task:womb} :: XX not factored in
{$west p/ship q/path r/*} :: remote request
+= task :: in request ->$
$% [%ktsg p=ship q=safe] :: destroy rights
[%hail p=ship q=remote] :: remote update
[%init p=@pG q=arms] :: initialize urbit
[%meet p=(unit (unit ship)) q=farm] :: integrate pki from
[%mint p=ship q=safe] :: create rights
[%move p=ship q=ship r=safe] :: transfer from=to
[%next p=bull] :: update private key
[%nuke ~] :: cancel tracker from
[%veil p=ship] :: view secret channel
[%vein ~] :: view signing keys
[%vest ~] :: view public balance
[%vine ~] :: view secret history
[%west p=ship q=path r=*] :: remote request
== ::
++ gilt gilt:womb
--
@ -4179,14 +4216,14 @@
:: (dray ~[p=%tas q=%p r=%f] %ack ~sarnel &)
::
=- |* {a/{@tas (pole @tas)} b/*} ^- (paf a)
=> .(b `(tup -.a +.a)`b)
=> .(b `,(tup -.a +.a)`b)
?~ +.a [(scot -.a b) ~]
[(scot -.a -.b) `(paf +.a)`(..$ +.a +.b)]
:- paf=|*(a/(pole) ?~(a $~ {(odo:raid -.a(. %ta)) (..$ +.a)}))
[(scot -.a -.b) `,(paf +.a)`(..$ +.a +.b)]
:- paf=|*(a/(pole) ?~(a $~ {(odo:raid ,-.a(. %ta)) ,(..$ +.a)}))
^= tup
|* {a/@tas b/(pole @tas)}
=+ c=(odo:raid a)
?~(b c {c (..$ -.b +.b)})
?~(b c {c (..$ ,-.b ,+.b)})
:: :: ++raid:wired
++ raid :: demand path odors
::
@ -4295,11 +4332,11 @@
|= who/ship ^- ship
=+ mir=(clan who)
?- mir
$czar ~zod
$czar who
$king (end 3 1 who)
$duke (end 4 1 who)
$earl (end 5 1 who)
$pawn (end 4 1 who)
$pawn ~zod
==
:: :: ++team:title
++ team :: our / our moon

0
web/static.md → web/static.umd
View File

5
web/talk/main.js
View File

@ -778,7 +778,10 @@ module.exports = recl({
case speech.url == null:
return speechArr = speech.url.txt.split(/(\s|-)/);
case speech.fat == null:
return speech.fat.taf.exp.txt.split(/(\s|-)/);
if (typeof speech.fat.taf.exp !== 'undefined') { return speech.fat.taf.exp.txt.split(/(\s|-)/); }
if (typeof speech.fat.taf.app !== 'undefined') { return speech.fat.taf.app.txt; }
if (typeof speech.fat.taf.lin !== 'undefined') { return speech.fat.taf.lin.txt; }
return "unsupported fat speech";
default:
return [];
}

15
web/tree/main.css
View File

@ -1287,6 +1287,9 @@ ol > li:before {
content: "—";
margin-right: .6rem; }
#body.post img {
max-width: 100%; }
.urbit .post h1.title,
.urbit .post p.preview,
.urbit.post h1.title,
@ -1309,6 +1312,15 @@ ol > li:before {
.urbit.post img {
border: 12px solid #000; }
.urbit .post img.full-width,
.urbit.post img.full-width {
width: 100%;
border: 0; }
.urbit .post img.inline,
.urbit.post img.inline {
margin-bottom: 0; }
.urbit .post p.preview,
.urbit.post p.preview {
margin-bottom: .6rem;
@ -1361,6 +1373,9 @@ ol > li:before {
.sections h1:first-of-type {
padding-bottom: 1rem; }
.sections .list h1 {
padding-bottom: 0; }
.sections li h1 {
font-size: 1.2rem; }

41
web/tree/main.js
View File

@ -470,8 +470,8 @@ extras = {
"This page was made by Urbit. Feedback: ", a({
href: "mailto:urbit@urbit.org"
}, "urbit@urbit.org"), " ", a({
href: "https://twitter.com/urbit_"
}, "@urbit_")
href: "https://twitter.com/urbit"
}, "@urbit")
])
]);
})
@ -1927,6 +1927,9 @@ module.exports = query({
},
onSubmit: function(e) {
var comment, path, title;
this.setState({
loading: true
});
title = this.refs["in"].title.value;
comment = this.refs["in"].comment.value;
path = this.props.path || "/";
@ -1939,27 +1942,26 @@ module.exports = query({
});
},
render: function() {
var _attr, bodyTextArea, postButton, titleInput;
_attr = {};
if (this.state.loading === true) {
_attr.disabled = "true";
}
titleInput = input(_.create(_attr, {
var bodyTextArea, postButton, titleInput;
titleInput = input({
disabled: this.state.loading ? "true" : void 0,
type: "text",
name: "title",
placeholder: "Title"
}));
bodyTextArea = textarea(_.create(_attr, {
});
bodyTextArea = textarea({
disabled: this.state.loading ? "true" : void 0,
type: "text",
name: "comment",
value: this.state.value,
onChange: this.onChange
}));
postButton = input(_.create(_attr, {
});
postButton = input({
disabled: this.state.loading ? "true" : void 0,
type: "submit",
value: "Post",
className: "btn btn-primary"
}));
});
return div({}, div({
className: "add-post"
}, form({
@ -2051,7 +2053,7 @@ Virtual = name("Virtual", function(arg) {
}, function(str) {
return str;
}, function(arg1, key) {
var c, e, error, ga, gn, props, ref1;
var c, e, ga, gn, props, ref1;
gn = arg1.gn, ga = arg1.ga, c = arg1.c;
props = {
key: key
@ -2476,7 +2478,7 @@ module.exports = query({
if (this.props.match) {
comp = gn === this.props.match;
} else {
comp = gn && gn[0] === 'h' && parseInt(gn[1]) !== NaN;
comp = gn && gn[0] === 'h' && parseInt(gn[1]) !== (0/0);
}
if (comp) {
ga = _.clone(ga);
@ -3164,8 +3166,9 @@ module.exports = {
if (hor != null) {
d.setHours(hor);
d.setMinutes(min);
return d.setSeconds(sec);
d.setSeconds(sec);
}
return d;
},
getKeys: function(kids, sortBy) {
return _.map(this.sortKids(kids, sortBy), 'name');
@ -3345,8 +3348,12 @@ EventEmitter.prototype.emit = function(type) {
er = arguments[1];
if (er instanceof Error) {
throw er; // Unhandled 'error' event
} else {
// At least give some kind of context to the user
var err = new Error('Uncaught, unspecified "error" event. (' + er + ')');
err.context = er;
throw err;
}
throw TypeError('Uncaught, unspecified "error" event.');
}
}

3
web/unmark/1.txt Normal file
View File

@ -0,0 +1,3 @@
The quick *brown fox* jumped over #(add 2 2)
their owner's "extremely lazy" dogs.

3
web/unmark/10.txt Normal file
View File

@ -0,0 +1,3 @@
;style:'#test-style {transform: skew(25deg)}'
### Test style

12
web/unmark/11.txt Normal file
View File

@ -0,0 +1,12 @@
;+
;>
foo *some style*
outdent
;= ;div; ==
;=
moar markdown
==

11
web/unmark/2.txt Normal file
View File

@ -0,0 +1,11 @@
The quick brown fox jumped _over
the_ extremely lazy dogs.
Then a horse arrived. It was extremely angry.
Outside, two bears [were fighting](http://google.com) each other.
Also present at the scene were:
- an Armenian.
Everything was soon back to normal.

52
web/unmark/3.txt Normal file
View File

@ -0,0 +1,52 @@
#(add 2 2) is a hoon expression
un*bearably*
0b1100
---
## This is a header
The quick brown fox jumped over
the extremely lazy dogs.
Then a horse arrived. It was extremely angry.
Outside, two bears [were fighting](http://google.com) each other.
Also present at _the intense %hoon scene_ were:
- an Armenian.
- a haberdasher.
A haberdasher is someone who makes hats. There are quite
a few kinds of hats:
- fedoras
- borsalinos
- sombreros
- baseball caps
All these devices will protect your bald spot from the rain.
It is _sometimes difficult_ to be a bald man when it's raining.
We sometimes speak in %hoon We also say 0xdead.beef things like ~ and #`@`2.
We don't care if we sound funny, and sometimes we !@#$%%#^? cuss.
```
We also sometimes put
in
code
looks
like
this.
```

18
web/unmark/4.txt Normal file
View File

@ -0,0 +1,18 @@
## A digital home base
What you need is a digital home base. What is that computer? Is
it (a) your phone, (b) your browser, (c) your PC or laptop, (d)
your AWS instance, (e) your RasPi or other custom home computer?
Here are three obvious features your digital home base needs.
(1) it should be infinitely secure and persistent -- at the level
of Amazon S3, Gmail, your bank, etc. (2) it should be a server,
not just a client. (3) it should be usable by ordinary people.
Everything except (d) falls far short of (1) and/or (2). (d)
falls far short of (3).
The missing piece is a practical _personal server_ -- a virtual
computer in the cloud, with persistence guarantees comparable to
cloud storage services, that's as completely yours as a RasPi.

6
web/unmark/6.txt Normal file
View File

@ -0,0 +1,6 @@
*brown fox* ;{s "ignoreme"} ;{a(name "foo")} jumped over
;div#test: hello world
- - foo
- bar

37
web/unmark/8.txt Normal file
View File

@ -0,0 +1,37 @@
> xyz
abc
```
code at the beginning of the line
```
zyxxy
> bar
poe
m
> baz
> bal
- - bleh
- blah
+ one
+ two
1
> > bel
> what did you just say about me
...
```
code
still code?
```
> > foo
not-code

1
web/unmark/9.txt Normal file
View File

@ -0,0 +1 @@
> - + ;div.test: nesting

Some files were not shown because too many files have changed in this diff Show More