ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2025-01-01 19:46:36 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'develop' into i/6340/ames-packet-size

Browse Source
This commit is contained in:
tadad 2023-02-17 14:04:38 -06:00 committed by GitHub
commit a82548615e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
15 changed files with 1178 additions and 634 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkg/arvo/lib/desk-jam.hoon
View File

@ -3,8 +3,8 @@
++ jam-desk
|= [our=ship =desk now=@da]
~> %slog.0^leaf/"jamming desk {<desk>}"
=+ .^(=rang:clay %cx /(scot %p our)//(scot %da now))
=+ .^(=tako:clay %cs /(scot %p our)/[desk]/(scot %da now))
=+ .^(=rang:clay %cx /(scot %p our)//(scot %da now)/rang)
=+ .^(=tako:clay %cs /(scot %p our)/[desk]/(scot %da now)/tako/~)
%- jam
%- ?:(=(%base desk) remove-misc-dirs same)
%- ~(run by q:(~(got by hut.rang) tako))

7
pkg/arvo/lib/test/ames-gall.hoon
View File

@ -1,5 +1,5 @@
/+ *test, test-pub, test-sub
/= ames-raw /sys/vane/ames
/= ames-raw /sys/vane/ames
/= gall-raw /sys/vane/gall
::
=/ ames-bunt (ames-raw ~zod)
@ -187,7 +187,8 @@
++ load-agent
|= [=ship =gall-gate =dude:gall =agent:gall]
=^ * gall-gate
(gall-call gall-gate ~[/jolt] [%jolt %base dude] *roof)
%+ gall-call gall-gate
[~[/load] load/[[dude [ship %base da+~1111.1.1] agent]~] *roof]
=^ * gall-gate
=/ =sign-arvo
:+ %clay %writ
@ -195,7 +196,7 @@
%: gall-take
gall-gate
/sys/cor/[dude]/(scot %p ship)/base/(scot %da ~1111.1.1)
~[/jolt]
~[/load]
sign-arvo
*roof
==

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

@ -1315,6 +1315,9 @@
:: so we can apply configurations on a per-site basis
::
[%set-config =http-config]
:: sessions: valid authentication cookie strings
::
[%sessions ses=(set @t)]
:: response: response to an event from earth
::
[%response =http-event:http]

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

@ -964,8 +964,14 @@
%- mean %- flop
=/ lyn p.hair
=/ col q.hair
^- (list tank)
:~ leaf+"syntax error at [{<lyn>} {<col>}] in {<pax>}"
leaf+(trip (snag (dec lyn) (to-wain:format (crip tex))))
::
=/ =wain (to-wain:format (crip tex))
?: (gth lyn (lent wain))
'<<end of file>>'
(snag (dec lyn) wain)
::
leaf+(runt [(dec col) '-'] "^")
==
::

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

@ -958,6 +958,7 @@
(session-cookie-string session &)
::
=; out=[moves=(list move) server-state]
=. moves.out [give-session-tokens moves.out]
:: if we didn't have any cookies previously, start the expiry timer
::
?. first-session out
@ -1032,7 +1033,7 @@
?~ channels
=^ moz state
(handle-response response)
[(weld moves moz) state]
[[give-session-tokens (weld moves moz)] state]
=^ moz state
(discard-channel:by-channel i.channels |)
$(moves (weld moves moz), channels t.channels)
@ -2116,6 +2117,13 @@
(cury cat 3)
?~ ext.request-line ''
(cat 3 '.' u.ext.request-line)
:: +give-session-tokens: send valid session tokens to unix
::
++ give-session-tokens
^- move
:- outgoing-duct.state
=* ses sessions.authentication-state.state
[%give %sessions (~(run in ~(key by ses)) (cury scot %uv))]
--
::
++ forwarded-params
@ -2295,12 +2303,15 @@
=. outgoing-duct.server-state.ax duct
::
:_ http-server-gate
;: weld
:: hand back default configuration for now
:* :: hand back default configuration for now
::
[duct %give %set-config http-config.server-state.ax]
:: provide a list of valid auth tokens
::
=< give-session-tokens
(per-server-event [eny duct now rof] server-state.ax)
::
[duct %give %set-config http-config.server-state.ax]~
::
closed-connections
closed-connections
==
::
?: ?=(%code-changed -.task)
@ -2574,6 +2585,8 @@
::
^- [(list move) _http-server-gate]
:_ http-server-gate
:- =< give-session-tokens
(per-server-event [eny duct now rof] server-state.ax)
?: =(~ sessions) ~
=; next-expiry=@da
[duct %pass /sessions/expire %b %wait next-expiry]~

35
pkg/arvo/ted/eval.hoon Normal file
View File

@ -0,0 +1,35 @@
/- spider
/+ strandio
=, strand=strand:spider
=>
|%
+$ deps (list path)
+$ inpt $@(cord (pair cord deps))
--
^- thread:spider
|= raw=vase
=/ m (strand ,vase)
^- form:m
=+ !<(arg=(unit inpt) raw)
?~ arg
(strand-fail:strand %no-input ~)
?@ u.arg
?~ u.arg
(strand-fail:strand %no-command ~)
(eval-hoon:strandio (ream u.arg) ~)
?~ p.u.arg
(strand-fail:strand %no-command ~)
;< =beak bind:m get-beak:strandio
=/ paz=(list path) q.u.arg
=/ bez=(list beam) ~
|-
?~ paz
(eval-hoon:strandio (ream p.u.arg) bez)
=/ bem
%+ fall
(de-beam i.paz)
[beak i.paz]
;< has=? bind:m (check-for-file:strandio bem)
?. has
(strand-fail:strand %no-file >bem< ~)
$(paz t.paz, bez [bem bez])

64
pkg/arvo/ted/khan-eval.hoon Normal file
View File

@ -0,0 +1,64 @@
/- spider
/+ strandio
=, strand=strand:spider
=>
|%
+$ deps (list path)
+$ inpt $@(cord (pair cord deps))
--
^- thread:spider
|= raw=vase
=/ m (strand ,vase)
^- form:m
=+ !<(arg=(unit inpt) raw)
?~ arg
(strand-fail:strand %no-input ~)
=/ com
?@ u.arg
u.arg
p.u.arg
?~ com
(strand-fail:strand %no-command ~)
;< =beak bind:m get-beak:strandio
=/ paz=(list path)
?@ u.arg
~
q.u.arg
=/ bez=(list beam)
:~
[beak /sur/spider/hoon]
[beak /lib/strandio/hoon]
==
=/ =shed:khan
|-
?~ paz
;< vax=vase
bind:m
(eval-hoon:strandio (ream com) bez)
!<(shed:khan vax)
=/ bem
%+ fall
(de-beam i.paz)
[beak i.paz]
;< has=? bind:m (check-for-file:strandio bem)
?. has
(strand-fail:strand %no-file >bem< ~)
$(paz t.paz, bez [bem bez])
=/ wir /test/wire
:: TODO: if we're building the thread against user-provided dependencies, can
:: TODO: we always use the default beak here?
;< ~ bind:m (send-thread:strandio beak shed wir)
;< [wer=wire sig=sign-arvo] bind:m take-sign-arvo:strandio
?> =(wir wer)
?> ?=(%khan -.sig)
?> ?=(%arow +<.sig)
=/ vow ,.+>.sig
?- -.vow
%& (pure:m q.p.vow)
%| (strand-fail:strand %child-failed +.vow)
==
:: tests:
:: success
:: -khan-eval '=/ m (strand ,vase) ;< ~ bind:m (poke [~zod %hood] %helm-hi !>(\'\')) (pure:m !>(\'success\'))'
:: failure
:: -khan-eval '=/ m (strand ,vase) ;< vax=vase bind:m (eval-hoon [%zpzp ~] ~) (pure:m !>(\'success\'))'

55
pkg/base-dev/lib/mip.hoon Normal file
View File

@ -0,0 +1,55 @@
|%
++ mip :: map of maps
|$ [kex key value]
(map kex (map key value))
::
++ bi :: mip engine
=| a=(map * (map))
|@
++ del
|* [b=* c=*]
=+ d=(~(gut by a) b ~)
=+ e=(~(del by d) c)
?~ e
(~(del by a) b)
(~(put by a) b e)
::
++ get
|* [b=* c=*]
=> .(b `_?>(?=(^ a) p.n.a)`b, c `_?>(?=(^ a) ?>(?=(^ q.n.a) p.n.q.n.a))`c)
^- (unit _?>(?=(^ a) ?>(?=(^ q.n.a) q.n.q.n.a)))
(~(get by (~(gut by a) b ~)) c)
::
++ got
|* [b=* c=*]
(need (get b c))
::
++ gut
|* [b=* c=* d=*]
(~(gut by (~(gut by a) b ~)) c d)
::
++ has
|* [b=* c=*]
!=(~ (get b c))
::
++ key
|* b=*
~(key by (~(gut by a) b ~))
::
++ put
|* [b=* c=* d=*]
%+ ~(put by a) b
%. [c d]
%~ put by
(~(gut by a) b ~)
::
++ tap
::NOTE naive turn-based implementation find-errors ):
=< $
=+ b=`_?>(?=(^ a) *(list [x=_p.n.a _?>(?=(^ q.n.a) [y=p v=q]:n.q.n.a)]))`~
|. ^+ b
?~ a
b
$(a r.a, b (welp (turn ~(tap by q.n.a) (lead p.n.a)) $(a l.a)))
--
--

248
pkg/base-dev/lib/sss.hoon Normal file
View File

@ -0,0 +1,248 @@
/- *sss
/+ *mip
::
|%
++ mk-subs :: Create sub-map.
|* [=(lake) paths=mold]
-:+6:(da lake paths)
::
++ mk-pubs :: Create pub-map.
|* [=(lake) paths=mold]
-:+6:(du lake paths)
::
++ mk-mar :: Create mar.
|* =(lake)
|_ =(response:poke lake *)
++ grow
|%
++ noun response
--
++ grab
|%
++ noun (response:poke lake *)
--
++ grad %noun
--
++ fled :: Like +sped but head is a path.
|= vax=vase
^- vase
:_ q.vax
%- ~(play ut p.vax)
=- [%wtgr [%wtts - [%& 2]~] [%$ 1]]
=/ pax ~| %path-none ;;(path -.q.vax)
|- ^- spec
?~ pax [%base %null]
[%bccl ~[[%leaf %ta -.pax] $(pax +.pax)]]
::
++ zoom |= =noun ~| %need-path $/sss/;;(path noun)
::
++ da :: Manage subscriptions.
|* [=(lake) paths=mold]
=>
|%
+$ flow [=aeon fail=_| =rock:lake]
--
|_ [sub=(map [ship dude paths] flow) =bowl:gall result-type=type on-rock-type=type]
++ surf pine :: Subscribe to [ship dude path].
++ read :: See current subscribed states.
^- (map [ship dude paths] [fail=? rock:lake])
%- ~(run by sub)
|= =flow
[fail rock]:flow
:: :: Check poke-acks for errors.
:: :: If an %sss-on-rock poke nacks,
++ chit :: that state is flagged as failed.
|= [[aeon=term ship=term dude=term path=paths] =sign:agent:gall]
^+ sub
?> ?=(%poke-ack -.sign)
?~ p.sign sub
%+ ~(jab by sub) [(slav %p ship) dude path]
|= =flow
?> =(aeon.flow (slav %ud aeon))
flow(fail &)
:: :: Check if we're still interested
:: :: in a wave. If no, no-op.
:: :: If yes, scry.
++ behn :: (See https://gist.github.com/belisarius222/7f8452bfea9b199c0ed717ab1778f35b)
|= [ship=term =dude aeon=term path=paths]
^- (list card:agent:gall)
=/ ship (slav %p ship)
=/ aeon (slav %ud aeon)
?: (lte aeon aeon:(~(got by sub) ship dude path)) ~
~[(scry `aeon ship dude path)]
::
++ apply :: Handle response from publisher.
|= res=(response:poke lake paths)
^- (quip card:agent:gall _sub)
?- type.res
%yore
:_ sub :_ ~
(pine src.bowl dude.res path.res)
::
%nigh
:_ sub :_ ~
(behn-s25 [dude aeon path]:res)
::
%scry
=* current [src.bowl dude.res path.res]
=/ [wave=(unit wave:lake) =flow]
=/ old=flow (~(gut by sub) current *flow)
?- what.res
%rock ?> (gte aeon.res aeon.old)
`[aeon.res | rock.res]
%wave ~| [%weird-wave res=res old=old]
?> =(aeon.res +(aeon.old))
[`wave.res [aeon.res | (wash:lake rock.old wave.res)]]
==
:_ (~(put by sub) current flow)
%- flop
:~ (scry `+(aeon.res) src.bowl dude.res path.res)
:* %pass (zoom on-rock/(scot %ud aeon.flow)^(scot %p src.bowl)^dude.res^path.res)
%agent [our dap]:bowl
%poke %sss-on-rock on-rock-type ^- from
[path.res src.bowl dude.res rock.flow wave]
== ==
==
::
:: Non-public facing arms below
::
+$ from (on-rock:poke lake paths)
+$ into (response:poke lake paths)
+$ result (request:poke paths)
++ behn-s25
|= [=dude =aeon path=noun]
^- card:agent:gall
:* %pass (zoom behn/(scot %p src.bowl)^dude^(scot %ud aeon)^path)
%arvo %b %wait (add ~s25 now.bowl)
==
++ pine |= [ship dude paths] (scry ~ +<)
++ scry
|= [when=(unit aeon) who=ship which=dude where=paths]
^- card:agent:gall
=/ when ?~ when %~ (scot %ud u.when)
:* %pass (zoom request/scry/(scot %p who)^which^when^where)
%agent [who which]
%poke %sss-to-pub :- result-type ^- result
[where which ^when]
==
--
++ du :: Manage publications.
|* [=(lake) paths=mold]
=>
|%
+$ rule [rocks=_1 waves=_5] :: Retention policy
+$ tide
$: rok=((mop aeon rock:lake) gte)
wav=((mop aeon wave:lake) lte)
rul=rule
mem=(mip aeon [ship dude] @da)
==
--
|_ [pub=(map paths tide) =bowl:gall result-type=type]
+* rok ((on aeon rock:lake) gte)
wav ((on aeon wave:lake) lte)
::
++ rule :: Set new retention policy.
|= [path=paths =^rule]
^+ pub
%+ ~(jab by pub) path
|= =tide
(form tide(rul rule))
::
++ wipe :: Create new rock and wipe rest.
|= path=paths
^+ pub
%+ ~(jab by pub) path
|= =tide
%* . (form tide(rul [0 1]))
rul rul.tide
wav ~
==
++ give :: Give a wave on a path.
|= [path=paths =wave:lake]
^- (quip card:agent:gall _pub)
?~ ;;((soft ^path) path) ~| %need-path !!
=/ =tide (~(gut by pub) path *tide)
=/ next=aeon
.+ %+ max
(fall (bind (pry:rok rok.tide) head) 0)
(fall (bind (ram:wav wav.tide) head) 0)
::
:_ %+ ~(put by pub) path
=/ last=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
=. wav.tide (put:wav wav.tide next wave)
=. mem.tide (~(del by mem.tide) next)
?. =(next (add aeon.last waves.rul.tide)) tide
(form tide)
::
%+ murn ~(tap by (~(gut by mem.tide) next ~))
|= [[=ship =dude] =@da]
?: (lth da now.bowl) ~
`(send scry/wave/wave ship dude next path)
++ read :: See current published states.
^- (map paths rock:lake)
%- ~(run by pub)
|= =tide
=< rock
=/ snap=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
%+ roll (tap:wav (lot:wav wav.tide `aeon.snap ~))
|= [[=aeon =wave:lake] =_snap]
?. =(aeon +(aeon.snap)) snap
[aeon (wash:lake rock.snap wave)]
::
++ apply :: Handle request from subscriber.
|= req=(request:poke paths)
^- (quip card:agent:gall _pub)
=/ =tide (~(gut by pub) path.req *tide)
?~ when.req
=/ last (fall (pry:rok rok.tide) *[=key =val]:rok)
:_ pub :_ ~
(send scry/rock/val.last src.bowl dude.req key.last path.req)
?^ dat=(get:wav wav.tide u.when.req)
:_ pub :_ ~
(send scry/wave/u.dat src.bowl [dude u.when path]:req)
?. (gth u.when.req key::(fall (ram:wav wav.tide) [key=+(u.when.req) **]))
:_ pub :_ ~
(send yore/~ src.bowl [dude u.when path]:req)
:- ~[(send nigh/~ src.bowl [dude u.when path]:req)]
%+ ~(put by pub) path.req
%= tide mem
%^ ~(put bi mem.tide) u.when.req [src.bowl dude.req]
(add ~s25 now.bowl)
==
::
:: Non-public facing arms below
::
+$ into (request:poke paths)
+$ result (response:poke lake paths)
++ send
|= [payload=_|3:*(response:poke lake paths) =ship =dude =aeon path=paths]
^- card:agent:gall
=* mark (cat 3 %sss- name:lake)
:* %pass (zoom response/scry/(scot %p ship)^dude^(scot %ud aeon)^path)
%agent [ship dude]
%poke mark result-type ^- (response:poke lake paths)
[path dap.bowl aeon payload]
==
++ form
|= =tide
^+ tide
=/ max-rock=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
=/ max-wave (fall (bind (ram:wav wav.tide) head) 0)
=. rok.tide
%+ gas:rok +<-:gas:rok
%- tab:rok :_ [~ +(rocks.rul.tide)]
?: ?| =(waves.rul.tide 0)
(lth max-wave (add aeon.max-rock waves.rul.tide))
==
rok.tide
%+ put:rok rok.tide
%+ roll (tab:wav wav.tide `aeon.max-rock max-wave)
|: [*[now=aeon =wave:lake] `[prev=aeon =rock:lake]`max-rock]
~| %aeon-awry
?> =(now +(prev))
[now (wash:lake rock wave)]
~| %rock-zero
tide(wav (lot:wav wav.tide (bind (ram:rok rok.tide) |=([r=@ *] (dec r))) ~))
--
--

37
pkg/base-dev/lib/strandio.hoon
View File

@ -73,7 +73,9 @@
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
~
`[%wait ~]
::
[~ %poke @ *]
?. =(mark p.cage.u.in.tin)
`[%skip ~]
@ -87,7 +89,9 @@
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
~
`[%wait ~]
::
[~ %sign *]
`[%done [wire sign-arvo]:u.in.tin]
==
@ -473,6 +477,18 @@
(pure:m ~)
?> =(%vase p.r.u.riot)
(pure:m (some !<(vase q.r.u.riot)))
::
++ build-file-hard
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay
bind:m
(warp ship desk ~ %sing %a case spur)
?> ?=(^ riot)
?> ?=(%vase p.r.u.riot)
(pure:m !<(vase q.r.u.riot))
:: +build-mark: build a mark definition to a $dais
::
++ build-mark
@ -585,6 +601,23 @@
(poke [who %hood] %helm-hi !>(~))
(pure:m ~)
::
++ eval-hoon
|= [gen=hoon bez=(list beam)]
=/ m (strand ,vase)
^- form:m
=/ sut=vase !>(..zuse)
|-
?~ bez
(pure:m (slap sut gen))
;< vax=vase bind:m (build-file-hard i.bez)
$(bez t.bez, sut (slop vax sut))
::
++ send-thread
|= [=bear:khan =shed:khan =wire]
=/ m (strand ,~)
^- form:m
(send-raw-card %pass wire %arvo %k %lard bear shed)
::
:: Queue on skip, try next on fail %ignore
::
++ main-loop

36
pkg/base-dev/sur/sss.hoon Normal file
View File

@ -0,0 +1,36 @@
|%
++ lake
|$ [rock wave]
$_ ^?
|%
++ name *term
+$ rock ^rock
+$ wave ^wave
++ wash |~ [rock wave] *rock
--
+$ aeon @ud
+$ dude dude:agent:gall
+$ what ?(%rock %wave)
++ poke
|%
++ request
|* paths=mold
$: path=paths
=dude
when=(unit aeon)
==
++ response
|* [=(lake) paths=mold]
$: path=paths
=dude
=aeon
$% [type=?(%nigh %yore) ~]
$: type=%scry
$% [what=%rock =rock:lake]
[what=%wave =wave:lake]
== == == ==
++ on-rock
|* [=(lake) paths=mold]
,[path=paths src=ship from=dude =rock:lake wave=(unit wave:lake)]
--
--

5
pkg/landscape/app/group-store.hoon
View File

@ -154,6 +154,7 @@
%noun
?+ q.vase !!
%migrate poke-migrate:gc
%migrate-my-channels poke-migrate-my-channels:gc
%export poke-export:gc
%rebuild poke-rebuild:gc
==
@ -302,6 +303,10 @@
(turn ~(tap in wait) watch-init-migrate)
=/ cards (welp cards-1 cards-2)
[cards state(wait wait)]
++ poke-migrate-my-channels
^- (quip card _state)
=/ [cards=(list card) *] (~(migrate-my-channels gladio bol) ~)
[cards state]
::
++ watch-init-migrate
|= =ship

94
pkg/landscape/lib/gladio.hoon
View File

@ -4,6 +4,7 @@
/- grp=group-store
/- i=migrate
/- *group
/+ res=resource
|_ =bowl:gall
+$ card card:agent:gall
:: if false, indicates that OTA should be done in one go, in order to
@ -54,15 +55,12 @@
?~ group=(~(get by groups) group.u.assoc)
~& missing-group/[flag group.u.assoc]
~
?: hidden.u.group
~
=/ writers=(set ship)
(~(get ju tags.u.group) %graph flag %writers)
?~ log=(~(get by update-logs.network) flag)
~& missing-log/flag :: XX: doesn't need to fail, but suspect case
~
`[flag writers u.assoc u.log graph]
++ scry
|= [=dude:gall =path]
%- welp
@ -78,6 +76,21 @@
.^(* (scry %graph-store /export/noun))
++ associations
~+ .^([@ =associations:met ~] (scry %metadata-store /export/noun))
++ my-channels-associations
=/ assoc
.^(associations:met %gx [(scot %p our.bowl) %metadata-store (scot %da now.bowl) %associations %noun ~])
%- ~(gas by *associations:met)
%+ skim
~(tap by assoc)
|= [m=md-resource:met [g=resource:res metdat=metadatum:met]]
?+ config.metdat %.n
[%graph @]
?& =(| hidden.metdat)
=(name.g name.resource.m)
=(entity.g our.bowl)
!=(%chat module.config.metdat)
==
==
++ associations-raw
.^(* (scry %metadata-store /export/noun))
++ export
@ -163,7 +176,78 @@
:_ ~
(welp setup (zing (turn ~(tap in (~(del in ships) our.bowl)) migrate-ship)))
[setup (~(uni in ships) wait)]
::
++ migrate-my-channels
|= wait=(set ship)
^- (quip card (set ship))
=+ network
=+ groups
=+ associations
=/ =flag:i [our.bowl %my-channels]
=/ ships (peers network)
=/ import (import-for-mark `our.bowl groups my-channels-associations network)
=/ chats=imports:graph:i
(import %graph-validator-chat)
=/ diarys=imports:graph:i
(import %graph-validator-publish)
=/ links=imports:graph:i
(import %graph-validator-link)
=| assoc=association:met
=/ hoops=imports:groups:i
%- ~(gas by *imports:groups:i)
%+ murn ~(tap by groups)
|= [=flag:i =group]
^- (unit [_flag import:groups:i])
=/ nass=(unit association:met)
?^ (~(get by associations) [%groups flag]) ~
`assoc(hidden.metadatum |, title.metadatum 'My Channels', creator.metadatum p.flag, group [our.bowl %my-channels])
?~ nass ~
=/ chans=(map flag:i association:met)
%- ~(gas by *(map flag:i association:met))
%+ murn ~(tap by associations)
|= [res=md-resource:met ass=association:met]
^- (unit [flag:i association:met])
?. =(group.ass flag) ~
?. =(entity.group.ass our.bowl) ~
`[resource.res ass]
=/ roles=(set flag:i)
%- ~(gas in *(set flag:i))
%+ murn ~(tap by chans)
|= [=flag:i =association:met]
^- (unit flag:i)
?. =(group.association flag) ~
?. =(entity.group.association our.bowl) ~
?^ link=(~(get by links) flag)
?: =(writers.u.link ~) ~
`flag
?^ diary=(~(get by links) flag)
?: =(writers.u.diary ~) ~
`flag
?^ chat=(~(get by chats) flag)
?: =(writers.u.chat ~) ~
`flag
~
?~ chans ~
`[flag u.nass chans roles group]
=/ bigport=import:groups:i
%+ roll ~(val by hoops)
|= [port=import:groups:i newport=import:groups:i]
^- import:groups:i
:: they should have the same association and group already
:* association.port
(~(uni by chans.port) chans.newport)
(~(uni by roles.port) roles.newport)
group.port
==
?~ chans.bigport
[~ ~]
=/ mychan-import=imports:groups:i
(~(put by *imports:groups:i) [our.bowl %my-channels] bigport)
:_ ~
:~ (poke-our %groups group-import+!>(mychan-import))
(poke-our %chat graph-imports+!>(chats))
(poke-our %heap graph-imports+!>(links))
(poke-our %diary graph-imports+!>(diarys))
==
++ migrate-ship
|= her=ship
^- (list card)
@ -189,5 +273,5 @@
:~ (poke-our %chat graph-imports+!>(chats))
(poke-our %diary graph-imports+!>(diarys))
(poke-our %heap graph-imports+!>(links))
==
==
--

1020
tests/sys/grq.hoon
View File

File diff suppressed because it is too large Load Diff

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

@ -7,27 +7,14 @@
::
|%
++ test-init
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
::
results1
-:perform-init
::
++ test-born
-:(perform-born eyre-gate)
::
++ test-overwrite-bindings
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: app1 binds successfully
::
=^ results2 eyre-gate
@ -57,14 +44,7 @@
::
++ test-remove-binding
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: app1 binds successfully
::
=^ results2 eyre-gate
@ -130,14 +110,7 @@
::
++ test-builtin-four-oh-four
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: when there's no configuration and nothing matches, expect 404
::
=^ results2 eyre-gate
@ -173,14 +146,7 @@
::
++ test-basic-app-request
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: app1 binds successfully
::
=^ results2 eyre-gate
@ -266,14 +232,7 @@
::
++ test-app-error
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: app1 binds successfully
::
=^ results2 eyre-gate
@ -369,14 +328,7 @@
::
++ test-multipart-app-request
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: app1 binds successfully
::
=^ results2 eyre-gate
@ -484,17 +436,11 @@
::
++ test-login-handler-full-path
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
=^ results2 eyre-gate (perform-born eyre-gate)
:: app1 binds successfully
::
=^ results2 eyre-gate
=^ results3 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.2
@ -504,7 +450,7 @@
==
:: outside requests a path that app1 has bound to
::
=^ results3 eyre-gate
=^ results4 eyre-gate
%- eyre-call-with-comparator :*
eyre-gate
now=~1111.1.3
@ -550,7 +496,7 @@
==
:: app then gives a redirect to Eyre
::
=^ results4 eyre-gate
=^ results5 eyre-gate
%- eyre-take :*
eyre-gate
now=~1111.1.4
@ -569,7 +515,7 @@
== == ==
:: the browser then fetches the login page
::
=^ results5 eyre-gate
=^ results6 eyre-gate
%- perform-authentication :*
eyre-gate
now=~1111.1.5
@ -577,7 +523,7 @@
==
:: going back to the original url will acknowledge the authentication cookie
::
=^ results6 eyre-gate
=^ results7 eyre-gate
%- eyre-call-with-comparator :*
eyre-gate
now=~1111.1.5..1.0.0
@ -644,18 +590,12 @@
results4
results5
results6
results7
==
::
++ test-generator
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: gen1 binds successfully
::
=^ results2 eyre-gate
@ -783,14 +723,7 @@
::
++ test-channel-reject-unauthenticated
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
::
=^ results2 eyre-gate
%- eyre-call :*
@ -1873,14 +1806,7 @@
::
++ test-born-sends-pending-cancels
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
:: app1 binds successfully
::
=^ results2 eyre-gate
@ -1951,15 +1877,15 @@
|= moves=(list move:eyre-gate)
^- tang
::
?. ?=([^ ^ ~] moves)
?. ?=([^ ^ ^ ~] moves)
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
:: we don't care about the first one, which is just a static
:: configuration move.
:: we don't care about the first two, which are just
:: configuration moves.
::
=/ move=move:eyre-gate i.t.moves
=/ =duct duct.move
=/ card=(wind note:eyre-gate gift:eyre-gate) card.move
=/ =move:eyre-gate i.t.t.moves
=/ =duct duct.move
=/ card card.move
::
%+ weld
(expect-eq !>(~[/http-blah]) !>(duct))
@ -2126,6 +2052,30 @@
:: todo: handle other deals
::
[%leaf "unexpected %deal type"]~
:: +perfom-init: %init a new eyre-gate
::
++ perform-init
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
:: +perform-born: %born an eyre-gate
::
++ perform-born
|= =_eyre-gate
%- eyre-call :*
eyre-gate
new=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/unix] ~ [%born ~]]
^= expected-moves
:~ [duct=~[/unix] %give %set-config *http-config:eyre]
[duct=~[/unix] %give %sessions ~]
==
==
:: +perform-authentication: goes through the authentication flow
::
++ perform-authentication
@ -2185,6 +2135,9 @@
:~ ::NOTE this ~d7 is tied to the eyre-internal +session-timeout...
:- duct=~[/http-blah]
[%pass p=/sessions/expire q=[%b [%wait p=(add start-now ~d7.m1)]]]
::
=+ token='0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea'
[duct=~[/unix] %give %sessions [token ~ ~]]
::
:* duct=~[/http-blah]
%give
@ -2209,17 +2162,11 @@
==
^- [tang _eyre-gate]
::
=^ results1 eyre-gate
%- eyre-call :*
eyre-gate
now=~1111.1.1
scry=scry-provides-code
call-args=[duct=~[/init] ~ [%init ~]]
expected-moves=~
==
=^ results1 eyre-gate perform-init
=^ results2 eyre-gate (perform-born eyre-gate)
:: ensure there's an authenticated session
::
=^ results2 eyre-gate
=^ results3 eyre-gate
%- perform-authentication :*
eyre-gate
now=~1111.1.2
@ -2227,7 +2174,7 @@
==
:: send the channel a poke and a subscription request
::
=^ results3 eyre-gate
=^ results4 eyre-gate
%- eyre-call-with-comparator :*
eyre-gate
now=~1111.1.2
@ -2293,7 +2240,7 @@
== ==
::
:_ eyre-gate
:(weld results1 results2 results3)
:(weld results1 results2 results3 results4)
::
++ scry-provides-code ^- roof
|= [gang =view =beam]