urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-28 13:54:20 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'next/kelvin/412' into yu/enable-close-flows

Browse Source
This commit is contained in:
yosoyubik 2023-06-28 15:51:37 +02:00
commit 20cb84d037
26 changed files with 2041 additions and 473 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:8c0fb3cb223a884bb10dc2877c2dcbc597d7ba54392c8cdc73ac152626888cc9
size 6379473
oid sha256:a5a31c4f3566eb7243b3a596ef9103eb8ef896e62c9cddd4f515429837734805
size 7275204

2
pkg/arvo/app/aqua.hoon
View File

@ -615,7 +615,7 @@
::
?: fake.ae ~
=+ [%raw-poke %noun %refresh-rate ~s30]
[/g/aqua/reduce-refresh-rate %deal [. .]:who.ae %azimuth -]~
[/g/aqua/reduce-refresh-rate %deal [. . /]:who.ae %azimuth -]~
==
==
=. this

62
pkg/arvo/app/dbug.hoon
View File

@ -361,17 +361,58 @@
::
[%eyre %authentication ~]
%- some
:- %a
%+ turn
%+ sort ~(tap by sessions:auth-state:v-eyre)
|= [[@uv a=session:eyre] [@uv b=session:eyre]]
(gth expiry-time.a expiry-time.b)
|= [cookie=@uv session:eyre]
=/ auth auth-state:v-eyre
%- pairs
:~ 'cookie'^s+(scot %uv cookie)
'identity'^(render-identity:v-eyre identity)
'expiry'^(time expiry-time)
'channels'^(numb ~(wyt in channels))
:~ :- 'sessions'
:- %a
%+ turn
%+ sort ~(tap by sessions.auth)
|= [[@uv a=session:eyre] [@uv b=session:eyre]]
(gth expiry-time.a expiry-time.b)
|= [cookie=@uv session:eyre]
%- pairs
:~ 'cookie'^s+(scot %uv cookie)
'identity'^(render-identity:v-eyre identity)
'expiry'^(time expiry-time)
'channels'^(numb ~(wyt in channels))
==
::
:- 'visitors'
:- %a
%+ turn
%+ sort ~(tap by visitors.auth)
|= [[@uv a=visitor:eyre] [@uv b=visitor:eyre]]
?@ +.a &
?@ +.b |
(aor (scot %p ship.a) (scot %p ship.b))
|= [nonce=@uv v=visitor:eyre]
%- pairs
:+ 'nonce'^s+(scot %uv nonce)
'duct'^?~(duct.v ~ a+(turn u.duct.v path))
?@ +.v ['sesh' s+(scot %uv sesh.v)]~
:~ 'pend'^b+?=(^ pend.v)
'ship'^(ship ship.v)
'last'^s+last.v
'toke'^?~(toke.v ~ s+(scot %uv u.toke.v))
==
::
:- 'visiting'
:- %a
%- zing
%+ turn
%+ sort ~(tap by visiting.auth)
|= [[a=@p *] [b=@p *]]
(aor (scot %p a) (scot %p b))
|= [who=@p q=(qeu @uv) m=(map @uv portkey)]
%+ turn ~(tap by m)
|= [nonce=@uv p=portkey]
%- pairs
:+ 'who'^(ship who)
'nonce'^s+(scot %uv nonce)
?@ p ['made' (time made.p)]~
:~ ['pend' b+?=(^ pend.p)]
['toke' ?~(toke.p ~ s+(scot %uv u.toke.p))]
==
==
::
:: /eyre/channels.json
@ -1001,6 +1042,7 @@
?- -.identity
%ours our.bowl
%fake who.identity
%real who.identity
==
::
++ render-action

2
pkg/arvo/app/debug/js/index.js
View File

File diff suppressed because one or more lines are too long

85
pkg/arvo/app/dojo.hoon
View File

