diff --git a/app/hood.hoon b/app/hood.hoon index 533079074..cc6c7ada5 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -59,7 +59,7 @@ :: ++ ably :: save part |* {(list) hood-part} - [(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))] + [(flop +<-) %_(+> lac (~(put by lac) +<+< `hood-part`+<+))] :: :: :: :::: :: :: :: :: :: @@ -163,15 +163,10 @@ ++ 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 diff --git a/arvo/ames.hoon b/arvo/ames.hoon index 5d11e6d05..8e926dd4f 100644 --- a/arvo/ames.hoon +++ b/arvo/ames.hoon @@ -2041,6 +2041,7 @@ :_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~])) ~& [%beer p.bon] :* [hen [%slip %c %init p.bon]] + [hen [%slip %j %init p.bon]] [hen [%give %init p.bon]] [hen [%slip %a %kick now]] [hen [%slip %e %init p.bon]] diff --git a/arvo/eyre.hoon b/arvo/eyre.hoon index 7a387dc38..dc336f678 100644 --- a/arvo/eyre.hoon +++ b/arvo/eyre.hoon @@ -28,6 +28,7 @@ $% {$thud $~} :: proxied death {$this p/? q/clip r/httq} :: proxied request {$meta vase} :: type check + {$mini-jael-task *} :: XX types == == :: $: $f :: to %ford $% {$exec p/@p q/(unit {beak silk:^ford})} :: @@ -49,6 +50,7 @@ == == :: $: $e :: by self $% {$thou p/httr} :: response for proxy + {$mini-jael-gift *} :: XX types == == :: $: $f :: by %ford $% {$made p/@uvH q/gage:^ford} :: @@ -57,21 +59,45 @@ $: @tas :: by any $% {$crud p/@tas q/(list tank)} :: == == == :: +++ mini-jael-task + $% {$save-cookie ses/hole own/?} + {$kill-cookie ses/hole} + {$save-token ses/hole tok/ixor} + {$live-token ses/hole tok/ixor} + == +++ mini-jael-gift + $% {$cookie-ack him/@p} + {$token-ack $~} + {$token-beat $~} + {$token-dead $~} + == +++ mini-jael-scry + $% {$pass him/ship pas/@t} :: ? + {$cook ses/hole} :: (unit ship) + {$ixor ses/hole tok/ixor} :: ? + == ++ ixor @t :: oryx hash +++ mend ?($get $head) :: amend after building ++ whir $@ $~ :: wire subset - $% {$ac p/hole q/whir} :: cookied - {$at p/hole q/whir} :: authenticated + $% {$ac p/whir-ac} :: finish request + {$at p/cord:beak q/whir-ac} :: build request {$ay p/knot:ship q/knot:@uvH $~} :: remote duct - {$ha p/path:beak} :: GET request - {$he p/whir} :: HEAD request {$hi p/knot q/mark $~} :: outbound HTTP {$se p/whir-se q/{user (list @t)}} :: outbound to domain {$si $~} :: response done + {$le $~} :: stateless lens req {$of p/ixor q/$@($~ whir-of)} :: associated view {$ow p/ixor $~} :: dying view {$on $~} :: dependency - == :: -++ whir-of {p/knot:ship q/term r/?($mess $lens) s/wire} :: path in dock + {$je p/whir-je} + == +++ whir-je + $% {$ses p/hole $~} + {$ire p/hole q/ixor $~} + {$liv p/hole q/ixor $~} + == +++ whir-ac {p/?($$ hole) q/mend r/$@($~ {p/@t $~})} :: auth? filter cookie? +++ whir-of {p/knot:ship q/term s/wire} :: path in dock ++ whir-se ?($core vi-arm) :: build/call ++ vi-arm $? $filter-request :: ++out mod request @@ -86,8 +112,7 @@ -- :: |% :: models ++ bolo :: eyre state - $: $6 :: version - gub/@t :: random identity + $: $7 :: version hov/(unit ship) :: master for remote top/beam :: ford serve prefix ged/duct :: client interface @@ -97,28 +122,20 @@ ask/{p/@ud q/(map @ud {p/duct q/hiss})} :: outgoing by number kes/(map duct @ud) :: outgoing by duct ney/@uvI :: rolling entropy - dop/(map host ship) :: host aliasing liz/(jug @uvH (each duct ixor)) :: ford depsets - wup/(map hole cyst) :: secure sessions - sop/(map hole {ship ?}) :: foreign sess names wix/(map ixor stem) :: open views sec/(map {user (list @t)} driv) :: security drivers + jel/mini-jael-state == :: :: -++ sec-move :: driver effect - $% {$send p/hiss} :: http out - {$show p/purl} :: direct user to url - {$give p/httr} :: respond immediately - {$redo $~} :: restart request qeu - == :: -:: -++ bale :: driver state - |* a/_* :: %jael keys type - $: {our/ship now/@da eny/@uvJ byk/beak} :: base info - {usr/user dom/(list @t)} :: req user, domain - key/a :: secrets from %jael - == :: -:: +++ je-per-ship + $: cok/(map hole die/@da) + tok/(map oryx {hen/duct ses/hole die/@da liv/(unit @da)}) + == +++ mini-jael-state + $: primary/(map ship je-per-ship) + secondary/(map hole ship) + == ++ driv :: driver state %+ pair (unit $@($~ vase)) :: main core {liv/? req/(qeu (trel duct mark vase:hiss))} :: waiting requests @@ -129,20 +146,10 @@ {$xeno p/ship} :: proxied request {$poll p/ixor} :: session state == -++ cyst :: client session - $: ced/cred :: credential - {him/ship aut/(set ship)} :: authenticated - cug/(list @t) :: unacked cookies - lax/@da :: last used - way/(map ship {purl duct}) :: waiting auth - vew/(set oryx) :: open views XX expire - == :: :: ++ stem :: client view - $: him/ship :: static identity - ude/(unit {p/duct q/?}) :: stream long-poll? - era/@da :: next wake - die/@da :: collection date + $: him/ship :: user + pol/(unit duct) :: long-poll sus/(set {dock $json wire path}) :: subscriptions eve/{p/@u q/(map @u even)} :: queued events med/(qeu duct) :: waiting /~/to/ @@ -160,7 +167,7 @@ {$bugs p/?($as $to) $~} {$beam p/beam} {$deps p/?($put $delt) q/@uvH} - {$mess p/dock q/mark r/wire s/json} + {$mess p/{dock mark wire s/json}} {$poll p/{i/@uvH t/(list @uvH)}} {$spur p/spur} {$subs p/?($put $delt) q/{dock $json wire path}} @@ -174,14 +181,13 @@ {$js $~} {$json $~} {$try him/ship paz/(unit cord)} - {$xen ses/hole rem/pork} == :: ++ pest :: result $@ $~ $% {$$ p/httr} :: direct response {$red $~} :: parent redirect - {$bake p/whir q/mark r/coin s/beam} :: ford request + {$bake p/mend q/mark r/coin s/beam} :: ford request {$js p/@t} :: script {$json p/json} :: data {$html p/manx} :: successful page @@ -204,7 +210,7 @@ ?~ quy [%$ %n ~]~ [[%$ %t p.i.quy] [%$ %t q.i.quy] $(quy t.quy)] :: -++ gsig |=({a/dock b/?($mess $lens) c/path} [(scot %p p.a) q.a b c]) +++ gsig |=({a/dock b/path} [(scot %p p.a) q.a b]) ++ session-from-cookies |= {nam/@t maf/math} ^- (unit hole) @@ -416,7 +422,7 @@ setTimeout(urb.call,1000*urb.tries) urb.tries++ } - urb.onupdate = function(){document.location.reload()} + urb.onupdate = function(){console.log('document.location.reload()')} urb.call() urb.wasp = function(deh){ if (!deh) return; @@ -459,18 +465,9 @@ document.location = url } urb.redir = function(ship){ - if(ship){ - var location = new URL(document.location) - location.pathname = location.pathname.replace(/^\/~~|\/~\/as\/any/,'/~/as/~'+ship) - urb.redirTo(location) - } - else urb.redirTo( - document.location.hash.match(/#[^?]+/)[0].slice(1) + - document.location.pathname.replace( - /^\/~\/am\/[^/]+/, - '/~/as/~' + urb.ship) + - document.location.search - ) + var location = new URL(document.location) + location.pathname = location.pathname.replace(/^\/~~|\/~\/as\/any/,'/~/as/~'+ship) + urb.redirTo(location) } if(urb.foreign && urb.auth.indexOf(urb.ship) !== -1){ req("/~/auth.json?PUT", @@ -487,8 +484,7 @@ "/~/auth.json?PUT", {ship:ship, code:pass}, function(){ - if(urb.foreign) urb.redir() - else document.location.reload() + document.location.reload() }) } urb.away = function(){req("/~/auth.json?DELETE", {}, @@ -631,12 +627,152 @@ ++ adit .(ney (mix eny ney)) :: flip entropy :: ++ anon `@p`(add our ^~((bex 64))) :: pseudo-sub + :: + :: + ++ je + |= him/ship + =+ (fall (~(get by primary.jel) him) *je-per-ship) + |% + ++ abet +>.$(primary.jel (~(put by primary.jel) him +<.abet)) + ++ wake + |= wir/whir-je ^+ ..je + =< abet + ?- -.wir + $ses (kill-cookie p.wir) + $ire (kill-token q.wir) + $liv (beat-token q.wir) + == + :: + ++ apex + |= kyz/mini-jael-task ^+ ..je + =< abet + ?- -.kyz + $save-cookie (save-cookie ses.kyz) + $kill-cookie (kill-cookie ses.kyz) + $save-token (save-token ses.kyz tok.kyz) + $live-token (live-token ses.kyz tok.kyz) + == + :: + ++ save-cookie + |= ses/hole + ?< (~(has by secondary.jel) ses) + =. secondary.jel (~(put by secondary.jel) ses him) + =/ die (add now ~d7) + =. +>.$ (reset-timer je+ses+/[ses] ~ `die) + %_ +>.$ + cok (~(put by cok) ses die) + ..je (jael-give [%cookie-ack him]) + == + :: + ++ live-cookie + |= ses/hole + =/ ole (~(got by cok) ses) + =/ die (add now ~d7) + =. +>.$ (reset-timer je+ses+/[ses] `die.ole `die) + %_ +>.$ + cok (~(put by cok) ses die) + secondary.jel (~(put by secondary.jel) ses him) + == + :: + ++ kill-cookie + |= ses/hole :: XX actively kill tokens? + =/ ole (~(got by cok) ses) + =. +>.$ (reset-timer je+ses+/[ses] `die.ole ~) + %_ +>.$ + cok (~(del by cok) ses) + secondary.jel (~(del by secondary.jel) ses) + == + :: + ++ save-token + |= {ses/hole ire/ixor} + =/ die (add now ~d7) + =. +>.$ (reset-timer je+ire+/[ses]/[ire] ~ `die) + %_ +>.$ + tok (~(put by tok) ire [hen ses die ~]) + ..je (jael-give [%token-ack ~]) + == + :: + ++ live-token + |= {ses/hole ire/ixor} + =/ ole (~(got by tok) ire) + ?. (~(has by cok) ses) ~&(expired-session+ses +>.$) :: XX + ?> =(ses ses.ole) :: XX caught beforehand? + =. +>.$ (live-cookie ses) + =+ [liv=`(add ~s30 now) die=(add ~d1 now)] + =. +>.$ (reset-timer je+liv+/[ses]/[ire] liv.ole liv) + =. +>.$ (reset-timer je+ire+/[ses]/[ire] `die.ole `die) + %_ +>.$ + tok (~(put by tok) ire [hen ses die liv]) + == + :: + ++ kill-token + |= ire/ixor + =/ ole (~(got by tok) ire) + =. +>.$ (reset-timer je+liv+/[ses.ole]/[ire] liv.ole ~) + =. +>.$ (reset-timer je+ire+/[ses.ole]/[ire] `die.ole ~) + %_ +>.$ + tok (~(del by tok) ire) + ..je (jael-give(hen hen.ole) [%token-dead ~]) + == + :: + ++ beat-token + |= ire/ixor + =/ ole (~(got by tok) ire) + %_ +>.$ + tok (~(put by tok) ire ole(liv ~)) + ..je (jael-give(hen hen.ole) [%token-beat ~]) + == + :: + :: + ++ jael-give + |=(mini-jael-gift %_(..je mow :_(mow [hen %give %mini-jael-gift +<]))) + :: + ++ reset-timer + |= {wir/whir ole/(unit time) new/(unit time)} + =. mow ?~(ole mow :_(mow [`/ %pass wir [%b %rest u.ole]])) + =. mow ?~(new mow :_(mow [`/ %pass wir [%b %wait u.new]])) + +>.$ + -- + :: + ++ scry-jael + |= a/mini-jael-scry + ^- $%({$bean ?} {$u-ship (unit ship)}) + ?- -.a + $pass + :- %bean + ?> =(our him.a) :: only own password known + =(|2.a load-secret) + :: + $cook + :- %u-ship + (~(get by secondary.jel) ses.a) + :: + $ixor + :- %bean + =/ loc (~(got by primary.jel) (~(got by secondary.jel) ses.a)) + =(ses.a ses:(~(got by tok.loc) tok.a)) + == + :: + :: ++ apex :: accept request |= kyz/task:able ^+ +> =. our ?~(hov our u.hov) :: XX =. p.top our :: XX necessary? ?- -.kyz + $mini-jael-task + =/ kyz-je ;;(mini-jael-task +.kyz) + =; him (apex:(je him) kyz-je) + ?- -.kyz-je + $save-cookie + ?: own.kyz-je our + `@p`(mix anon (lsh 5 1 (rsh 5 1 (shaf %ship ses.kyz-je)))) + :: + $kill-cookie (~(got by secondary.jel) ses.kyz-je) + $save-token (~(got by secondary.jel) ses.kyz-je) + $live-token (~(got by secondary.jel) ses.kyz-je) + == + :: $born +>.$(ged hen) :: register external $serv =< ~&([%serving (tope top)] .) @@ -664,7 +800,7 @@ == =. p.p.pul |(p.p.pul ?=(hoke r.p.pul)) ?: ?=($chis -.kyz) :: IPC escape hatch - ~(lens handle pul [q.+.kyz |] [p.heq maf s.heq]) + ~(as-lens handle pul [q.+.kyz |] [p.heq maf s.heq]) =+ her=(host-to-ship r.p.pul) ?: |(?=($~ her) =(our u.her)) ~(apex handle pul [q.+.kyz |] [p.heq maf s.heq]) @@ -744,9 +880,7 @@ ?~ mez ~& e+[%strange-west p.kyz] ~|(%strange-west !!) - ?- -<.u.mez - $aut abet:(logon:(ses-ya p.u.mez) q.p.kyz) - $hat (foreign-hat:(ses-ya p.u.mez) q.p.kyz q.u.mez) + ?- -<.u.mez $gib (pass-note ay+(dray p+uv+~ q.p.kyz p.u.mez) [%e %thud ~]) $get (pass-note ay+(dray p+uv+~ q.p.kyz p.u.mez) [%e %this q.u.mez]) $got @@ -757,13 +891,6 @@ pox (~(del by pox) p.u.mez) == (give-thou q.u.mez) - :: - $lon - ~& ses-ask+[p.u.mez sop (~(run by wup) $~)] - ?: (ses-authed p.u.mez) - (ames-gram q.p.kyz aut+~ p.u.mez) - =. sop (~(put by sop) p.u.mez q.p.kyz |) - (ames-gram q.p.kyz hat+~ p.u.mez our-host) == :: $wegh !! :: handled elsewhere @@ -783,6 +910,14 @@ ?: &(?=({?($of $ow) ^} tee) !(~(has by wix) p.tee)) ~&(dead-ire+[`whir`tee ({term term $~} +.sih)] +>) ?- &2.sih + $mini-jael-gift + =/ gif ;;(mini-jael-gift |2.sih) + ?: ?=($cookie-ack -.gif) + :: XX probably should wait for this instead of pulling ship out via scry + +>.$ + ?> ?=({$of @ $~} tee) + (get-jael:(ire-ix p.tee) gif) + :: $crud +>.$(mow [[hen %slip %d %flog +.sih] mow]) :: $dumb :: =. +> ?+(tee +> [%of ^] pop-duct:(ire-ix p.tee)) @@ -803,29 +938,32 @@ == :: $unto :: app response - ?> ?=({$of @ ^} tee) + ?> ?=($%({$le $~} {$of @ ^}) tee) =+ cuf=`cuft:^gall`+>.sih ?- -.cuf ?($coup $reap) - :: ~? ?=($lens r.q.tee) hen=hen^hcuf=-.cuf - (get-ack:(ire-ix p.tee) q.tee ?~(p.cuf ~ `[-.cuf u.p.cuf])) + =/ ack ?~(p.cuf ~ `[-.cuf u.p.cuf]) + ?: ?=($le -.tee) (~(get-ack lens ~) ack) + (get-ack:(ire-ix p.tee) q.tee ack) :: $doff !! $diff ?. ?=($json p.p.cuf) :: ~> %slog.`%*(. >[%backing p.p.cuf %q-p-cuf]< &3.+> (sell q.p.cuf)) (back tee %json p.cuf) - (get-rush:(ire-ix p.tee) q.tee ((hard json) q.q.p.cuf)) + =/ jon ((hard json) q.q.p.cuf) + ?: ?=($le -.tee) (~(get-diff lens ~) jon) + (get-rush:(ire-ix p.tee) q.tee jon) :: - $quit ~&(quit+tee (get-quit:(ire-ix p.tee) q.tee)) + $quit + ~& quit+tee + ?: ?=($le -.tee) ~(get-quit lens ~) + (get-quit:(ire-ix p.tee) q.tee) == :: $wake - ?> ?=({?($of $ow) @ $~} tee) - ?: ?=($ow -.tee) - abut:(ire-ix p.tee) - => wake:(ire-ix p.tee) - (give-json 200 ~ (joba %beat %b &)) + ?> ?=($je -.tee) + %.(p.tee wake:(je (~(got by secondary.jel) p.p.tee))) :: $news :: dependency updated ?: ?=({$se *} tee) @@ -844,10 +982,8 @@ $made ?< ?=($tabl -.q.sih) =. our (need hov) :: XX - =| ses/(unit hole) - |- ^+ ..axon ?- tee - $@($~ {?($on $ay $ow) *}) ~|(e+ford+lost+tee !!) + $@($~ {?($on $ay $ow $je) *}) ~|(e+ford+lost+tee !!) {$of @ $~} ~|(e+ford+lost+tee !!) {$si $~} (give-sigh q.sih) {$se ^} (get-made:(dom-vi q.tee) p.tee [p q]:sih) @@ -872,57 +1008,68 @@ :: ?> ?=($hiss p.cay) :: (eyre-them p.tee q.cay) :: - {$he *} :: XX hack - =. ..axon $(tee p.tee) - %_ ..axon - mow %+ turn mow - |= a/move - ?+ q.a a - {$give $thou *} a(r.p.p.q ~) - {$pass ^} ?.(=(p.tee p.q.a) a a(p.q tee)) - == == + {$le $~} + ?: ?=($| -.q.sih) + ((slog p.q.sih) +>.$) :: XX get-ack (some)? + %- ~(get-diff lens ~) + ?> ?=($json p.p.q.sih) :: XX others + ((hard json) q.q.p.q.sih) :: {$of @ ^} ?: ?=($| -.q.sih) - ((slog p.q.sih) +>.^$) :: XX get-even %mean + ((slog p.q.sih) +>.$) :: XX get-even %mean %+ get-rush:(ire-ix p.tee) q.tee ?> ?=($json p.p.q.sih) :: XX others ((hard json) q.q.p.q.sih) :: {$at ^} - ?: ?=($| -.q.sih) $(tee q.tee) - ?. ?=($js -.p.q.sih) - ~& e+at-lost+[-.p.q.sih q.tee] - $(tee q.tee) - ?> ?=(@ q.q.p.q.sih) - =. ses (some p.tee) - =+ cyz=(~(got by wup) p.tee) - =^ jon ..ya ~(stat-json ya p.tee cyz) - $(tee q.tee, q.q.p.q.sih (add-json jon q.q.p.q.sih)) - :: - {$ac ^} ?>((~(has by wup) p.tee) $(ses `p.tee, tee q.tee)) - {$ha *} %- emule |. ^+ ..apex ?. ?=($& -.q.sih) (fail 404 p.sih p.q.sih) - =* cay p.q.sih + =^ cay ..ya :: inject stat-json + =* cay p.q.sih + ?~ p.q.tee [cay ..ya] + (add-auth p.q.tee cay) :: XX block on session save? ?: ?=($red-quri p.cay) =+ url=(apex:earn ((hard quri) q.q.cay)) (give-thou 307 [location+(crip url)]~ ~) :: (give-html:abet 200 ~ (redir:xml url)) ?. ?=($mime p.cay) - =+ bek=(norm-beak -:(need (tome p.tee))) - =+ tee-ses=?~(ses tee [%ac u.ses tee]) - (exec-live tee-ses bek [%flag [p.sih `~] %cast %mime [%$ p.q.sih]]) - ~| q.q.cay - =+ cug=?~(ses ~ cug:(~(got by wup) u.ses)) - =+ ((hard {mit/mite rez/octs}) q.q.cay) - =+ dep=(crip "W/{(pojo %s (scot %uv p.sih))}") - =+ hit=[200 ~[etag+dep content-type+(moon mit)] ~ rez] - (give-thou (add-cookies cug hit)) + =+ bek=(norm-beak -:(need (tome (need (puck p.tee))))) + (exec-live ac+q.tee bek [%flag [p.sih `~] %cast %mime [%$ cay]]) + (give-mime q.tee p.sih cay) + :: + {$ac ^} + %- emule |. ^+ ..apex + ?. ?=($& -.q.sih) + (fail 404 p.sih p.q.sih) + =* cay p.q.sih + ?> ?=($mime p.cay) + (give-mime p.tee p.sih cay) == == :: + ++ give-mime + |= {{ses/?($~ hole) men/mend dom/?($~ {p/@t $~})} dep/@uvH cay/cage} + ^+ +>.$ + ?> ?=($mime -.cay) + ~| q.q.cay + =+ cug=?~(dom ~ ?~(ses !! [(set-cookie p.dom cookie-prefix ses)]~)) + =+ ((hard {mit/mite rez/octs}) q.q.cay) + =+ dep=(crip "W/{(pojo %s (scot %uv dep))}") + =+ bod=?-(men $get `rez, $head ~) + =+ hit=[200 ~[etag+dep content-type+(moon mit)] bod] + (give-thou (add-cookies cug hit)) + :: + ++ add-auth + |= {ses/hole cay/cage} ^- {cage _..ya} + ?. ?=($js -.cay) + ~& e+at-lost+-.cay + [cay ..ya] + ?> ?=(@ q.q.cay) + =^ jon ..ya ~(stat-json ya ses) + [cay(q.q (add-json jon q.q.cay)) ..ya] + :: ++ norm-beak |=(bek/beak ?+(r.bek bek {$ud $0} bek(r da+now))) ++ emule |= a/_|?(..emule) ^+ ..emule @@ -937,15 +1084,6 @@ |= {usr/knot dom/path} ^+ vi :: XX default to initialized user? ~(. vi [usr dom] (fall (~(get by sec) usr dom) *driv)) :: - ++ ses-authed - |= ses/hole - =+ sap=(~(get by sop) ses) - ?: ?=({$~ @ $&} sap) & - =+ cyz=(~(get by wup) ses) - ?~ cyz | - (~(has in aut.u.cyz) our) - :: - ++ ses-ya |=(ses/hole ~(. ya ses (~(got by wup) ses))) ++ our-host `hart`[& ~ %& /org/urbit/(rsh 3 1 (scot %p our))] :: [| [~ 8.443] `/localhost] :: XX testing :: @@ -956,6 +1094,9 @@ ++ ames-gram |=({him/ship gam/gram} (pass-note ~ %a %wont [our him] [%e -.gam] +.gam)) :: + ++ jael-note + |=({tea/whir kyz/mini-jael-task} (pass-note tea %e %mini-jael-task kyz)) + :: ++ back :: %ford bounce |= {tea/whir mar/mark cay/cage} (execute tea (norm-beak -.top) [%cast mar $+cay]) @@ -1031,7 +1172,7 @@ ++ mean-json |=({sas/@uG err/ares} (give-json sas ~ (ares-to-json err))) ++ nice-json |=(* (give-json 200 ~ (joba %ok %b &))) :: - ++ pass-note |=(noe/{whir note} +>(mow :_(mow [hen %pass noe]))) + ++ pass-note |=(noe/{whir note} %_(+> mow :_(mow [hen %pass noe]))) ++ host-to-ship :: host to ship |= hot/host ^- (unit ship) @@ -1048,6 +1189,16 @@ %^ rsh 3 1 (scot %p (@ (need (sky [151 %noun] %a pax)))) :: + ++ cookie-prefix (rsh 3 1 (scot %p our)) + ++ set-cookie + |= {domain/@t key/@t val/@t} + %+ rap 3 :~ + key '=' val + :: '; HttpOnly' ?.(sec '' '; Secure') :: XX security + domain + '; Path=/; HttpOnly' + == + :: :: ++ handle ~% %eyre-h ..is ~ @@ -1069,8 +1220,19 @@ :: ++ fcgi-cred ^- cred - ?: aut fcgi-cred:for-client - %*(fcgi-cred for-client him anon) + =/ him + ?. aut anon + (need get-user:for-client) + %* . *cred + hut hat + orx 'not-yet-implemented' + acl + =+ lag=(~(get by maf) %accept-language) + ?~(lag ~ ?~(u.lag ~ [~ i.u.lag])) + :: + :: cip cip :: XX performance + aut (~(put ju ^+(aut:*cred ~)) %$ (scot %p him)) + == :: ++ apex =< abet @@ -1081,12 +1243,10 @@ ?: ?=($| -.pez) p.pez (resolve ~ p.pez) :: - ++ lens + ++ as-lens =< abet :: (process-parsed [%mess [our %dojo] %lens-command /lens (need grab-json)]) - =^ orx ..ya new-view:(logon:for-client our) - =+ vew=(ire-ix (oryx-to-ixor orx)) - ((teba new-lens.vew) (need grab-json)) + ((teba ~(new lens ~)) (need grab-json)) :: ++ resolve |= {cug/(list @t) pez/pest} ^+ done @@ -1097,10 +1257,7 @@ $json (give-json 200 cug p.pez) $html (give-html 200 cug p.pez) $htme (give-html 401 cug p.pez) - $bake - =+ req=[%bake mar=q.pez [r s]:pez] - =+ red=req(mar %red-quri) - (exec-live p.pez -.s.pez `silk:^ford`[%alts ~[req red]]) + $bake (resolve-bake ~ ~ +.pez) :: $red =+ url=(earn hat pok(p [~ %html]) quy) @@ -1112,6 +1269,14 @@ == == :: + ++ resolve-bake + |= {ses/(unit hole) dom/(unit @t) men/mend mar/mark arg/coin bem/beam} + =+ wir=[%at (pack [- +]:(tope -.bem ~)) (fall ses %$) men ?~(dom ~ [u.dom]~)] + =. -.bem (norm-beak -.bem) + =+ req=[%bake mar arg bem] + =+ red=[%bake %red-quri arg bem] + (exec-live wir -.bem `silk:^ford`[%alts ~[req red]]) + :: :: ++ is-anon =([~ ''] (~(get by (molt quy)) 'anon')) ++ check-oryx :: | if json with bad oryx @@ -1119,9 +1284,16 @@ ?. &(?=({$~ $json} p.pok) ?=($post mef) ?=(^ bod) !is-anon) & =+ oxe=grab-oryx ?~ oxe | - ?: (~(has in vew.cyz:for-client) u.oxe) - & - ~&(bad-oryx+[u.oxe vew.cyz:for-client] &) :: XX security + =/ ses (session-from-cookies cookie-prefix maf) + ?~ ses ~&(%oryx-no-cookie &) :: XX security + ?~ ~(get-user ya u.ses) ~&(%oryx-bad-cookie |) + =/ ire (oryx-to-ixor u.oxe) + ?~ (~(get by wix) ire) ~&(bad-oryx+u.oxe &) :: XX security? + =+ (scry-jael %ixor u.ses ire) + ?> ?=($bean -<) + ?. -> + ~&(oryx-ses-mismatch+[orx=u.oxe u.ses] &) :: XX security + & :: ++ grab-json ?. ?=(?($post $put $delt) mef) @@ -1143,7 +1315,7 @@ =+ hem=as-aux-request ?^ hem ?. check-oryx - ~|(%bad-oryx ~|([grab-oryx vew.cyz:for-client] !!)) + ~|(%bad-oryx ~|([grab-oryx ses:for-client] !!)) [%& u.hem] =+ bem=as-beam ?^ bem [%& %beam u.bem] @@ -1214,7 +1386,6 @@ p:(need (puck src)) :: allow state=usr_other-data :: $at [%auth %at pok(q but)] - $am ?~(but !! [%auth %xen i.but pok(q t.but)]) $as :+ %auth %get ~| bad-ship+?~(but ~ i.but) @@ -1319,16 +1490,14 @@ =+ bem=?-(-.hem $beam p.hem, $spur [-.top (weld p.hem s.top)]) ~| bad-beam+q.bem ?< =([~ 0] (sky [151 %noun] %cw (tope bem(+ ~, r [%da now])))) - =+ wir=`whir`[%ha (tope -.bem ~)] - =. wir ?+(mef !! $get wir, $head [%he wir]) - =. r.bem ?+(r.bem r.bem {$ud $0} da+now) + =+ men=?+(mef !! $get mef, $head mef) :: redact result =+ arg=(fcgi payload fcgi-cred) - =+ [%bake wir ext arg bem] + =+ [%bake men ext arg bem] ?.(aut [%& `pest`-] [%| `_done`(resolve ~ -)]) :: $bugs ?- p.hem - $as (show-login-page) + $as show-login-page $to [%& %html poke-test:xml] == :: @@ -1343,9 +1512,11 @@ :: $mess :- %| - =^ orx ..ya ?:(is-anon new-view:for-client [(need grab-oryx) ..ya]) + ?. is-anon + ((teba new-mess:for-view) p.hem(s [%json !>(`json`s.p.hem)])) + =^ orx ..ya new-view:for-client =+ vew=(ire-ix (oryx-to-ixor orx)) - ((teba new-mess.vew) p.hem r.hem q.hem %json !>(`json`s.hem)) + ((teba new-mess.vew) p.hem(s [%json !>(`json`s.p.hem)])) :: $oath ?. (~(has by sec) [p q]:hem) @@ -1370,7 +1541,7 @@ :: $view ~| lost-ixor+p.hem - [%| ((teba poll:(ire-ix p.hem)) u.q.hem)] + [%| ((teba poll:(ire-ix p.hem)) u.q.hem ses:for-client)] == :: ++ process-auth @@ -1378,9 +1549,9 @@ =+ yac=for-client ?- -.ham $js [%& %js auth:js] - $json =^ jon ..ya stat-json.yac - [%| (give-json 200 cug.yac jon)] - $xen (show-login-page ~ ses.ham) + $json =/ cug (set-cookie -):yac + =^ jon ya stat-json.yac :: XX block on session save? + [%| (give-json 200 cug jon)] :: $at =. ..ya abet.yac @@ -1391,58 +1562,80 @@ $red pez $bake =. ya abet.yac - [%| (resolve ~ p.pez(p [%at ses.yac p.p.pez]))] + [%| (resolve-bake `ses.yac dom.yac +.p.pez)] :: $js - =^ jon ..ya stat-json.yac - [%| (resolve cug.yac p.pez(p (add-json jon p.p.pez)))] + =/ cug (set-cookie -):yac + =^ jon ya stat-json.yac :: XX block on session save? + [%| (resolve cug p.pez(p (add-json jon p.p.pez)))] == :: $del - =. ..ya (logoff:yac p.ham) - =+ cug=~[(set-cookie cookie-prefix '~') (set-cookie %ship '~')] + =. ..ya abut:yac + =/ cug + :~ (set-cookie cookie-domain cookie-prefix '~') + (set-cookie cookie-domain %ship '~') + == [%| (give-json 200 cug (joba %ok %b &))] :: $get |- ~| aute+ham - ?: |(=(anon him.ham) (~(has in aut.yac) him.ham)) - =. ..ya abet.yac(him him.ham) + ?: |(=(anon him.ham) =(get-user.yac `him.ham)) =+ pez=process(pok rem.ham, aut &) ?: ?=($| -.pez) pez [%| (resolve ~ p.pez)] ?. =(our him.ham) - [%| ((teba foreign-auth.yac) him.ham hat rem.ham quy)] - (show-login-page ~) + ~|(sso-disabled+[our him.ham] !!) + show-login-page :: $try :- %| ?. =(our him.ham) ~|(stub-foreign+him.ham !!) - ?. ?| (~(has in aut.yac) him.ham) - ?~(paz.ham | =(u.paz.ham load-secret)) + ?. ?| =(get-user.yac `him.ham) + ?~(paz.ham | (check-password him.ham u.paz.ham)) == ~|(%auth-fail !!) - =^ jon ..ya stat-json:(logon:yac him.ham) - =. cug.yac :_(cug.yac (set-cookie %ship (scot %p him.ham))) - (give-json 200 cug.yac jon) + =. yac (for-authed-client him.ham) + =/ cug (set-cookie -):yac + =^ jon ya stat-json.yac + (give-json 200 cug jon) :: XX wait for session save? == :: + ++ check-password + |= pas/{ship @t} ^- ? + =+ (scry-jael %pass pas) + ?> ?=($bean -<) + -> + :: ++ show-login-page - |= ses/(unit hole) ^- (each pest _done) + ^- (each pest _done) ?. ?=($@($~ {$~ $html}) p.pok) [%& %red ~] - ?~ ses - [%& %htme login-page:xml] - ?: (~(has by wup) u.ses) - [%& %htme login-page:xml] - =+ yac=(new-ya u.ses) - =+ =- lon=?~(- | (~(has in aut.u.-) our)) - (biff (session-from-cookies cookie-prefix maf) ~(get by wup)) - =. yac ?.(lon yac (logon.yac our)) - [%| (give-html(..ya abet.yac) 401 cug.yac login-page:xml)] + [%& %htme login-page:xml] :: - ++ cookie-prefix (rsh 3 1 (scot %p our)) + ++ need-ixor (oryx-to-ixor (need grab-oryx)) + ++ for-view ^+(ix (fix-user:(ire-ix need-ixor) ses:for-client)) + :: + ++ random-session (rsh 3 1 (scot %p (end 6 1 ney))) + ++ for-authed-client + |= him/ship ^+ [dom=*(unit @t) ya] + ?> =(him our) :: XX SSO + (new-ya &) + :: + ++ for-client :: stateful per-session engine + ^+ [dom=*(unit @t) ya] + =+ pef=cookie-prefix + =+ lig=(session-from-cookies pef maf) + ?~ lig + (new-ya |) + ?~ ~(get-user ya u.lig) + ~& bad-cookie+u.lig + (new-ya |) + [~ ~(. ya u.lig)] + :: + ++ cookie-domain ^- cord ?- r.hat @@ -1450,120 +1643,31 @@ {$& $org $urbit *} '; Domain=.urbit.org' {$& @ @ *} =- (rap 3 "; Domain={-}{i.p.r.hat ~}") (turn (flop `path`t.p.r.hat) |=(a/knot (cat 3 a '.'))) - {$& *} '' :: XX security? == :: - ++ set-cookie - |= {key/@t val/@t} - %+ rap 3 :~ - key '=' val - :: '; HttpOnly' ?.(sec '' '; Secure') :: XX security - cookie-domain - '; Path=/; HttpOnly' - == - ++ need-ixor (oryx-to-ixor (need grab-oryx)) - ++ for-view ^+(ix (ire-ix need-ixor)) - :: - ++ for-client :: stateful per-session engine - ^+ ya - =+ pef=cookie-prefix - =+ lig=(session-from-cookies pef maf) - ?~ lig - (new-ya (rsh 3 1 (scot %p (end 6 1 ney)))) - =+ cyz=(~(get by wup) u.lig) - ?~ cyz - ~& bad-cookie+u.lig - (new-ya (rsh 3 1 (scot %p (end 6 1 ney)))) - ~(. ya u.lig u.cyz(cug ~)) - :: - ++ new-ya |=(ses/hole ~(. ya ses (new-cyst ses))) - ++ new-cyst - |= ses/hole - =* sec p.hat - ^- cyst - :* ^- cred - :* hat(p sec) - ~ - 'not-yet-implemented' - ::(rsh 3 1 (scot %p (end 6 1 (shaf %oryx ses)))) - :: - =+ lag=(~(get by maf) %accept-language) - ?~(lag ~ ?~(u.lag ~ [~ i.u.lag])) - :: - cip - ~ - == - [`@p`(mix anon (lsh 5 1 (rsh 5 1 (shaf %ship ses)))) ~] - :: - [(set-cookie cookie-prefix ses)]~ - :: - now - ~ - ~ - :: [1 ~] - == + ++ new-ya |=(own/? [`cookie-domain %.(own ~(new ya random-session))]) -- :: ++ oryx-to-ixor |=(a/oryx (rsh 3 1 (scot %p (end 6 1 (shas %ire a))))) ++ ya :: session engine ~% %eyre-y ..is ~ - =| {ses/hole cyst} - =* cyz -> - |% - ++ abet ..ya(wup (~(put by wup) ses cyz)) - ++ abut ..ya(wup (~(del by wup) ses)) - ++ foreign-auth - |= {him/ship pul/purl} ^+ ..ya - =. way (~(put by way) him pul hen) - ~& asking-foreign+him - (ames-gram:abet him [lon+~ ses]) + |_ ses/hole + ++ abet ..ya + ++ abut (jael-note / %kill-cookie ses) + ++ new |=(own/? +>(..ya (jael-note / %save-cookie ses own))) :: - ++ foreign-hat - |= {him/ship hat/hart} ^+ ..ya - ~| way - ?. (~(has by way) him) :: XX crashes should be handled by ames - ~&(strange-auth+[way him hat] ..ya) - =^ pul hen (~(got by way) him) - =: way (~(del by way) him) - dop (~(put by dop) r.hat him) - q.q.pul ['~' %am ses q.q.pul] - == - =+ url=(welp (earn pul(p hat)) '#' (head:earn p.pul)) - (give-html:abet 200 cug (redir:xml url)) - :: - ++ logon - |= her/ship - %_ +> - him her - aut (~(put in aut) her) - ..ya - :: ~& logon+[our her ses] - ?. =(our her) - ..ya - =+ sap=(~(get by sop) ses) - :: ~& sap+sap - ?. ?=({$~ @ $|} sap) - ..ya - (ames-gram -.u.sap aut+~ ses) - == - ++ logoff - |= her/(unit ship) ^+ ..ya - ?~ her abut - =. aut (~(del in aut) u.her) - ?~ aut abut - abet(him ?.(=(u.her him) him n.aut)) + ++ set-cookie + |= domain/(unit @t) ^- (list @t) + ?~ domain ~ + [(^set-cookie u.domain cookie-prefix ses)]~ :: ++ new-view ^+ [*oryx ..ya] =+ orx=`@t`(rsh 3 1 (scot %p (shaf %orx eny))) - =. vew (~(put in vew) orx) =+ ire=(oryx-to-ixor orx) - =. ..ix ~(init ix ire %*(. *stem him him, p.eve 1)) - :: ~& stat-ire+`@t`ire - [orx abet] + [orx %.(ses ~(init ix ire %*(. *stem him anon, p.eve 1)))] :: XX fix him on ack? :: - ++ fcgi-cred %_(ced aut (~(put ju aut.ced) %$ (scot %p him))) ++ stat-json ^+ [*json ..ya] =^ orx ..ya new-view @@ -1573,9 +1677,14 @@ ixor+s+(oryx-to-ixor orx) sein+(jape +:<(sein:title:jael our)>) ship+(jape +:) - user+(jape +:) - auth+a+(turn (~(tap in aut)) |=(a/@p (jape +:))) + user+(jape +:<(fall get-user anon)>) :: XX crash on unsaved session? == + :: + ++ get-user + ^- (unit ship) + =+ (scry-jael %cook ses) + ?> ?=($u-ship -<) + -> -- :: ++ ix @@ -1589,14 +1698,13 @@ =+ sub=(~(tap in sus)) |- ^+ ..ix ?^ sub $(sub t.sub, ..ix (pul-subs i.sub)) - =. +> poll-rest ..ix(wix (~(del by wix) ire)) :: ++ teba |*(a/$-(* ..ix) |*(b/* %_(done ..ix (a b)))) ++ give-json (teba ^give-json) ++ pass-note (teba ^pass-note) ++ hurl-note - |= {a/{dock ?($mess $lens) path} b/note} ^+ ..ix + |= {a/{dock path} b/note} ^+ ..ix =: med (~(put to med) hen) hen `~ == @@ -1604,63 +1712,40 @@ (pass-note:abet [%of ire (gsig a)] b) :: ++ init - =. die (add ~d1 now) - abet(mow :_(mow [`/ %pass ow+/[ire] [%b %wait die]])) + |= ses/hole ^+ ..ix + (jael-note:abet of+/[ire] %save-token ses ire) :: - ++ refresh - =. mow :_(mow [`/ %pass ow+/[ire] [%b %rest die]]) - =. die (add ~d1 now) - done(mow :_(mow [`/ %pass ow+/[ire] [%b %wait die]])) + ++ fix-user + |= ses/hole ^+ +> + ?. =(anon him) +> + +>(him (need ~(get-user ya ses))) :: XX set correct value on session create :: ++ add-even |= a/even ^+ eve [+(p.eve) (~(put by q.eve) p.eve a)] :: - ++ new-lens - |= jon/json ^+ ..ix - =. +>.$ - %+ pass-note - [%of ire (gsig [our %dojo] lens+/)] - [%g %deal [him our] %dojo %peel %lens-json /sole] - =. +>.$ - %+ pass-note - [%of ire (gsig [our %dojo] lens+/)] - [%g %deal [him our] %dojo %punk %lens-command %json !>(`json`jon)] - abet - :: ++ new-mess - |= {a/dock b/wire c/mark d/cage} ^+ ..ix - (hurl-note [a mess+b] [%g %deal [him -.a] +.a %punk c d]) + |= {a/dock b/mark c/wire d/cage} ^+ ..ix + (hurl-note [a c] [%g %deal [him -.a] +.a %punk b d]) :: ++ add-subs |= {a/dock $json b/wire c/path} ^+ ..ix ?: (~(has in sus) +<) ~|(duplicate+c !!) =. sus (~(put in sus) +<) - (hurl-note [a mess+b] [%g %deal [him -.a] +.a %peel %json c]) + (hurl-note [a b] [%g %deal [him -.a] +.a %peel %json c]) :: ++ pul-subs |= {a/dock $json b/wire c/path} ^+ ..ix =. sus (~(del in sus) +<) - (hurl-note [a mess+b] [%g %deal [him -.a] +.a %pull ~]) + (hurl-note [a b] [%g %deal [him -.a] +.a %pull ~]) :: ++ del-subs :: XX per path? |= {a/dock $json b/wire c/path} ^+ ..ix =. ..ix (pul-subs +<) (nice-json:pop-duct:(ire-ix ire)) :: XX gall ack :: - ++ get-lens - |= {a/whir-of fec/json} ^+ ..ix - ?~ fec ..ix :: nulled event we don't care about - =. +>.$ - %+ pass-note - `whir`[%of ire (gsig [our %dojo] lens+/)] - `note`[%g %deal [him our] %dojo %pull ~] - abet:(give-json 200 ~ fec) - :: ++ get-rush |= {a/whir-of b/json} ^+ ..ix - ?: ?=($lens r.a) - (get-lens a b) (get-even [%rush [[(slav %p p.a) q.a] s.a] (joba %json b)]) :: ++ get-quit @@ -1669,35 +1754,24 @@ :: ++ get-ack |= {a/whir-of b/(unit {term tang})} ^+ ..ix - ?: ?=($lens r.a) - (ack-lens b) ?: =(~ med) ~& resp-lost+ire ..ix ?~ b (nice-json:pop-duct) (mean-json:pop-duct 500 b) :: - ++ ack-lens - |= a/(unit (pair term tang)) ^+ ..ix - ?~ a - ..ix :: (give-json 200 ~ (joba %okey-dokey %b &)) - =+ tag=(flop `tang`[>[%eyre-lens-fail p.u.a]< q.u.a]) - %- (slog tag) - abet:(give-json 500 ~ (jape (wush 160 tag))) - :: ++ get-even |= ven/even ^+ ..ix =+ num=p.eve =. eve (add-even ven) =< abet - ?~ ude done - =. hen p.u.ude - (give-even:pass-rest(ude ~) q.u.ude num ven) + ?~ pol done + =. hen u.pol + (give-even(pol ~) num ven) :: ++ give-even - |= {pol/? num/@u ven/even} ^+ done + |= {num/@u ven/even} ^+ done =: q.eve (~(del by q.eve) (dec num)) :: TODO ponder a-2 mow ?.(?=($rush -.ven) mow mow:(pass-took [- %mess +]:p.ven)) == - ?> pol :: XX eventstream %^ give-json 200 ~ %^ jobe id+(jone num) type+[%s -.ven] ?- -.ven @@ -1706,41 +1780,30 @@ $rush ~[from+(subs-to-json p.ven) data+q.ven] == :: - ++ pass-wait (pass-note of+/[ire] [%b %wait era]) - ++ pass-rest - =. lyv (~(del by lyv) hen) - (pass-note of+/[ire] [%b %rest era]) - :: ++ pass-took - |= a/{p/dock ?($mess $lens) wire} + |= a/{p/dock wire} %+ pass-note(hen `~) [%of ire (gsig a)] [%g %deal [him -.p.a] +.p.a %pump ~] :: ++ pop-duct =^(ned med ~(get to med) abet(hen ned)) ++ poll - |= a/@u ^+ ..ix + |= {seq/@u ses/hole} ^+ ..ix =< abet - =. ..poll refresh - ?: =(a p.eve) - =. ..poll poll-rest - =. era (add ~s30 now) + =. ..ix (jael-note of+/[ire] %live-token ses ire) + ?: =(seq p.eve) =. lyv (~(put by lyv) hen [%poll ire]) - pass-wait(ude [~ hen &]) - ?: (gth a p.eve) ~|(seq-high+cur=p.eve !!) - =+ ven=~|(seq-low+cur=p.eve (~(got by q.eve) a)) - (give-even & a ven) - :: - ++ poll-rest - ?~ ude done - %*(. pass-rest(hen p.u.ude) hen hen) + done(pol `hen) + ?: (gth seq p.eve) ~|(seq-high+cur=p.eve !!) + =+ ven=~|(seq-low+cur=p.eve (~(got by q.eve) seq)) + (give-even seq ven) :: ++ poll-dead ^+ ..ix =< abet - ?. =(ude [~ hen &]) + ?. =(pol `hen) done :: old long poll - pass-rest(ude ~) + done(pol ~) :: ++ subs-to-json |= {a/dock b/path} @@ -1749,9 +1812,52 @@ appl+[%s q.a] path+(jape (spud b)) == - ++ wake ^+(..ix abet(ude ~)) :: XX other effects? - :: XX unused - ++ print-subs |=({a/dock b/path} "{}/{(trip q.a)}{(spud b)}") + :: + ++ get-jael + =* jael-gift-token :: XX types + => (mini-jael-gift /token-ack) + ?>(?=(?($token-ack $token-dead $token-beat) -) _.) + |= a/jael-gift-token ^+ ..ix + ?- -.a + $token-ack abet + $token-dead abut :: notify? + $token-beat + ?~ pol abet :: recieved other response + ~? !=(hen u.pol) [%oryx-beat-weird-duct hen] + (give-json:abet(pol ~, hen u.pol) 200 ~ (joba %beat %b &)) + == + -- + ++ lens :: urb.py engine + =/ him our :: XX other uses? + |_ $~ :: XX stateful? + ++ abet ..lens + ++ new + |= jon/json ^+ ..lens + =. ..lens + %+ pass-note [%le ~] + [%g %deal [him our] %dojo %peel %lens-json /sole] + =. ..lens + %+ pass-note [%le ~] + [%g %deal [him our] %dojo %punk %lens-command %json !>(`json`jon)] + abet + :: + ++ get-ack + |= a/(unit (pair term tang)) ^+ ..lens + ?~ a + ..lens :: (give-json 200 ~ (joba %okey-dokey %b &)) + =+ tag=(flop `tang`[>[%eyre-lens-fail p.u.a]< q.u.a]) + %- (slog tag) + (give-json:abet 500 ~ (jape (wush 160 tag))) + :: + ++ get-diff + |= fec/json ^+ ..lens + ?~ fec ..lens :: nulled event we don't care about + =. ..lens + %+ pass-note [%le ~] + `note`[%g %deal [him our] %dojo %pull ~] + (give-json:abet 200 ~ fec) + :: + ++ get-quit (give-json:abet 500 ~ (joba %quit b+&)) -- ++ vi :: auth engine ~% %eyre-v ..is ~ @@ -1982,9 +2088,8 @@ :^ hen %give %mass :- %eyre :- %| - :~ dependencies+[%& liz] sessions+[%& wup] views+[%& wix] + :~ dependencies+[%& liz] views+[%& wix] ducts+[%| ~[dead+[%& ded] proxy+[%& pox] outgoing+[%& ask]]] - hosts+[%& dop] misc+[%& bol] == =+ our=`@p`0x100 :: XX sentinel @@ -1992,7 +2097,6 @@ =+ sky=|=({* *} `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) =. ney (shax :(mix (shax now) +(eny) ney)) :: XX!! shd not need ^+ [p=*(list move) q=..^$] - =. gub ?.(=(`@`0 gub) gub (cat 3 (rsh 3 1 (scot %p (end 6 1 eny))) '-')) =^ mos bol abet:(apex:~(adit ye [hen [now eny our sky] ~] bol) q.hic) [mos ..^$] @@ -2003,12 +2107,16 @@ ~ :: ++ load :: take previous state + =+ bolo-6={$6 _%*(+ *bolo lyv *(map duct ^), wix [*(map) *(map)])} =+ driv-5=_=>(*driv [cor=p req=req.q]) - =+ bolo-5={$5 _=+(*bolo +.-(sec (~(run by sec.-) driv-5)))} + =+ bolo-5={$5 _=+(*bolo-6 +.-(sec (~(run by sec.-) driv-5)))} =+ bolo-4={$4 _%*(+ *bolo-5 lyv *(map duct ^))} - |= old/?(bolo bolo-5 bolo-4) + =/ bolo _%*(. *bolo lyv **) + ::|= * %. (bolo +<) + |= old/?(bolo bolo-6 bolo-5 bolo-4) ?- -.old - $6 ..^$(+>- old) + $7 ..^$(+>- old(lyv ~)) + $6 $(old [%7 +.old(lyv ~, wix ~)]) $5 $(old [%6 +.old(sec (~(run by sec.old) |=(driv-5 [cor & req])))]) $4 $(old [%5 +.old(lyv ~)]) :: minor leak == @@ -2048,7 +2156,6 @@ =+ sky=|=({* *} `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) =. ney (shax :(mix (shax now) +(eny) ney)) :: XX!! shd not need ^+ [p=*(list move) q=..^$] - =. gub ?.(=(`@`0 gub) gub (cat 3 (rsh 3 1 (scot %p (end 6 1 eny))) '-')) =+ tee=((soft whir) tea) ?~ tee ~& [%e %lost -.q.hin hen] [~ ..^$] =^ mos bol diff --git a/arvo/gall.hoon b/arvo/gall.hoon index c0403aa59..1d03b049a 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -1197,6 +1197,7 @@ $wont `%a :: XX for begin; remove $warp `%c $wipe `%f :: XX cache clear + $jaelwomb `%j :: XX name/unpack == -- -- diff --git a/arvo/jael.hoon b/arvo/jael.hoon index 8bec7aa5d..32453a990 100644 --- a/arvo/jael.hoon +++ b/arvo/jael.hoon @@ -21,6 +21,7 @@ =, able:^jael =, title:jael =, crypto:ames +=* womb womb:^jael =, jael :: :::: :::: # models :: data structures @@ -444,7 +445,7 @@ [n.b ~ ~] :: :: ++put:py ++ put :: insert - |= b/ship ^- pile + |= b/@ ^- pile (uni [b b] ~ ~) :: :: ++sub:py ++ sub :: subtract @@ -467,10 +468,10 @@ $(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~]) :: ++ tap - =| out/(list (pair ship ship)) + =| out/(list @u) |- ^+ out ?~ a out - $(a l.a, out [n.a $(a r.a)]) + $(a l.a, out (welp (gulf n.a) $(a r.a))) :: :: ++uni:py ++ uni :: merge two piles |= b/pile @@ -518,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) (table %final p.lef p.ryt)) + $final ?>(?=($final -.ryt) (cable %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)) @@ -528,6 +529,11 @@ $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)} @@ -623,7 +629,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 (table p.lef p.ryt)]) + $final ?>(?=($final -.ryt) [%final (cable 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)]) @@ -633,6 +639,11 @@ $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)} @@ -699,7 +710,7 @@ |= ryt/rite ^- safe ?~ pig - ~ + !! :: not found ?. =(-.ryt -.n.pig) ?: (gor -.ryt -.n.pig) [n.pig $(pig l.pig) r.pig] @@ -782,7 +793,7 @@ [%apple (~(run by p.rys) |=(@ (mug +<)))] :: $final - [%final (~(run by p.rys) |=(@ (mug +<)))] + [%final (mug p.rys)] :: $login [%login ~] @@ -831,16 +842,16 @@ |_ pub/will :: :: ++collate:we ++ collate :: sort by version - |= com/$-({{life cert} {life cert}} ?) + |= ord/$-({{life cert} {life cert}} ?) ^- (list (pair life cert)) - (sort (~(tap by pub)) com) + (sort (~(tap by pub)) ord) :: :: ++current:we ++ current :: current number ^- (unit life) (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)) @@ -848,7 +859,7 @@ ?~(- ~ `i) :: :: ++reverse:we ++ reverse :: sort latest first - (collate |=({a/{life *} b/{life *}} (gth -.a -.b))) + (collate |=({{a/life *} {b/life *}} (gth a b))) -- -- :: :::: @@ -900,6 +911,33 @@ ++ burb :: per ship |= who/ship ~(able ~(ex ur urb) who) + :: + ++ read-womb + =, wired:eyre :: 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 @@ -927,7 +965,9 @@ :: {$init p/code q/arms} :: $init - (cure abet:(~(make ur urb) now.sys eny.sys p.tac q.tac)) + =. our p.tac + (cure abet:abet:(make:(burb our) now.sys eny.sys (shaf %genr eny.sys) *arms)) +:: (cure abet:abet:(make:(burb our) now.sys eny.sys p.tac q.tac)) :: :: create promises :: {$mint p/ship q/safe} @@ -969,6 +1009,13 @@ $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} :: @@ -1463,6 +1510,8 @@ :: 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) @@ -1505,73 +1554,6 @@ |= 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 @@ -1656,6 +1638,72 @@ |= 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} @@ -1678,6 +1726,140 @@ =. +>.$ (deal rex [[ryt ~ ~] ~]) =. ..ex (meet [~ ~] hec) +>.$ + :: + ++ as-hotel :: XX moveme + |= a/ship ^- (map {ship bloq} pile) + =/ b (xeb (xeb a)) + =- (my - ~) + :- [(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 shy] + ?- -.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 (sy who.inv ~)]) + %+ mov-rite [rex pas] + [%fungi (my [%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 [%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 (sy who.inv ~)]) + :: XX history + =/ ole/@p (shaf %pass aut.taz) + %+ mov-rite [ole pas] + [%fungi (my [%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 [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 @@ -1916,7 +2098,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) + =^ did lex abet:(~(call of [now eny] lex) hen q.hic) [did ..^$] :: :: ++doze ++ doze :: await @@ -1953,7 +2135,12 @@ 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 diff --git a/arvo/zuse.hoon b/arvo/zuse.hoon index dc420c4bf..3c13d6108 100644 --- a/arvo/zuse.hoon +++ b/arvo/zuse.hoon @@ -576,6 +576,7 @@ {$thus p/@ud q/(unit hiss)} :: http request+cancel {$veer p/@ta q/path r/@t} :: drop-through {$vega p/path} :: drop-through + {$mini-jael-gift *} == :: ++ task :: in request ->$ $% {$born $~} :: new unix process @@ -591,11 +592,19 @@ {$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 *} == :: -- ::able :: :::: :: (1e2) :: + ++ bale :: driver state + |* a/_* :: %jael keys type + $: {our/ship now/@da eny/@uvJ byk/beak} :: base info + {usr/user dom/(list @t)} :: req user, domain + key/a :: secrets from %jael + == :: + :: ++ clip (each @if @is) :: client IP ++ cred :: credential $: hut/hart :: client host @@ -612,10 +621,7 @@ but/path :: ending == :: ++ 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 + $? {{$get $~} p/@uvH q/{? clip httq}} :: remote request {{$got $~} p/@uvH q/httr} :: remote response {{$gib $~} p/@uvH} :: remote cancel == :: @@ -673,6 +679,12 @@ {$| p/pork q/quay} :: relative == :: ++ rout {p/(list host) q/path r/oryx s/path} :: http route (new) + ++ sec-move :: driver effect + $% {$send p/hiss} :: http out + {$show p/purl} :: direct user to url + {$give p/httr} :: respond immediately + {$redo $~} :: restart request qeu + == :: -- ::eyre :: ++ ford ^? @@ -921,22 +933,57 @@ %+ each balance :: complete action :: change :: - ++ task :: in request ->$ - $% {$burn 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 - == :: - -- :: moves + ++ task :: in request ->$ + $% {$burn p/ship q/safe} :: destroy rights + {$hail p/ship q/remote} :: remote update + {$init p/@p} +:: {$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} + {$west p/ship q/path r/*} :: remote request + == :: + ++ gilt gilt:womb + -- + :: + ++ womb ^? + :: types used to serve the lib/womb invite controller + |% + ++ ticket @G :: old 64-bit ticket + ++ passcode @uvH :: 128-bit passcode + ++ passhash @uwH :: passocde hash + ++ mail @t :: email address + ++ invite :: + $: who/mail :: owner email + pla/@ud :: planets to send + sta/@ud :: stars to send + == :: + :: :: + ++ 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} :: alloc to passcode + {$reinvite aut/passcode tid/passcode inv/invite}:: move to another + == + ++ scry + $% {$shop typ/?($star $planet) nth/@u} :: available ships + {$stats who/ship} :: ship details + {$balance aut/passcode} :: invite details + == + ++ balance {who/mail pla/@ud sta/@ud} :: equivalent to invite? + ++ gilt + $% {$ships (list ship)} :: + {$womb-owner (unit mail)} :: + {$womb-balance (unit balance)} :: + == + -- :: :: :::: ++pki:^jael :: (1h2) certificates :: :::: @@ -1029,8 +1076,8 @@ ++ rite :: urbit commitment $% {$apple p/(map site @)} :: web api key {$block $~} :: banned - {$email p/(set @ta)} :: email addresses - {$final p/(map ship @pG)} :: ticketed ships + {$email p/(set @t)} :: email addresses + {$final p/@pG} :: recognize by ticket {$fungi p/(map term @ud)} :: fungibles {$guest $~} :: refugee visa {$hotel p/(map dorm pile)} :: reserved block @@ -4526,6 +4573,7 @@ {$e task:able:^eyre} {$f task:able:^ford} {$g task:able:^gall} + {$j $init ship} :: XX actual jael tasks == == ++ sign-arvo :: in result $<- $% {$a gift:able:^ames} diff --git a/gen/hood/invite.hoon b/gen/hood/invite.hoon index cc239a0c6..0815e65d9 100644 --- a/gen/hood/invite.hoon +++ b/gen/hood/invite.hoon @@ -9,9 +9,9 @@ /+ womb :- %say |= $: {now/@da eny/@uvJ bec/beak} - {{who/@t $~} ref/(unit (each ship mail:womb)) sta/@} + {{who/@t $~} sta/@} == :- %womb-invite -^- {cord reference invite}:womb +^- {cord invite}:womb =+ inv=(scot %uv (end 7 1 eny)) -[inv ref [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]] +[inv [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]] diff --git a/gen/solid.hoon b/gen/solid.hoon index 1f8b702da..7e95831e4 100644 --- a/gen/solid.hoon +++ b/gen/solid.hoon @@ -29,6 +29,7 @@ [%b %behn] [%d %dill] [%e %eyre] + [%j %jael] == |- ^+ all ?~ vay all diff --git a/lib/basic-auth.hoon b/lib/basic-auth.hoon index 8885ac9d1..acc5635e1 100644 --- a/lib/basic-auth.hoon +++ b/lib/basic-auth.hoon @@ -2,6 +2,7 @@ :: :::: /hoon/basic-auth/lib :: +=, ^eyre |% ++ keys @t -- diff --git a/lib/kiln.hoon b/lib/kiln.hoon index 3034f656b..a69c2c18a 100644 --- a/lib/kiln.hoon +++ b/lib/kiln.hoon @@ -190,7 +190,7 @@ =. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon) =. cur-vanes %- malt - %+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall] + %+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael] |= syd/@tas :- syd .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon) @@ -242,7 +242,7 @@ |= {way/wire rot/riot} ?> ?=($~ way) ?> ?=(^ rot) - =+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall] + =+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael] =. +>.$ ?. autoload +>.$ diff --git a/lib/oauth1.hoon b/lib/oauth1.hoon index f0c51cc20..51b1c6a2c 100644 --- a/lib/oauth1.hoon +++ b/lib/oauth1.hoon @@ -3,6 +3,7 @@ :::: /hoon/oauth1/lib :: /+ interpolate, hep-to-cab +=, ^eyre |% ++ keys cord:{key/@t sec/@t} :: app key pair ++ token :: user keys diff --git a/lib/oauth2.hoon b/lib/oauth2.hoon index 348462459..6d04fecb7 100644 --- a/lib/oauth2.hoon +++ b/lib/oauth2.hoon @@ -3,6 +3,7 @@ :::: /hoon/oauth2/lib :: /+ hep-to-cab, interpolate +=, ^eyre |% ++ parse-url parse-url:interpolate ++ join diff --git a/lib/womb.hoon b/lib/womb.hoon index c788ccfa9..42d7d7f1b 100644 --- a/lib/womb.hoon +++ b/lib/womb.hoon @@ -5,49 +5,50 @@ /+ talk, old-phon =, wired:eyre =, title:jael +=, 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 +:: |* 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 +:: == :: +:: -- :: :: :: :::: :: :: :: |% :: -++ 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 @@ -58,15 +59,11 @@ owner/mail :: owner's email history/(list mail) :: transfer history == :: -++ 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 - == :: +:: ++ 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 @@ -77,10 +74,6 @@ $: 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 @@ -102,9 +95,8 @@ ++ part {$womb $1 pith} :: womb state ++ pith :: womb content $: boss/(unit ship) :: outside master - bureau/(map passhash balance) :: active invitations - office/property :: properties managed - hotel/(map (each ship mail) client) :: everyone we know +:: bureau/(map passhash balance) :: active invitations +:: office/property :: properties managed recycling/(map ship @) :: old ticket keys == :: -- :: @@ -112,6 +104,14 @@ :::: :: :: :: :: :: |% :: 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) @@ -120,7 +120,8 @@ {$poke wire dock pear} :: app RPC {$next wire p/ring} :: update private key {$tick wire p/@pG q/@p} :: save ticket - {$knew wire p/ship q/wyll:^ames} :: learn wyll (old pki) + {$knew wire p/ship q/wyll:^ames} :: learn will (old pki) + {$jaelwomb wire task:womb} :: manage rights == :: ++ pear :: $% {$email mail tape wall} :: send email @@ -133,19 +134,17 @@ {$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 ref/reference inv/invite} + {$invite tid/cord inv/invite} {$reinvite aut/passcode inv/invite} == -- @@ -170,86 +169,8 @@ =+ 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) - == - == - -- -- :: :: :: :::: :: :: @@ -272,32 +193,6 @@ ^+ +> ?~(+< +> $(+< 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) @@ -306,113 +201,25 @@ %+ ames-grab %rue .^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a)) :: -++ neighboured :: filter for connectivity - |* a/(list {ship *}) ^+ a - %+ skim a - |= {b/ship *} - ?=(^ (ames-last-seen b)) +++ jael-scry + |* {typ/mold pax/path} ^- typ + .^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax)) :: -++ shop-galaxies (available galaxies.office) :: unassigned %czar +++ 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] :: -:: 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 (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)) + =; 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) :: ++ get-live :: last-heard time ++live |= a/ship ^- live @@ -420,88 +227,39 @@ ?~ 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 - ?- (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)) - == + :- (get-live who) + =/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner) + ?~ man [%free ~] + ?: stat-no-email [%owned ''] + [%owned u.man] :: ++ peek-x-stats :: inspect ship/system |= tyl/path ?^ tyl ?> |(=(our src) =([~ src] boss)) :: privileged info - ``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) + :: 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) :: ++ 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})) - =+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~)) + :: XX redundant parse? + =+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv])) %- some - %+ bind (~(get by bureau) (shaf %pass pas)) - |=(bal/balance [%womb-balance bal]) + %+ bind (jael-pas-balance pas) + |=(a/balance [%womb-balance a]) :: -:: ++ 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)] @@ -524,7 +282,7 @@ =+ pas=`passcode`(end 7 1 (sham %tick him tik)) :- pas ?. gud %fail - ?: (~(has by bureau) (shaf %pass pas)) %used + ?^ (jael-pas-balance pas) %used %good :: ++ peer-scry-x :: subscription like .^ @@ -548,7 +306,6 @@ :: /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 @@ -561,29 +318,6 @@ ?> |(=(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 @@ -610,10 +344,8 @@ $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)) == == :: @@ -623,47 +355,25 @@ =. log-transaction (log-transaction %bonus +<) ?> |(=(our src) =([~ src] boss)) :: priveledged =/ pas ~|(bad-invite+tid `passcode`(slav %uv tid)) - %_ . - 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)) - == + (emit %jaelwomb / %bonus pas pla sta) :: ++ poke-invite :: create invitation - |= {tid/cord ref/reference inv/invite} + |= {tid/cord 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)) - ?: (~(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]) + =. emit (emit %jaelwomb / %invite pas [who pla sta]:inv) (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 - =+ ~|(%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) + =/ 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) :: ++ poke-obey :: set/reset boss |= who/(unit @p) @@ -696,47 +406,6 @@ ?> =(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 {}: {<`@pG`tik>}") - :: - $split :: or ship distribution - %.(+>.$ (slog leaf+"Ticket for {}: {<`@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 !!) @@ -746,10 +415,14 @@ =+ [him tik]=(parse-ticket him-t tik-t) ?> (need (check-old-ticket him tik)) =+ pas=`passcode`(end 7 1 (sham %tick him tik)) - ?: (~(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)) +:: ?^ (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' :: ++ poke-claim :: claim plot, req ticket |= {aut/passcode her/@p} @@ -757,100 +430,9 @@ =< abet =. log-transaction (log-transaction %claim +<) ?> =(src src) - (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 {} 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)) + =/ 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 {}: {<`@pG`tik>}") -- diff --git a/mar/womb/do-claim.hoon b/mar/womb/do-claim.hoon deleted file mode 100644 index 72a012cee..000000000 --- a/mar/womb/do-claim.hoon +++ /dev/null @@ -1,11 +0,0 @@ -:: -:::: /hoon/do-claim/womb/mar - :: -/? 310 -|_ {her/ship tik/@p} -:: -++ grab :: convert from - |% - ++ noun {ship @p} :: clam from %noun - -- --- diff --git a/mar/womb/do-ticket.hoon b/mar/womb/do-ticket.hoon deleted file mode 100644 index ff5d71ee5..000000000 --- a/mar/womb/do-ticket.hoon +++ /dev/null @@ -1,11 +0,0 @@ -:: -:::: /hoon/do-ticket/womb/mar - :: -/? 310 -|_ her/ship -:: -++ grab :: convert from - |% - ++ noun @p :: clam from %noun - -- --- diff --git a/mar/womb/invite.hoon b/mar/womb/invite.hoon index 6d14ddd6e..b546e3271 100644 --- a/mar/womb/invite.hoon +++ b/mar/womb/invite.hoon @@ -6,11 +6,11 @@ :: :::: ~fyr :: -|_ {cord reference invite}:womb +|_ {cord invite}:womb :: ++ grab :: convert from |% - ++ noun {cord reference invite}:womb :: clam from %noun + ++ noun {cord invite}:womb :: clam from %noun ++ json %+ corl need => jo @@ -21,7 +21,6 @@ == %- 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 ~) ~) == --