@ -1172,6 +1172,16 @@
::
%kick +>.$
==
::
++ he-self
|= [way=wire =sign:agent:gall]
^+ +>
?. ?=(%poke-ack -.sign)
~& [%strange-self sign]
+>
?~ p.sign
+>
(he-diff %tan leaf+"dojo: failed to process input" ~)
:: +he-http-response: result from http-client
::
++ he-http-response
@ -1429,23 +1439,34 @@
=/ naked-gen=(unit term)
%+ rust txt
(full (ifix [lus (just `@`10)] ;~(pose sym (easy %$))))
?~ naked-gen
?^ naked-gen
(complete-naked-gen u.naked-gen)
=/ naked-ted=(unit term)
%+ rust txt
(full (ifix [hep (just `@`10)] ;~(pose sym (easy %$))))
?~ naked-ted
res
(complete-naked-gen u.naked-gen)
(complete-naked-ted u.naked-ted)
::
++ complete-naked-poke
|= app=term
=/ pax=path
/(scot %p our.hid)/[q:he-beam]/(scot %da now.hid)/app
=+ [our=(scot %p our.hid) now=(scot %da now.hid)]
=+ .^(desks=(set desk) %cd /[our]//[now])
=. desks (~(del in desks) %kids)
%+ complete (cat 3 ':' app)
%+ murn ~(tap by dir:.^(arch %cy pax))
|= [=term ~]
^- (unit [^term tank])
?. =(app (end [3 (met 3 app)] term))
%- zing
%+ turn ~(tap in desks)
|= =desk
%+ murn
%~ tap in
.^((set [dude:gall ?]) %ge /[our]/[desk]/[now]/$)
|= [=dude:gall live=?]
^- (unit [term tank])
?. live
~
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
?. =(app (end [3 (met 3 app)] dude))
~
`[(cat 3 ':' term) *tank]
`[(cat 3 ':' dude) *tank]
::
++ complete-variable
|= variable=term
@ -1459,14 +1480,17 @@
::
++ complete-gen-poke-to-app
|= [app=term gen=term]
=. app
?:(?=(%$ app) %hood app)
=? app =(%$ app)
%hood
%+ complete
?: =(%hood app)
(cat 3 '|' gen)
:((cury cat 3) ':' app '|' gen)
=/ pfix=path
/(scot %p our.hid)/[q:he-beam]/(scot %da now.hid)/gen/[app]
=+ [our=(scot %p our.hid) now=(scot %da now.hid)]
?. .^(? %gu /[our]/[app]/[now]/$)
~
=+ .^(=desk %gd /[our]/[app]/[now]/$)
=/ pfix=path /[our]/[desk]/[now]/gen/[app]
::
%^ tab-generators:auto pfix `app
%+ murn
@ -1493,6 +1517,27 @@
~
(some term)
::
++ complete-naked-ted
|= ted=term
=/ pfix=path
/(scot %p our.hid)/[q:he-beam]/(scot %da now.hid)/ted
=+ .^(paths=(list path) %ct pfix)
%+ complete (cat 3 '-' ted)
%+ murn paths
|= pax=path
^- (unit [term tank])
?~ pax
~
?~ t.pax
~
?. =(%hoon (rear t.pax))
~
=/ =cord
(reel (join '-' (snip `path`t.pax)) (cury cat 3))
?. =(ted (end [3 (met 3 ted)] cord))
~
`[(cat 3 '-' cord) *tank]
::
++ complete
|= [completing=term options=(list [term tank])]
?~ options
@ -1528,7 +1573,9 @@
:: Else, print results
::
%+ he-diff %tab
options
%+ sort options
|= [[a=term *] [b=term *]]
(aor a b)
--
::
++ he-type :: apply input
@ -1538,7 +1585,7 @@
he-pine:(~(dy-type dy u.poy) act)
?- -.dat.act
%det (he-stir +.dat.act)
%ret (he-done (tufa buf.say))
%ret (he-card %pass /self %agent [our.hid %dojo] %poke %done !>(id))
%clr he-pine(buf "")
%tab (he-tab +.dat.act)
==
@ -1668,6 +1715,11 @@
=+ !<([ses=@ta =command:lens] vase)
=/ =id [our.hid ses]
he-abet:(~(he-lens he hid id ~ (~(got by hoc) id)) command)
::
%done
=+ !<(=id vase)
=/ ses=session (~(got by hoc) id)
he-abet:(~(he-done he hid id ~ ses) (tufa buf.say.ses))
::
%allow-remote-login
=/ who !<(@p vase)
@ -1736,6 +1788,7 @@
?+ i.t.t.wire ~|([%dojo-bad-on-agent wire -.sign] !!)
%poke (he-unto:he-full t.wire sign)
%wool (he-wool:he-full t.wire sign)
%self (he-self:he-full t.wire sign)
==
[moves ..on-init]
::

9
pkg/arvo/app/ping.hoon
View File

@ -9,7 +9,7 @@
:: Note this issue manifests itself even for bootstrapping a planet to
:: talk to its own star.
::
/+ default-agent, verb
/+ default-agent, verb, dbug
=* point point:kale
::
|%
@ -21,6 +21,8 @@
==
--
::
%- agent:dbug
::
=| state=[%0 ships=(map ship [=rift =ship-state])]
=> |%
:: +print-error: maybe +slog
@ -118,6 +120,11 @@
=. state new-state
loop(old-ships t.old-ships)
::
:: NB: !! This includes our own ship, and for moons, this is what
:: has caused Jael to fetch our own rift from our parent. This
:: role may be taken by Ames's subscription to %public-keys, but
:: this must be tested before changing the behavior here.
::
=/ new-ships (saxo:title our now our)
|- ^- (quip card _state)
=* loop $

10
pkg/arvo/app/spider.hoon
View File

@ -554,9 +554,13 @@
~
%+ give-simple-payload:app:server u.eyre-id
^- simple-payload:http
:_ ~ :_ ~
?. ?=(http-error:spider term)
((slog tang) 500)
%- (slog tang)
=/ tube (convert-tube %tang %json desk bowl)
:- [500 [['content-type' 'application/json'] ~]]
=- `(as-octs:mimes:html (en:json:html -))
o/(malt `(list [key=@t json])`[term+s/term tang+!<(json (tube !>(tang))) ~])
:_ ~ :_ ~
?- term
%bad-request 400
%forbidden 403
@ -570,9 +574,9 @@
::%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)
=^ http-cards state (thread-http-fail tid term tang)
=^ scry-card state (cancel-scry tid silent=%.n)
=^ cards state (thread-clean yarn)
:_ state
:(weld fail-cards cards http-cards scry-card)
::

4
pkg/arvo/gen/hood/doze.hoon
View File

@ -1,4 +0,0 @@
:- %say
|= [^ [dap=term wake=$@(~ [%wake ~])] ~]
=/ mode ?@(wake %idle %jolt)
[%helm-pass %g %fade dap mode]

17
pkg/arvo/gen/hood/fade.hoon
View File

@ -1,17 +0,0 @@
:: Drum: destroy app
::
:::: /hoon/fade/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=[@ $@(~ [@ ~])] ~]
==
:- %drum-fade
?> ((sane %tas) -.arg)
?@ +.arg [q.bec -.arg]
?> ((sane %tas) +<.arg)
[-.arg +<.arg]

13
pkg/arvo/gen/hood/rc.hoon
View File

@ -1,13 +0,0 @@
:: Helm: Reload %clay
::
:::: /hoon/rc/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=~ ~]
==
[%helm-reload ~[%c]]

5
pkg/arvo/gen/hood/resume.hoon
View File

@ -1,5 +0,0 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-resume desk]

2
pkg/arvo/gen/vats.hoon
View File

@ -22,7 +22,7 @@
%- zing
%+ turn
%+ sort
=/ sed .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now))
=/ sed .^((set desk) %cd /(scot %p p.bec)//(scot %da now))
(sort ~(tap in sed) |=([a=@ b=@] !(aor a b)))
|=([a=desk b=desk] ?|(=(a %kids) =(b %base)))
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))

5
pkg/arvo/sys/arvo.hoon
View File

@ -1555,9 +1555,9 @@
^- roon
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
?. ?| =(our p.bem)
?. ?& =(our p.bem)
?=(%$ q.bem)
=([%da now] p.r.bem)
=([%da now] r.bem)
==
~
?+ s.bem ~
@ -1742,6 +1742,7 @@
%i %iris
%j %jael
%k %khan
%l %lick
==
-- =>
::

5
pkg/arvo/sys/hoon.hoon
View File

@ -4239,12 +4239,11 @@
?& ?| =(1 tef)
=+ i=1
|- ^- ?
?|
=(i tef)
?| =(i tef)
?& (gte (cut 3 [(add i inx) 1] b) 128)
$(i +(i))
== == ==
$(inx +(inx))
$(inx (add inx tef))
==
::
++ ruth :: biblical sanity

126
pkg/arvo/sys/lull.hoon
View File

@ -1375,7 +1375,9 @@
=+ len=(cut 3 [4 2] hoot)
=+ pat=(cut 3 [6 len] hoot)
~| pat=pat
[(add 6 len) [(stab pat) num]]
:- (add 6 len)
:_ num
(rash pat ;~(pfix fas (most fas (cook crip (star ;~(less fas prn))))))
::
++ sift-meow
|= =yowl
@ -1528,7 +1530,10 @@
file-path=term ::
== ::
+$ care :: clay submode
?(%a %b %c %d %e %f %p %r %s %t %u %v %w %x %y %z) ::
$? %a %b %c %d %e %f ::
%p %q %r %s %t %u ::
%v %w %x %y %z ::
== ::
+$ cash :: case or tako
$% [%tako p=tako] ::
case ::
@ -2070,7 +2075,10 @@
$% [%payload =simple-payload:http]
== ==
+$ gift
$% :: set-config: configures the external http server
$% :: ames responses
::
$>(?(%boon %done) gift:ames)
:: set-config: configures the external http server
::
:: TODO: We need to actually return a (map (unit @t) http-config)
:: so we can apply configurations on a per-site basis
@ -2101,6 +2109,9 @@
:: new unix process
::
$>(%born vane-task)
:: network request
::
$>(%plea vane-task)
:: trim state (in response to memory pressure)
::
$>(%trim vane-task)
@ -2113,6 +2124,11 @@
:: update http configuration
::
[%rule =http-rule]
:: set a base url for eauth, like `'https://sampel.com'
::
:: eyre will append /~/eauth to it internally to redirect into eauth
::
[%eauth-host host=(unit @t)]
:: starts handling an inbound http request
::
[%request secure=? =address =request:http]
@ -2194,6 +2210,18 @@
$: :: sessions: a mapping of session cookies to session information
::
sessions=(map @uv session)
:: visitors: in-progress incoming eauth flows
::
visitors=(map @uv visitor)
:: visiting: outgoing eauth state per ship
::
visiting=(map ship logbook)
:: endpoint: hardcoded local eauth endpoint for %syn and %ack
::
:: user-configured or auth-o-detected, with last-updated timestamp.
:: both shaped like 'prot://host'
::
endpoint=[user=(unit @t) auth=(unit @t) =time]
==
:: +session: server side data about a session
::
@ -2215,13 +2243,72 @@
:: mint some sort of long lived cookie for mobile apps which only has
:: access to a single application path.
==
:: +visitor: completed or in-progress incoming eauth flow
::
:: duct: boon duct
:: and
:: sesh: login completed, session exists
:: or
:: pend: awaiting %tune for %keen sent at time, for initial eauth http req
:: ship: the @p attempting to log in
:: base: local protocol+hostname the attempt started on, if any
:: last: the url to redirect to after log-in
:: toke: authentication secret received over ames or offered by visitor
::
+$ visitor
$: duct=(unit duct)
$@ sesh=@uv
$: pend=(unit [http=duct keen=time])
ship=ship
base=(unit @t)
last=@t
toke=(unit @uv)
== ==
:: +logbook: record of outgoing eauth comms & state
::
:: qeu: a queue of nonces for to-be-n/acked pleas
:: map: per nonce, completed or pending eauth session
::
+$ logbook [=(qeu @uv) =(map @uv portkey)]
:: +portkey: completed or in-progress outgoing eauth flow
::
:: made: live since
:: or
:: duct: confirm request awaiting redirect
:: toke: secret to include in redirect, unless aborting
::
+$ portkey
$@ made=@da :: live since
$: pend=(unit duct) :: or await redir
toke=(unit @uv) :: with secret
==
:: +eauth-plea: client talking to host
::
+$ eauth-plea
$: %0
$% :: %open: client decided on an attempt, wants to return to url
:: %shut: client wants the attempt or session closed
::
[%open nonce=@uv token=(unit @uv)]
[%shut nonce=@uv]
== ==
:: +eauth-boon: host responding to client
::
+$ eauth-boon
$: %0
$% :: %okay: attempt heard, client to finish auth through url
:: %shut: host has expired the session
::
[%okay nonce=@uv url=@t]
[%shut nonce=@uv]
== ==
:: $identity: authentication method & @p
::
+$ identity
$~ [%ours ~]
$% [%ours ~] :: local, root
[%fake who=@p] :: guest id
:: [%real who=@p] :: authed cross-ship
[%real who=@p] :: authed cross-ship
==
:: channel-state: state used in the channel system
::
@ -2339,6 +2426,9 @@
:: internal authentication page
::
[%authentication ~]
:: cross-ship authentication handling
::
[%eauth ~]
:: internal logout page
::
[%logout ~]
@ -3104,6 +3194,30 @@
:: ::
+$ shed _*form:(strand:rand ,vase) :: compute vase
-- ::khan
:: ::::
:::: ++lick :: (1j) IPC
:: ::::
++ lick ^?
|%
+$ gift :: out result <-$
$% [%spin =name] :: open an IPC port
[%shut =name] :: close an IPC port
[%spit =name =mark =noun] :: spit a noun to the IPC port
[%soak =name =mark =noun] :: soak a noun from the IPC port
==
+$ task :: in request ->$
$~ [%vega ~] ::
$% $>(%born vane-task) :: new unix process
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
[%spin =name] :: open an IPC port
[%shut =name] :: close an IPC port
[%spit =name =mark =noun] :: spit a noun to the IPC port
[%soak =name =mark =noun] :: soak a noun from the IPC port
==
::
+$ name path
-- ::lick
::
++ rand :: computation
|%
@ -3306,6 +3420,7 @@
gift:iris
gift:jael
gift:khan
gift:lick
==
+$ task-arvo :: in request ->$
$% task:ames
@ -3317,6 +3432,7 @@
task:iris
task:jael
task:khan
task:lick
==
+$ note-arvo :: out request $->
$~ [%b %wake ~]
@ -3329,6 +3445,7 @@
[%i task:iris]
[%j task:jael]
[%k task:khan]
[%l task:lick]
[%$ %whiz ~]
[@tas %meta vase]
==
@ -3351,6 +3468,7 @@
[%iris gift:iris]
[%jael gift:jael]
[%khan gift:khan]
[%lick gift:lick]
==
:: $unix-task: input from unix
::

183
pkg/arvo/sys/vane/ames.hoon
View File

@ -274,9 +274,7 @@
^- [sig=@ux dat=$@(~ (cask))]
=/ mes=@
%+ rep response-size
%+ turn
(sort hav |=([a=have b=have] (lth fra.a fra.b)))
|=(=have dat.have)
(roll hav |=([=have dat=(list @ux)] [dat.have dat]))
=+ sig=(end 9 mes)
:- sig
=+ dat=(rsh 9 mes)
@ -2283,6 +2281,7 @@
::
=~ (emit duct %pass /turf %j %turf ~)
(emit duct %pass /private-keys %j %private-keys ~)
(emit duct %pass /public-keys %j %public-keys [n=our ~ ~])
==
:: +on-priv: set our private key to jael's response
::
@ -2344,6 +2343,8 @@
++ on-publ-breach
|= =ship
^+ event-core
?: =(our ship)
event-core
::
=/ ship-state (~(get by peers.ames-state) ship)
:: we shouldn't be hearing about ships we don't care about
@ -2406,6 +2407,8 @@
=public-key
==
^+ event-core
?: =(our ship)
event-core
::
=/ ship-state (~(get by peers.ames-state) ship)
?. ?=([~ %known *] ship-state)
@ -2435,6 +2438,9 @@
|= [=ship sponsor=(unit ship)]
^+ event-core
::
?: =(our ship)
event-core
::
?~ sponsor
%- (slog leaf+"ames: {(scow %p ship)} lost sponsor, ignoring" ~)
event-core
@ -2458,6 +2464,10 @@
::
=+ ^- [=ship =point] i.points
::
?: =(our ship)
=. rift.ames-state rift.point
$(points t.points)
::
?. (~(has by keys.point) life.point)
$(points t.points)
::
@ -2522,6 +2532,9 @@
++ on-publ-rift
|= [=ship =rift]
^+ event-core
?: =(our ship)
=. rift.ames-state rift
event-core
?~ ship-state=(~(get by peers.ames-state) ship)
:: print error here? %rift was probably called before %keys
::
@ -4080,6 +4093,7 @@
?. =(vane.plea %$)
?+ vane.plea ~| %ames-evil-vane^our^her^vane.plea !!
%c (pe-emit duct %pass wire %c %plea her plea)
%e (pe-emit duct %pass wire %e %plea her plea)
%g (pe-emit duct %pass wire %g %plea her plea)
%j (pe-emit duct %pass wire %j %plea her plea)
==
@ -4313,9 +4327,16 @@
=^ found=? fine (fi-on-ack num)
?. found
(fi-fast-retransmit:og num)
=: hav.keen [[num meow] hav.keen]
num-received.keen +(num-received.keen)
==
=. num-received.keen +(num-received.keen)
=. hav.keen
:: insert in reverse order
::
|- ^- (list have)
?~ hav.keen
[num meow]~
?: (lth num fra.i.hav.keen)
[i.hav.keen $(hav.keen t.hav.keen)]
[[num meow] hav.keen]
?. =(num-fragments num-received):keen
fi-continue
(fi-done [sig dat]:fi-sift-full)
@ -4344,28 +4365,29 @@
++ fi-on-ack
=| marked=(list want)
|= fra=@ud
^- [? _fine]
=; [[found=? cor=_fine] wan=_wan.keen]
:- found
?.(found fine cor(wan.keen wan))
%^ (dip:fi-mop ,[found=? cor=_fine]) wan.keen
^- [found=? cor=_fine]
=. fine
=/ first (pry:fi-mop wan.keen)
?~ first
fine
?: =(fra fra.val.u.first)
fine
=^ resend=? metrics.keen
(on-skipped-packet:fi-gauge +>.val.u.first)
?: !resend
fine
=. tries.val.u.first +(tries.val.u.first)
=. last-sent.val.u.first now
=. wan.keen (put:fi-mop wan.keen u.first)
=. fine (fi-send `@ux`hoot.val.u.first)
fine
::
=/ found (get:fi-mop wan.keen fra)
?~ found
[| fine]
|= [[found=? cor=_fine] @ud =want]
^- [(unit _want) stop=? [found=? cor=_fine]]
=. fine cor
?: =(fra fra.want)
=. metrics.keen
(on-ack:fi-gauge +>.want)
[~ %.y %.y fine]
=. skips.want +(skips.want)
=^ resend=? metrics.keen
(on-skipped-packet:fi-gauge +>.want)
?. resend
[`want %.n found fine]
=. tries.want +(tries.want)
=. last-sent.want now
=. fine (fi-send `@ux`hoot.want)
[`want %.n found fine]
=. metrics.keen (on-ack:fi-gauge +>.u.found)
=. wan.keen +:(del:fi-mop wan.keen fra)
[& fine]
::
++ fi-done
|= [sig=@ data=$@(~ (cask))]
@ -4862,53 +4884,60 @@
++ state-14-to-15
|= old=ames-state-14
^- ^ames-state
=- old(peers -)
%- ~(run by peers.old)
|= ship-state=ship-state-14
^- ^ship-state
?. ?=(%known -.ship-state)
ship-state
|^ %= ship-state
snd (~(run by snd.ship-state) message-pump-14-to-15)
keens (~(run by keens.ship-state) keen-state-14-to-15)
rcv (~(rut by rcv.ship-state) remove-outbound-naxplanations)
%= old
rift
!< =rift =< q
(need (need (rof ~ /ames %j `beam`[[our %rift %da now] /(scot %p our)])))
::
peers
%- ~(run by peers.old)
|= ship-state=ship-state-14
^- ^ship-state
?. ?=(%known -.ship-state)
ship-state
|^
%= ship-state
snd (~(run by snd.ship-state) message-pump-14-to-15)
keens (~(run by keens.ship-state) keen-state-14-to-15)
rcv (~(rut by rcv.ship-state) remove-outbound-naxplanations)
==
::
++ message-pump-14-to-15
|= pump=message-pump-state-14
^- message-pump-state
%= pump
metrics.packet-pump-state
[rto rtt rttvar ssthresh cwnd counter]:metrics.packet-pump-state.pump
==
::
++ message-pump-14-to-15
|= pump=message-pump-state-14
^- message-pump-state
%= pump
metrics.packet-pump-state
[rto rtt rttvar ssthresh cwnd counter]:metrics.packet-pump-state.pump
==
::
++ keen-state-14-to-15
|= keen-state=keen-state-14
^- ^keen-state
%= keen-state
metrics [rto rtt rttvar ssthresh cwnd counter]:metrics.keen-state
==
::
++ remove-outbound-naxplanations
|= [=bone sink=message-sink-state]
^+ sink
=/ target=^bone (mix 0b10 bone)
?. =(%3 (mod target 4)) sink
%_ sink
::
++ keen-state-14-to-15
|= keen-state=keen-state-14
^- ^keen-state
%= keen-state
metrics [rto rtt rttvar ssthresh cwnd counter]:metrics.keen-state
==
::
++ remove-outbound-naxplanations
|= [=bone sink=message-sink-state]
^+ sink
=/ target=^bone (mix 0b10 bone)
?. =(%3 (mod target 4)) sink
%_ sink
nax
=/ pump=message-pump-state-14 (~(got by snd.ship-state) target)
%- ~(rep in nax.sink)
|= [=message-num nax=(set message-num)]
:: we keep messages in the queue that have not been acked.
:: if the message-num for the naxplanation we sent is
:: less than the current message, +pump-done:mu had been called,
:: so the message-num can be safely removed
::
=? nax (gte message-num current.pump)
(~(put in nax) message-num)
nax
=/ pump=message-pump-state-14 (~(got by snd.ship-state) target)
%- ~(rep in nax.sink)
|= [=message-num nax=(set message-num)]
:: we keep messages in the queue that have not been acked.
:: if the message-num for the naxplanation we sent is
:: less than the current message, +pump-done:mu had been called,
:: so the message-num can be safely removed
::
=? nax (gte message-num current.pump)
(~(put in nax) message-num)
nax
==
--
==
--
==
--
:: +scry: dereference namespace
::
@ -5073,6 +5102,13 @@
=+ per=!<([r=dict:clay w=dict:clay] q.u.u.pem)
?. =([%black ~ ~] rul.r.per) ~
(en-hunk (rof ~ /ames nom))
::
%e
=/ kyr ?@(vis.nom (rsh 3 vis.nom) car.vis.nom)
%- en-hunk
?+ kyr ~
%x (rof ~ /ames nom)
==
::
%g
=/ kyr ?@(vis.nom (rsh 3 vis.nom) car.vis.nom)
@ -5106,5 +5142,8 @@
?~ keen=(~(get by keens.u.peer) path)
[~ ~]
``noun+!>(listeners:u.keen)
::
[%rift ~]
``noun+!>(rift.ames-state)
==
--

65
pkg/arvo/sys/vane/clay.hoon
View File

@ -160,6 +160,8 @@
[%1 =desk =lobe]
==
::
:: All except %1 are deprecated
::
+$ fell
$% [%direct p=lobe q=page]
[%delta p=lobe q=[p=mark q=lobe] r=page]
@ -943,7 +945,7 @@
%- road |.
((pile-rule pax) [1 1] tex)
?^ res pile.u.res
%- mean %- flop
%- mean
=/ lyn p.hair
=/ col q.hair
^- (list tank)
@ -1544,7 +1546,7 @@
::
++ good-care
|= =care
(~(has in ^~((silt `(list ^care)`~[%u %w %x %y %z]))) care)
(~(has in ^~((silt `(list ^care)`~[%q %u %w %x %y %z]))) care)
--
::
:: Build and send agents to gall
@ -3362,6 +3364,7 @@
%s ~| %please-dont-get-your-takos-over-a-network !!
%t ~| %requesting-foreign-directory-is-vaporware !!
%v ~| %weird-shouldnt-get-v-request-from-network !!
%q `[p %noun q]:r.rand
%u `(validate-u r.rand)
%w `(validate-w r.rand)
%x (validate-x [p.p q.p q r]:rand)
@ -3566,7 +3569,7 @@
== ==
:: make the request over remote scry
::
=/ =mood [%x uv+tako path]:i.need.sat
=/ =mood [%q uv+tako path]:i.need.sat
=< [`[%back-index -] +]
(send-over-scry %back-index hen her inx syd mood)
:: otherwise, request over ames
@ -3784,6 +3787,10 @@
:: %next is just %mult with one path, so we pretend %next = %mult here.
::
?(%next %mult)
?. ?=(~ for)
:: reject if foreign (doesn't work over the network)
::
[[~ ~] ..park]
:: because %mult requests need to wait on multiple files for each
:: revision that needs to be checked for changes, we keep two
:: cache maps. {old} is the revision at {(dec aeon)}, {new} is
@ -3965,6 +3972,8 @@
::
%many
:_ ..park
?. |(?=(~ for) (allowed-by:ze u.for path.moat.rov per.red))
[~ ~]
=/ from-aeon (case-to-aeon from.moat.rov)
?~ from-aeon
:: haven't entered the relevant range, so do nothing
@ -4249,6 +4258,27 @@
^- (list (pair path lobe))
[[~ ?~(us *lobe u.us)] descendants]
|=([[path lobe] @uvI] (shax (jam +<)))
:: +read-q: typeless %x
::
:: useful if the marks can't be built (eg for old marks built
:: against an incompatible standard library). also useful if you
:: don't need the type (eg for remote scry) because it's faster.
::
++ read-q
|= [tak=tako pax=path]
^- (unit (unit cage))
?: =(0v0 tak)
[~ ~]
=+ yak=(tako-to-yaki tak)
=+ lob=(~(get by q.yak) pax)
?~ lob
[~ ~]
=/ peg=(unit page) (~(get by lat.ran) u.lob)
:: if tombstoned, nothing to return
::
?~ peg
~
``[p.u.peg %noun q.u.peg]
:: +read-r: %x wrapped in a vase
::
++ read-r
@ -4443,23 +4473,15 @@
++ read-x
|= [tak=tako pax=path]
^- [(unit (unit cage)) _..park]
?: =(0v0 tak)
[[~ ~] ..park]
=+ yak=(tako-to-yaki tak)
=+ lob=(~(get by q.yak) pax)
?~ lob
[[~ ~] ..park]
=/ peg=(unit page) (~(get by lat.ran) u.lob)
:: if tombstoned, nothing to return
::
?~ peg
[~ ..park]
=/ q (read-q tak pax)
?~ q `..park
?~ u.q `..park
:: should convert any lobe to cage
::
=^ =cage ..park
%+ tako-flow tak
%- wrap:fusion
(page-to-cage:(tako-ford tak) u.peg)
(page-to-cage:(tako-ford tak) p.u.u.q q.q.u.u.q)
[``cage ..park]
::
:: Gets an arch (directory listing) at a node.
@ -4533,6 +4555,7 @@
%e (read-e tak path.mun)
%f (read-f tak path.mun)
%p [(read-p path.mun) ..park]
%q [(read-q tak path.mun) ..park]
%r (read-r tak path.mun)
%s [(read-s tak path.mun case.mun) ..park]
%t [(read-t tak path.mun) ..park]
@ -5049,6 +5072,11 @@
==
==
[~ ..^$]
::
[%fine ~]
~& "clay: resetting fine state. old:"
~& sad.ruf
`..^$(sad.ruf ~)
==
::
%tire
@ -6193,12 +6221,15 @@
?: ?=(%boon +<.hin) `;;(fell payload.hin)
?~ roar.hin ~
?~ q.dat.u.roar.hin ~
=* pag u.q.dat.u.roar.hin
`[%direct (page-to-lobe pag) pag]
`[%1 `u.q.dat.u.roar.hin]
::
=^ mos ruf
=/ den ((de now rof hen ruf) her desk)
?~ fell
:: We shouldn't get back null on any of the fine requests we
:: make unless they're out of date
::
%- (slog leaf+"clay: got null from {<her>}, falling back to ames" ~)
abet:(retry-with-ames:den %back-index index)
=? den ?=(%tune +<.hin)
(cancel-scry-timeout:den index)

1378
pkg/arvo/sys/vane/eyre.hoon
View File

File diff suppressed because it is too large Load Diff

19
pkg/arvo/sys/vane/gall.hoon
View File

@ -1153,7 +1153,13 @@
=/ =note-arvo
=/ prov=path /gall/[agent-name]
?- -.neet
%arvo +.neet
%arvo ?. ?=([%l *] +.neet)
+.neet
?+ +.neet
~|(%nope !!)
[%l ?(%spin %shut) *] +.neet(name [agent-name name.+.neet])
[%l %spit *] +.neet(name [agent-name name.+.neet])
==
%huck note-arvo.neet
%agent [%g %deal [our ship.neet prov] [name task]:neet]
==
@ -1277,7 +1283,7 @@
::
?. ?& ?=(%x care)
?=([~ ~ *] p.peek-result)
!=(mark p.u.u.p.peek-result)
!=(want p.u.u.p.peek-result)
==
p.peek-result
:: for %x scries, attempt to convert to the requested mark if needed
@ -1397,6 +1403,15 @@
~/ %ap-generic-take
|= [=wire =sign-arvo]
^+ ap-core
=? sign-arvo ?=([%lick *] sign-arvo)
?+ sign-arvo
~|(%nope !!)
::
[%lick %soak *]
=- sign-arvo(name -)
?> &(?=(^ name.sign-arvo) =(agent-name i.name.sign-arvo))
t.name.sign-arvo
==
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(on-arvo:ap-agent-core wire sign-arvo)

133
pkg/arvo/sys/vane/lick.hoon Normal file
View File

@ -0,0 +1,133 @@
:: %lick
!:
!? 164
::
=, lick
|= our=ship
=> |%
+$ move [p=duct q=(wite note gift)]
+$ note ~ :: out request $->
+$ sign ~
::
+$ lick-state
$: %0
unix-duct=duct
owners=(map name duct)
==
::
+$ name path
--
::
~% %lick ..part ~
::
=| lick-state
=* state -
|= [now=@da eny=@uvJ rof=roof]
=* lick-gate .
^?
|%
:: +register: Create a move to register an agent with vere
::
++ register
|= =name
^- move
[unix-duct.state %give [%spin name]]
:: +disconnect: Create Move to send a disconnect soak to am agent
::
++ disconnect
|= =name
^- move
=/ =duct (~(get by owners) name)
[+.duct %give [%soak name %disconnect ~]]
:: +call: handle a +task:lick request
::
++ call
|= $: hen=duct
dud=(unit goof)
wrapped-task=(hobo task)
==
^- [(list move) _lick-gate]
::
=/ =task ((harden task) wrapped-task)
?+ -.task [~ lick-gate]
%born :: need to register devices with vere and send disconnect soak
:- %+ weld
(turn ~(tap in ~(key by owners.state)) register)
(turn ~(tap in ~(key by owners.state)) disconnect)
lick-gate(unix-duct hen)
::
%spin :: A gall agent wants to spin a communication line
:- ~[(register name.task)]
lick-gate(owners (~(put by owners) name.task hen))
::
%shut :: shut down a communication line
:- [unix-duct.state %give [%shut name.task]]~
lick-gate(owners (~(del by owners) name.task))
::
%soak :: push a soak to the ipc's owner
=/ ner=duct (~(get by owners.state) name.task)
:_ lick-gate
[+.ner %give [%soak name.task mark.task noun.task]]~
::
%spit :: push a spit to ipc
:_ lick-gate
[unix-duct.state %give [%spit name.task mark.task noun.task]]~
==
:: +load: migrate an old state to a new lick version
::
++ load
|= old=lick-state
^+ lick-gate
lick-gate(state old)
:: +scry: view state
::
:: %a scry out a list of all ipc ports
:: %d get the owner of an ipc port
++ scry
^- roon
|= [lyc=gang pov=path car=term bem=beam]
^- (unit (unit cage))
|^
:: only respond for the local identity, current timestamp
::
?. ?& =(our p.bem)
=(%$ q.bem)
=([%da now] r.bem)
==
~
?+ car ~
%a read-a
%d read-d
%u read-u
==
:: +read-a: scry our list of ports
::
++ read-a
^- (unit (unit cage))
=/ ports=(list name) ~(tap in ~(key by owners))
``[%noun !>(ports)]
:: +read d: get ports owner
::
++ read-d
^- (unit (unit cage))
=/ devs=(unit duct) (~(get by owners) s.bem)
?~ devs [~ ~]
``[%noun !>(devs)]
:: +read u: does a port exist
::
++ read-u
^- (unit (unit cage))
``[%noun !>((~(has by owners) s.bem))]
::
--
::
++ stay
state
++ take
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^- [(list move) _lick-gate]
?^ dud
~|(%lick-take-dud (mean tang.u.dud))
::
[~ lick-gate]
--

16
pkg/base-dev/lib/shoe.hoon
View File

@ -413,23 +413,25 @@
=/ cobs=(list [wid=@ud (list tape)])
(turn cows col-as-lines)
=+ [lin=0 any=|]
=+ len=(lent cobs)
=| fez=(list sole-effect)
|- ^+ fez
=; out=tape
=; [line=(list tape) end=@ud]
:: done when we're past the end of all columns
::
?: (levy out (cury test ' '))
?: =(len end)
(flop fez)
=; fec=sole-effect
$(lin +(lin), fez [fec fez])
=/ out=tape
(zing (join " " line))
?. bold txt+out
klr+[[`%br ~ ~]^[(crip out)]~]~
%+ roll cobs
|= [[wid=@ud lines=(list tape)] out=tape]
%+ weld out
%+ weld ?~(out "" " ")
%^ spin cobs 0
|= [[wid=@ud lines=(list tape)] empty=@ud]
=+ l=(swag [lin 1] lines)
?^(l i.l (reap wid ' '))
?^ l [i.l empty]
[(reap wid ' ') +(empty)]
::
++ col-as-lines
|= [wid=@ud col=dime]

8
pkg/base-dev/sur/hood.hoon
View File

@ -159,16 +159,10 @@
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
?. verb
=/ cut=(list tape) (turn meb truncate-hash)
=/ len (lent cut)
=/ base-hash
?: =(0 len) "~"
?: =(1 len) (head cut)
"~[{`tape`(zing (join " " `(list tape)`cut))}]"
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash ends in: {base-hash}"
leaf/"%cz hash ends in: {(truncate-hash hash)}"
leaf/"app status: {sat}"
leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
::

6
pkg/interface/dbug/src/js/store.js
View File

@ -12,7 +12,11 @@ class Store {
commits: [],
bindings: [],
connections: [],
authentication: [],
authentication: {
sessions: [],
visitors: [],
visiting: [],
},
channels: [],
sidebarShown: true
};

64
pkg/interface/dbug/src/js/views/eyre.js
View File

@ -21,7 +21,7 @@ export class Eyre extends Component {
const { props } = this;
if (props.bindings.length === 0) this.loadBindings();
if (props.connections.length == 0) this.loadConnections();
if (props.authentication.length == 0) this.loadAuthenticationState();
if (props.authentication.sessions.length == 0) this.loadAuthenticationState();
if (props.channels.length == 0) this.loadChannels();
}
@ -155,7 +155,8 @@ export class Eyre extends Component {
)};
});
const sessionItems = props.authentication.map(s => {
//TODO also make sure column headings get rendered
const sessionItems = props.authentication.sessions.map(s => {
return ({key: s.identity, jsx: (<div class="flex">
<div class="flex-auto" style={{maxWidth: '5em'}}>
{s.cookie.slice(0,6)}…
@ -178,6 +179,53 @@ export class Eyre extends Component {
</div>)});
});
const visitingItems = props.authentication.visiting.map(v => {
return ({key: '~'+v.who+':'+v.nonce, jsx: (<div class="flex">
<div class="flex-auto">
~{v.who}
</div>
<div class="flex-auto">
{v.nonce}
</div>
<div class="flex-auto">
{ v.goal ? 'pending, will return to '+v.goal :
<form method="post" action="/~/logout?redirect=/~debug/eyre">
logged in since {msToDa(v.made)}
<input type="hidden" name="host" value={'~'+v.who} />
<input type="hidden" name="sid" value={v.nonce} />
<button type="submit" name="eauth">log out</button>
</form>
}
</div>
</div>)});
});
const visitorsItems = props.authentication.visitors.map(v => {
return ({key: v.nonce+':~'+v.ship, jsx: (<div class="flex">
<div class="flex-auto">
{v.nonce}
</div>
<div class="flex-auto">
{v.duct}
</div>
{ v.sesh ? <div class="flex-auto">session: {v.sesh.slice(0,6)}…</div> :
<>
<div class="flex-auto">
{v.pend ? 'request pending' : 'no pending request'}
</div>
<div class="flex-auto">
{v.ship}
</div>
<div class="flex-auto">
redirect: {v.last}
</div>
<div class="flex-auto">
{v.toke ? 'token received' : 'no token yet'}
</div>
</> }
</div>)});
});
return (<>
<h4>Bindings</h4>
<SearchableList placeholder="binding" items={bindingItems}>
@ -194,15 +242,23 @@ export class Eyre extends Component {
<button onClick={this.loadChannels}>refresh</button>
</SearchableList>
<h4>Cookies</h4>
<h4>Authentication</h4>
<form method="post" action="/~/logout">
<button type="submit">logout self</button>
</form>
<form method="post" action="/~/logout">
<button type="submit" name="all">logout all selves</button>
</form>
<br/>
<button onClick={this.loadAuthenticationState}>refresh</button>
<h3>Sessions</h3>
<SearchableList placeholder="identity" items={sessionItems}>
<button onClick={this.loadAuthenticationState}>refresh</button>
</SearchableList>
<h3>Outgoing eauth</h3>
<SearchableList placeholder="host" items={visitingItems}>
</SearchableList>
<h3>Incoming eauth</h3>
<SearchableList placeholder="visitor" items={visitorsItems}>
</SearchableList>
</>);
}

4
tests/sys/hoon/auras.hoon
View File

@ -143,4 +143,8 @@
!> (scot %q 0x101.0101.0101.0101.0102)
::
==
::
++ test-sane
%- expect
!>(((sane %t) '🤔'))
--

287
tests/sys/vane/eyre.hoon
View File

@ -1190,10 +1190,24 @@
;< ~ bind:m perform-init
|= =state
:+ %& ~
=- state(sessions.authentication-state.server-state.ax.gate -)
%+ ~(put by sessions.authentication-state.server-state.ax.gate.state)
=- state(sessions.auth.server-state.ax.gate -)
%+ ~(put by sessions.auth.server-state.ax.gate.state)
0vguest
[fake+~sampel-sampel-sampel-sampel--sampel-sampel-sampel-sampel ~2222.2.2 ~]
::
++ setup-for-eauth
|= base=@t
=/ m (mare ,~)
^- form:m
;< ~ bind:m perform-init-wo-timer
;< ~ bind:m perform-born
;< ~ bind:m perform-authentication-2
;< ~ bind:m
:: make sure there is an eauth endpoint set
::
|= =state
&+`state(user.endpoint.auth.server-state.ax.gate `base)
(pure:m ~)
:: +perform-born: %born an eyre-gate
::
++ perform-born
@ -1209,7 +1223,6 @@
;< ~ bind:m perform-init-wo-timer
;< ~ bind:m perform-born
perform-authentication-2
:: +perform-authentication: goes through the authentication flow
::
++ perform-authentication-2
@ -1219,7 +1232,7 @@
(get '/~/login?redirect=/~landscape/inner-path' g-auth ~)
;< ~ bind:m
=/ headers ['content-type' 'text/html']~
=/ body `(login-page:eyre-gate `'/~landscape/inner-path' ~nul fake+g-name %.n)
=/ body `(login-page:eyre-gate `'/~landscape/inner-path' ~nul fake+g-name ~ %.n)
(expect-moves mos (ex-response 200 headers body) ~)
;< mos=(list move) bind:m
=/ body 'password=lidlut-tabwed-pillex-ridrup&redirect=/~landscape'
@ -1230,6 +1243,272 @@
(expect-moves mos (ex-sessions token ~ ~) (ex-response 303 headers ~) ~)
(pure:m ~)
::
++ eauth
|%
++ nonce 0vcn5.qlgj3.hpopf
++ server
|%
++ wire `^wire`/eauth/keen/(scot %p ~sampel)/(scot %uv nonce)
::
++ start
=/ body 'eauth&name=~sampel&redirect=/final'
(post '/~/login' [g-auth]~ body)
::
++ tune
%^ take /eauth/keen/(scot %p ~sampel)/(scot %uv nonce)
~[/http-blah]
::NOTE path and signature don't matter here, eyre doesn't look at them
[%ames %tune [~sampel *path] ~ [*path ~ %noun `'http://sampel.com/~/eauth'] ~]
::
++ grant
%+ call ~[/http-blah]
[%plea ~sampel %e /eauth/0 `eauth-plea:eyre`[%0 %open nonce `0vtoken]]
::
++ final
=; url=@t (get url [g-auth]~)
(cat 3 '/~/eauth?token=0vtoken&nonce=' (scot %uv nonce))
::
++ ex-keen
|= =time
%+ ex ~[/http-blah]
=. time (sub time (mod time ~h1))
[%pass wire %a %keen ~sampel /e/x/(scot %da time)//eauth/url]
::
++ ex-yawn
|= =time
%+ ex ~[/http-blah]
=. time (sub time (mod time ~h1))
[%pass wire %a %yawn ~sampel /e/x/(scot %da time)//eauth/url]
::
++ ex-done
(ex ~[/http-blah] %give %done ~)
::
++ ex-boon
|= boon=eauth-boon:eyre
(ex ~[/http-blah] %give %boon boon)
--
::
++ client
|%
++ wire /eauth/plea/(scot %p ~hoster)
++ duct [/eyre/eauth/synthetic]~
::
++ grant
=/ body 'server=~hoster&nonce=0vnonce&grant=grant'
(post '/~/eauth' cookie body)
::
++ okay
::NOTE eyre doesn't do anything with the %done ack,
:: so we dont simulate it
%^ take wire
duct
[%ames %boon %0 %okay 0vnonce 'http://hoster.com/~/eauth']
::
::NOTE expects a version %0 plea for :ship
++ ex-plea
|= [=ship plea=eauth-plea:eyre]
(ex duct %pass wire %a %plea ship %e /eauth/(scot %ud %0) plea)
--
--
::
::TODO would be good to test with different ducts so we know they get
:: stored & re-used correctly
++ test-eauth-incoming
%- eval-mare
=/ m (mare ,~)
^- form:m
=, server:eauth
;< ~ bind:m (setup-for-eauth 'http://hoster.com')
:: eauth login attempt starts the flow: send a scry, set timeout timer
::
;< mos=(list move) bind:m start
;< now=@da bind:m get-now
;< ~ bind:m
%+ expect-moves mos
:~ (ex-keen now)
(ex-wait /eauth/expire/visitors/(scot %uv nonce) (add now ~m5))
==
:: ~sampel gets back to us with a url, we redirect the requester
::
;< mos=(list move) bind:m tune
;< ~ bind:m
%+ expect-moves mos
=/ loc=@t
%^ cat 3
'http://sampel.com/~/eauth?server=~nul&nonce='
(scot %uv nonce)
:~ (ex-response 303 ~['location'^loc g-head] ~)
==
:: requester approves, we get an %open plea, must give an %okay boon
::
;< mos=(list move) bind:m grant
;< ~ bind:m
%+ expect-moves mos
:~ ex-done
(ex-boon %0 %okay nonce 'http://hoster.com/~/eauth')
==
:: requester returns for the final request
::
;< mos=(list move) bind:m final
;< ~ bind:m
%+ expect-moves mos
:~ (ex-response 303 ~['location'^'/final' g-head] ~)
==
(pure:m ~)
::
++ test-eauth-incoming-bad-token
%- eval-mare
=/ m (mare ,~)
^- form:m
=, server:eauth
;< ~ bind:m (setup-for-eauth 'http://hoster.com')
;< * bind:m start
;< * bind:m tune
;< * bind:m grant
:: requester GETs a url with a non-matching token
::
;< mos=(list move) bind:m
=; url=@t (get url [g-auth]~)
(cat 3 '/~/eauth?token=0vbad&nonce=' (scot %uv nonce))
;< ~ bind:m
%+ expect-moves mos
=/ body `(eauth-error-page:eyre-gate %server '/final')
:~ (ex-response 400 ['content-type' 'text/html']~ body)
==
(pure:m ~)
::
++ test-eauth-incoming-expired
%- eval-mare
=/ m (mare ,~)
^- form:m
=, server:eauth
;< ~ bind:m (setup-for-eauth 'http://hoster.com')
;< * bind:m start
;< =time bind:m get-now
:: expiry timer fires, we serve a response and delete the attempt
::
;< ~ bind:m (wait ~m5)
;< mos=(list move) bind:m
=/ =^wire /eauth/expire/visitors/(scot %uv nonce)
(take wire ~[/http-blah] %behn %wake ~)
;< ~ bind:m
%+ expect-moves mos
=/ body `(eauth-error-page:eyre-gate %server '/final')
:~ (ex-yawn time)
(ex-response 503 ['content-type' 'text/html']~ body)
==
(pure:m ~)
::
++ test-eauth-incoming-aborted
%- eval-mare
=/ m (mare ,~)
^- form:m
=, server:eauth
;< ~ bind:m (setup-for-eauth 'http://hoster.com')
;< * bind:m start
;< * bind:m tune
:: visitor returns, saying the attempt was aborted. we delete it
::
;< mos=(list move) bind:m
=; url=@t (get url [g-auth]~)
(cat 3 '/~/eauth?abort&nonce=' (scot %uv nonce))
;< ~ bind:m
%+ expect-moves mos
=/ loc '/~/login?eauth&redirect=%2Ffinal'
:~ (ex-response 303 ~['location'^loc g-head] ~)
==
(pure:m ~)
::
++ test-eauth-incoming-aborted-with-duct
%- eval-mare
=/ m (mare ,~)
^- form:m
=, server:eauth
;< ~ bind:m (setup-for-eauth 'http://hoster.com')
;< * bind:m start
;< * bind:m tune
;< * bind:m grant
:: visitor returns, saying the attempt was aborted. we delete it
::
;< mos=(list move) bind:m
=; url=@t (get url [g-auth]~)
(cat 3 '/~/eauth?abort&nonce=' (scot %uv nonce))
;< ~ bind:m
%+ expect-moves mos
=/ loc '/~/login?eauth&redirect=%2Ffinal'
:~ (ex-response 303 ~['location'^loc g-head] ~)
(ex-boon %0 %shut nonce)
==
(pure:m ~)
::
++ test-eauth-incoming-delete
%- eval-mare
=/ m (mare ,~)
^- form:m
=, server:eauth
;< ~ bind:m (setup-for-eauth 'http://hoster.com')
;< * bind:m start
;< * bind:m tune
;< * bind:m grant
;< * bind:m final
:: visitor tells us they want the session deleted
::
;< mos=(list move) bind:m
%+ call ~[/http-blah]
[%plea ~sampel %e /eauth/0 %0 %shut nonce]
;< ~ bind:m
%+ expect-moves mos
:~ ex-done
(ex-boon %0 %shut nonce)
==
(pure:m ~)
::
++ test-eauth-outgoing
%- eval-mare
=/ m (mare ,~)
^- form:m
=, client:eauth
;< ~ bind:m (setup-for-eauth 'http://client.com')
:: visitor uses eauth page to approve a login attempt,
:: we send ~hoster the token and await its url
::
;< mos=(list move) bind:m grant
;< now=@da bind:m get-now
;< ~ bind:m
%+ expect-moves mos
:~ (ex-plea ~hoster %0 %open 0vnonce `0v4.qkgot.d07e3.pi1qd.m1bhj.ti8bo)
(ex-wait /eauth/expire/visiting/~hoster/0vnonce (add now ~m5))
==
:: upon receiving an %okay from ~hoster, redirect the user
::
;< mos=(list move) bind:m okay
;< ~ bind:m
%+ expect-moves mos
=/ loc=@t
'http://hoster.com/~/eauth?nonce=0vnonce&token=0v4.qkgot.d07e3.pi1qd.m1bhj.ti8bo'
:~ (ex-response 303 ~['location'^loc 'set-cookie'^cookie-string] ~)
==
(pure:m ~)
::
++ test-eauth-unauthenticated-approval
%- eval-mare
=/ m (mare ,~)
^- form:m
=, client:eauth
;< ~ bind:m (setup-for-eauth 'http://client.com')
:: visitor attempts to approve an eauth attempt without being authenticated
::
;< mos=(list move) bind:m
=/ body 'server=~hoster&nonce=0vnonce'
(post '/~/eauth' [g-auth]~ body)
:: eyre must not comply, instead redirect to login page
::
;< ~ bind:m
%+ expect-moves mos
:~ (ex-response 303 ~['location'^'/~/login?redirect=%2F~%2Feauth' g-head] ~)
==
(pure:m ~)
::
++ test-perform-init-start-channel
%- eval-mare
perform-init-start-channel-2