mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-18 04:11:49 +03:00
~wicrum-wicrun
GitHub
commit
9b636eb188
1
.github/workflows/feature.yml
vendored
1
.github/workflows/feature.yml
vendored
@ -29,4 +29,5 @@ jobs:
|
||||
${{
|
||||
(github.ref_name == 'next/vere' && github.ref_type == 'branch')
|
||||
}}
|
||||
next: ${{ github.base_ref }}
|
||||
secrets: inherit
|
||||
|
||||
2
.github/workflows/next.yml
vendored
2
.github/workflows/next.yml
vendored
@ -27,5 +27,5 @@ jobs:
|
||||
uses: ./.github/workflows/shared.yml
|
||||
with:
|
||||
upload: true
|
||||
next: ${{ github.ref | replace('refs/heads/next/kelvin/', '') }}
|
||||
next: ${{ github.ref_name }}
|
||||
secrets: inherit
|
||||
|
||||
10
.github/workflows/shared.yml
vendored
10
.github/workflows/shared.yml
vendored
@ -15,7 +15,7 @@ on:
|
||||
default: 'edge'
|
||||
required: false
|
||||
next:
|
||||
description: 'next kelvin version'
|
||||
description: 'next kelvin version branch name'
|
||||
type: string
|
||||
default: null
|
||||
required: false
|
||||
@ -78,8 +78,12 @@ jobs:
|
||||
name: run urbit-tests
|
||||
run: |
|
||||
cp -RL tests pkg/arvo/tests
|
||||
if ${{ inputs.next != null }}; then
|
||||
base="https://bootstrap.urbit.org/vere/next/kelvin/${{ inputs.next }}"
|
||||
if [[ "${{ inputs.next }}" == "next/kelvin/"* ]]; then
|
||||
next=$(echo ${{ inputs.next }} | sed 's/[^0-9]//g')
|
||||
base="https://bootstrap.urbit.org/vere/next/kelvin/${next}"
|
||||
elif [[ "${{ github.head_ref }}" == "next/kelvin"* ]]; then
|
||||
next=$(echo ${{ github.head_ref }} | sed 's/[^0-9]//g')
|
||||
base="https://bootstrap.urbit.org/vere/next/kelvin/${next}"
|
||||
else
|
||||
base="https://bootstrap.urbit.org/vere/${{ inputs.pace }}"
|
||||
fi
|
||||
|
||||
@ -47,6 +47,7 @@
|
||||
event-log=(list unix-timed-event)
|
||||
next-events=(qeu unix-event)
|
||||
processing-events=?
|
||||
namespace=(map path (list yowl:ames))
|
||||
==
|
||||
--
|
||||
::
|
||||
@ -224,6 +225,16 @@
|
||||
::
|
||||
:: Peek
|
||||
::
|
||||
++ peek-once
|
||||
|= [=view =desk =spur]
|
||||
=/ res (mox +22.snap)
|
||||
?> ?=(%0 -.res)
|
||||
=/ peek p.res
|
||||
=/ pek (slum peek [[~ ~] %| %once view desk spur])
|
||||
=+ ;;(res=(unit (cask [path (cask)])) pek)
|
||||
::NOTE it's an %omen, so we unpack a little bit deeper
|
||||
(bind res (cork tail (cork tail tail)))
|
||||
::
|
||||
++ peek
|
||||
|= p=*
|
||||
=/ res (mox +22.snap)
|
||||
@ -649,6 +660,37 @@
|
||||
=. this thus
|
||||
(publish-effect:(pe who) [/ %restore ~])
|
||||
(pe ~bud) :: XX why ~bud? need an example
|
||||
::
|
||||
%read
|
||||
?~ pier=(~(get by ships.piers) from.ae)
|
||||
(pe from.ae)
|
||||
=/ cash (~(get by namespace.u.pier) path.ae)
|
||||
|-
|
||||
?^ cash
|
||||
?: (gth num.ae (lent u.cash))
|
||||
(pe from.ae)
|
||||
::TODO depends on /ted/aqua/ames behavior in a weird indirect way
|
||||
=/ for=@p `@`(tail for.ae) ::NOTE moons & comets not supported
|
||||
=; task=task-arvo
|
||||
^$(ae [%event for /a/aqua/fine-response task], thus this)
|
||||
:+ %hear `lane:ames`[%| `@`from.ae]
|
||||
^- blob:ames
|
||||
=/ =shot:ames
|
||||
::NOTE dec is important! so dumb!!
|
||||
(sift-shot:ames `@`(snag (dec num.ae) u.cash))
|
||||
::TODO runtime needs to update rcvr field also
|
||||
::NOTE rcvr life is allowed to be wrong
|
||||
(etch-shot:ames shot(sndr from.ae, rcvr for))
|
||||
=/ pacs=(unit (list yowl:ames))
|
||||
%+ biff
|
||||
(peek-once:(pe from.ae) %ax %$ [%fine %message path.ae])
|
||||
(soft (list yowl:ames))
|
||||
?~ pacs (pe from.ae)
|
||||
=. namespace.u.pier
|
||||
(~(put by namespace.u.pier) path.ae u.pacs)
|
||||
=. ships.piers
|
||||
(~(put by ships.piers) from.ae u.pier)
|
||||
$(cash pacs, thus this)
|
||||
::
|
||||
%event
|
||||
~? &(aqua-debug=| !?=(?(%belt %hear) -.q.ue.ae))
|
||||
|
||||
@ -263,7 +263,7 @@
|
||||
:: ~& >> %no-logs-in-azimuth-state
|
||||
number.id.sap.state
|
||||
=+ [our=(scot %p our.bowl) now=(scot %da now.bowl)]
|
||||
=+ .^(dudes=(set [dude:gall ?]) %ge our %base now /)
|
||||
=+ .^(dudes=(set [dude:gall ?]) %ge our %base now /$)
|
||||
=/ running=? (~(has in dudes) [%eth-watcher &])
|
||||
=/ installed=?
|
||||
|((~(has in dudes) [%eth-watcher &]) (~(has in dudes) [%eth-watcher |]))
|
||||
@ -445,8 +445,8 @@
|
||||
=/ =pass
|
||||
(pass-from-eth:azimuth [32^crypt 32^auth suite]:keys.net)
|
||||
^- (list [@p udiff:point])
|
||||
:* [ship id %rift rift.net %.y]
|
||||
[ship id %keys [life.keys.net suite.keys.net pass] %.y]
|
||||
:* [ship id %keys [life.keys.net suite.keys.net pass] %.y]
|
||||
[ship id %rift rift.net %.y]
|
||||
[ship id %spon ?:(has.sponsor.net `who.sponsor.net ~)]
|
||||
udiffs
|
||||
==
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
::
|
||||
|%
|
||||
+$ state-0 [%0 passcode=(unit @t)]
|
||||
+$ card card:agent:gall
|
||||
+$ card card:agent:gall
|
||||
--
|
||||
::
|
||||
=| state-0
|
||||
@ -433,7 +433,7 @@
|
||||
^- (list dude:gall)
|
||||
=- (turn ~(tap in -) head)
|
||||
;; (set [dude:gall ?]) ::TODO for some reason we need this?
|
||||
(scry (set [dude:gall ?]) %ge desk /)
|
||||
(scry (set [dude:gall ?]) %ge desk /$)
|
||||
::
|
||||
++ running
|
||||
|= app=term
|
||||
@ -524,6 +524,7 @@
|
||||
:~ 'messages'^(numb (lent messages))
|
||||
'packets'^(numb ~(wyt in packets))
|
||||
'heeds'^(set-array heeds from-duct)
|
||||
'keens'^(set-array ~(key by keens) path)
|
||||
==
|
||||
::
|
||||
:: json for known peer is structured to closely match the peer-state type.
|
||||
@ -585,6 +586,45 @@
|
||||
:: message-num: 123
|
||||
:: }, ...],
|
||||
:: heeds: [['/paths', ...] ...]
|
||||
:: scries:
|
||||
:: -> { =path
|
||||
:: keen-state: {
|
||||
:: wan: [ //request packets, sent
|
||||
:: { frag: 1234,
|
||||
:: size: 1234, // size, in bytes
|
||||
:: last-sent: 123456, // ms timestamp
|
||||
:: retries: 123,
|
||||
:: skips: 123
|
||||
:: }, ...
|
||||
:: ],
|
||||
:: nex: [ // request packets, unsent
|
||||
:: { frag: 1234,
|
||||
:: size: 1234, // size, in bytes
|
||||
:: last-sent: 123456, // ms timestamp
|
||||
:: retries: 123,
|
||||
:: skips: 123
|
||||
:: }, ...
|
||||
:: ],
|
||||
:: hav: [ // response packets, backward
|
||||
:: {fra: 1234,
|
||||
:: meow: { num: 1234, size: 1234}
|
||||
:: }, ...
|
||||
:: ],
|
||||
:: num-fragments: 1234,
|
||||
:: num-received: 1234,
|
||||
:: next-wake: 123456, // ms timestamp
|
||||
:: listeners: [['/paths', ...] ...],
|
||||
:: metrics: {
|
||||
:: rto: 123, // seconds
|
||||
:: rtt: 123, // seconds
|
||||
:: rttvar: 123,
|
||||
:: ssthresh: 123,
|
||||
:: num-live: 123,
|
||||
:: cwnd: 123,
|
||||
:: counter: 123
|
||||
:: }
|
||||
:: }
|
||||
:: }
|
||||
:: }
|
||||
::
|
||||
++ known
|
||||
@ -668,6 +708,8 @@
|
||||
==
|
||||
::
|
||||
'heeds'^(set-array heeds from-duct)
|
||||
::
|
||||
'scries'^(scries ~(tap by keens))
|
||||
==
|
||||
::
|
||||
++ snd-with-bone
|
||||
@ -705,7 +747,7 @@
|
||||
'fragment-num'^(numb fragment-num)
|
||||
'num-fragments'^(numb num-fragments)
|
||||
'last-sent'^(time last-sent)
|
||||
'retries'^(numb retries)
|
||||
'tries'^(numb tries)
|
||||
'skips'^(numb skips)
|
||||
==
|
||||
::
|
||||
@ -773,6 +815,65 @@
|
||||
++ from-duct
|
||||
|= =duct
|
||||
a+(turn duct path)
|
||||
::
|
||||
++ scries
|
||||
|= keens=(list [^path keen-state])
|
||||
^- json
|
||||
:- %a
|
||||
%+ turn keens
|
||||
|= [=^path keen=keen-state]
|
||||
%- pairs
|
||||
:~ 'scry-path'^(^path path)
|
||||
'keen-state'^(parse-keens keen)
|
||||
==
|
||||
::
|
||||
++ parse-keens
|
||||
|= keen-state
|
||||
|^ ^- json
|
||||
%- pairs
|
||||
:~ 'wan'^a/(turn (tap:(deq want) wan) wants)
|
||||
'nex'^a/(turn nex wants)
|
||||
::
|
||||
:- 'hav'
|
||||
:- %a
|
||||
%+ turn hav
|
||||
|= [fra=@ud meow]
|
||||
%- pairs
|
||||
:~ 'fra'^(numb fra)
|
||||
::
|
||||
:- 'meow'
|
||||
%- pairs
|
||||
:~ 'num'^(numb num)
|
||||
'size'^(numb (met 3 dat))
|
||||
== ==
|
||||
::
|
||||
'num-fragments'^(numb num-fragments)
|
||||
'num-received'^(numb num-received)
|
||||
'next-wake'^(maybe next-wake time)
|
||||
'listeners'^(set-array listeners from-duct)
|
||||
::
|
||||
:: XX refactor (see metric in snd-with-bone)
|
||||
:- 'metrics'
|
||||
%- pairs
|
||||
=, metrics
|
||||
:~ 'rto'^(numb (div rto ~s1)) ::TODO milliseconds?
|
||||
'rtt'^(numb (div rtt ~s1))
|
||||
'rttvar'^(numb (div rttvar ~s1))
|
||||
'ssthresh'^(numb ssthresh)
|
||||
'cwnd'^(numb cwnd)
|
||||
'counter'^(numb counter)
|
||||
== ==
|
||||
::
|
||||
++ wants
|
||||
|= [fra=@ud =hoot packet-state]
|
||||
%- pairs
|
||||
:~ 'frag'^(numb fra)
|
||||
'size'^(numb (met 3 hoot))
|
||||
'last-sent'^(time last-sent)
|
||||
'tries'^(numb tries)
|
||||
'skips'^(numb skips)
|
||||
==
|
||||
--
|
||||
--
|
||||
--
|
||||
::
|
||||
|
||||
File diff suppressed because one or more lines are too long
@ -129,7 +129,7 @@
|
||||
=/ =desk
|
||||
::TODO maybe should recognize if the user specified a desk explicitly.
|
||||
:: currently eats the :app|desk#gen case.
|
||||
=+ gop=(en-beam dir(q q.gol, s /))
|
||||
=+ gop=(en-beam dir(q q.gol, s /$))
|
||||
?. .^(? %gu gop)
|
||||
q.dir
|
||||
.^(desk %gd gop)
|
||||
@ -378,7 +378,7 @@
|
||||
^+ +>+>
|
||||
?> ?=(~ pux)
|
||||
%- he-card(poy `+>+<(pux `way))
|
||||
=/ [=ship =desk =case:clay] beak
|
||||
=/ [=ship =desk =case] beak
|
||||
[%pass way %arvo %c %warp ship desk ~ %sing care case path]
|
||||
::
|
||||
++ dy-request
|
||||
@ -399,7 +399,7 @@
|
||||
:: really shoud stop the thread as well
|
||||
::
|
||||
[%pass u.pux %agent [our.hid %spider] %leave ~]
|
||||
=/ [=ship =desk =case:clay] he-beak
|
||||
=/ [=ship =desk =case] he-beak
|
||||
[%pass u.pux %arvo %c %warp ship desk ~]
|
||||
::
|
||||
++ dy-errd :: reject change, abet
|
||||
|
||||
@ -15,6 +15,7 @@
|
||||
running=(axal thread-form)
|
||||
tid=(map tid yarn)
|
||||
serving=(map tid [(unit @ta) =mark =desk])
|
||||
scries=(map tid [=ship =path])
|
||||
==
|
||||
::
|
||||
+$ clean-slate-any
|
||||
@ -23,10 +24,20 @@
|
||||
clean-slate-1
|
||||
clean-slate-2
|
||||
clean-slate-3
|
||||
clean-slate-4
|
||||
clean-slate
|
||||
==
|
||||
::
|
||||
+$ clean-slate
|
||||
$: %5
|
||||
starting=(map yarn [=trying =vase])
|
||||
running=(list yarn)
|
||||
tid=(map tid yarn)
|
||||
serving=(map tid [(unit @ta) =mark =desk])
|
||||
scries=(map tid [ship path])
|
||||
==
|
||||
::
|
||||
+$ clean-slate-4
|
||||
$: %4
|
||||
starting=(map yarn [=trying =vase])
|
||||
running=(list yarn)
|
||||
@ -98,7 +109,8 @@
|
||||
(old-to-2 any)
|
||||
=. any (old-to-3 any)
|
||||
=. any (old-to-4 any)
|
||||
?> ?=(%4 -.any)
|
||||
=. any (old-to-5 any)
|
||||
?> ?=(%5 -.any)
|
||||
::
|
||||
=. tid.state tid.any
|
||||
=/ yarns=(list yarn)
|
||||
@ -121,8 +133,8 @@
|
||||
++ old-to-2
|
||||
|= old=clean-slate-any
|
||||
^- (quip card clean-slate-any)
|
||||
?> ?=(?(%1 %2 %3 %4) -.old)
|
||||
?: ?=(?(%2 %3 %4) -.old)
|
||||
?> ?=(?(%1 %2 %3 %4 %5) -.old)
|
||||
?: ?=(?(%2 %3 %4 %5) -.old)
|
||||
`old
|
||||
:- ~[bind-eyre:sc]
|
||||
:* %2
|
||||
@ -135,8 +147,8 @@
|
||||
++ old-to-3
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate-any
|
||||
?> ?=(?(%2 %3 %4) -.old)
|
||||
?: ?=(?(%3 %4) -.old)
|
||||
?> ?=(?(%2 %3 %4 %5) -.old)
|
||||
?: ?=(?(%3 %4 %5) -.old)
|
||||
old
|
||||
:* %3
|
||||
starting.old
|
||||
@ -146,9 +158,9 @@
|
||||
==
|
||||
++ old-to-4
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate
|
||||
?> ?=(?(%3 %4) -.old)
|
||||
?: ?=(%4 -.old)
|
||||
^- clean-slate-any
|
||||
?> ?=(?(%3 %4 %5) -.old)
|
||||
?: ?=(?(%4 %5) -.old)
|
||||
old
|
||||
:* %4
|
||||
starting.old
|
||||
@ -156,6 +168,13 @@
|
||||
tid.old
|
||||
(~(run by serving.old) |=([id=@ta =mark =desk] [`id mark q.byk.bowl]))
|
||||
==
|
||||
::
|
||||
++ old-to-5
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate
|
||||
?> ?=(?(%4 %5) -.old)
|
||||
?: ?=(%5 -.old) old
|
||||
[%5 +.old(serving [serving.old ~])]
|
||||
--
|
||||
::
|
||||
++ on-poke
|
||||
@ -400,9 +419,11 @@
|
||||
~& %stopping-nonexistent-thread
|
||||
[~ state]
|
||||
?: (~(has of running.state) u.yarn)
|
||||
?: nice
|
||||
(thread-done u.yarn *vase)
|
||||
(thread-fail u.yarn %cancelled ~)
|
||||
?. nice
|
||||
(thread-fail u.yarn %cancelled ~)
|
||||
=^ cancel-cards state (cancel-scry tid &)
|
||||
=^ done-cards state (thread-done u.yarn *vase)
|
||||
[(weld cancel-cards done-cards) state]
|
||||
?: (~(has by starting.state) u.yarn)
|
||||
(thread-fail-not-running tid %stopped-before-started ~)
|
||||
~& [%thread-not-started u.yarn]
|
||||
@ -432,9 +453,14 @@
|
||||
==
|
||||
=. running.state (~(put of running.state) yarn eval-form)
|
||||
=/ =tid (yarn-to-tid yarn)
|
||||
=. cards.r
|
||||
%+ turn cards.r
|
||||
|= =card
|
||||
=^ new-cards state
|
||||
^- [(list card) _state]
|
||||
%+ roll cards.r
|
||||
|= [=card cards=(list card) s=_state]
|
||||
:_ =? scries.s ?=([%pass ^ %arvo %a %keen @ *] card)
|
||||
(~(put by scries.s) tid &6.card +>+>+>.card)
|
||||
s
|
||||
:_ cards
|
||||
^- ^card
|
||||
?+ card card
|
||||
[%pass * *] [%pass [%thread tid p.card] q.card]
|
||||
@ -445,7 +471,7 @@
|
||||
^- ^path
|
||||
[%thread tid path]
|
||||
==
|
||||
=. cards (weld cards cards.r)
|
||||
=. cards (weld cards (flop new-cards))
|
||||
=^ final-cards=(list card) state
|
||||
?- -.eval-result.r
|
||||
%next `state
|
||||
@ -470,6 +496,17 @@
|
||||
:~ [%give %fact ~[/thread-result/[tid]] %thread-fail !>([term tang])]
|
||||
[%give %kick ~[/thread-result/[tid]] ~]
|
||||
==
|
||||
::
|
||||
++ cancel-scry
|
||||
|= [=tid silent=?]
|
||||
^- (quip card _state)
|
||||
?~ scry=(~(get by scries.state) tid)
|
||||
`state
|
||||
:_ state(scries (~(del by scries.state) tid))
|
||||
?: silent ~
|
||||
%- (slog leaf+"cancelling {<tid>}: [{<[ship path]:u.scry>}]" ~)
|
||||
[%pass /thread/[tid]/keen %arvo %a %yawn [ship path]:u.scry]~
|
||||
::
|
||||
++ thread-http-fail
|
||||
|= [=tid =term =tang]
|
||||
^- (quip card ^state)
|
||||
@ -500,7 +537,9 @@
|
||||
=/ fail-cards (thread-say-fail tid term tang)
|
||||
=^ cards state (thread-clean yarn)
|
||||
=^ http-cards state (thread-http-fail tid term tang)
|
||||
[:(weld fail-cards cards http-cards) state]
|
||||
=^ scry-card state (cancel-scry tid |)
|
||||
:_ state
|
||||
:(weld fail-cards cards http-cards scry-card)
|
||||
::
|
||||
++ thread-http-response
|
||||
|= [=tid =vase]
|
||||
@ -527,8 +566,9 @@
|
||||
==
|
||||
=^ http-cards state
|
||||
(thread-http-response tid vase)
|
||||
=^ scry-card state (cancel-scry tid &)
|
||||
=^ cards state (thread-clean yarn)
|
||||
[:(weld done-cards cards http-cards) state]
|
||||
[:(weld done-cards cards http-cards scry-card) state]
|
||||
::
|
||||
++ thread-clean
|
||||
|= =yarn
|
||||
@ -546,7 +586,6 @@
|
||||
=/ =^yarn i.children
|
||||
=/ =tid (yarn-to-tid yarn)
|
||||
=: running.state (~(lop of running.state) yarn)
|
||||
|
||||
tid.state (~(del by tid.state) tid)
|
||||
serving.state (~(del by serving.state) (yarn-to-tid yarn))
|
||||
==
|
||||
@ -601,7 +640,7 @@
|
||||
::
|
||||
++ clean-state
|
||||
!> ^- clean-slate
|
||||
4+state(running (turn ~(tap of running.state) head))
|
||||
5+state(running (turn ~(tap of running.state) head))
|
||||
::
|
||||
++ convert-tube
|
||||
|= [from=mark to=mark =desk =bowl:gall]
|
||||
|
||||
@ -6,5 +6,5 @@
|
||||
^- (list [dude:gall @ud])
|
||||
%+ sort
|
||||
%~ tap by
|
||||
.^((map dude:gall @ud) %gf /(scot %p p.bec)//(scot %da now))
|
||||
.^((map dude:gall @ud) %gf /(scot %p p.bec)//(scot %da now)/$)
|
||||
|=([[* a=@ud] [* b=@ud]] (lth a b))
|
||||
|
||||
@ -9,7 +9,6 @@
|
||||
::::
|
||||
::
|
||||
=, generators
|
||||
=, html
|
||||
=, format
|
||||
:- %ask
|
||||
|= $: [now=@da eny=@uvJ bec=beak]
|
||||
@ -23,7 +22,7 @@
|
||||
(fun.q.q jon.arg)
|
||||
%+ prompt
|
||||
[%& %oauth-json "json credentials: "]
|
||||
%+ parse apex:de-json
|
||||
%+ parse apex:de:json:html
|
||||
|= jon=json
|
||||
=+ ~| bad-json+jon
|
||||
=- `[cid=@t cis=@t]`(need (rep jon))
|
||||
|
||||
6
pkg/arvo/gen/hood/keen.hoon
Normal file
6
pkg/arvo/gen/hood/keen.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
:- %say
|
||||
|= [^ [=ship pax=$@(~ [path ~])] ~]
|
||||
=/ =path
|
||||
?^ pax -.pax
|
||||
/c/x/1/kids/sys/kelvin
|
||||
[%helm-pass %a %keen ship path]
|
||||
9
pkg/arvo/gen/hood/wham.hoon
Normal file
9
pkg/arvo/gen/hood/wham.hoon
Normal file
@ -0,0 +1,9 @@
|
||||
:- %say
|
||||
|= [^ [=ship pax=$@(~ [=path ~])] ~]
|
||||
=/ =path
|
||||
:: XX remove default path
|
||||
?~ pax /c/x/1/kids/sys/kelvin
|
||||
?> ?=([@ *] path.pax)
|
||||
=, pax
|
||||
path
|
||||
[%helm-pass %a %wham ship path]
|
||||
9
pkg/arvo/gen/hood/yawn.hoon
Normal file
9
pkg/arvo/gen/hood/yawn.hoon
Normal file
@ -0,0 +1,9 @@
|
||||
:- %say
|
||||
|= [^ [=ship pax=$@(~ [=path ~])] ~]
|
||||
=/ =path
|
||||
:: XX remove default path
|
||||
?~ pax /c/x/1/kids/sys/kelvin
|
||||
?> ?=([@ *] path.pax)
|
||||
=, pax
|
||||
path
|
||||
[%helm-pass %a %yawn ship path]
|
||||
@ -100,7 +100,7 @@
|
||||
::
|
||||
:: only forward flows
|
||||
::
|
||||
=? pags &(=(0 (end 0 bone)) (gth retries 10))
|
||||
=? pags &(=(0 (end 0 bone)) (gth tries 10))
|
||||
?~ duct=(~(get by by-bone.ossuary.peer-state) bone)
|
||||
pags
|
||||
?. ?=([* [%gall %use sub=@ @ %out @ @ nonce=@ pub=@ *] *] u.duct)
|
||||
@ -108,13 +108,13 @@
|
||||
=/ =wire i.t.u.duct
|
||||
(~(add ja pags) (snag 2 wire) (snag 8 wire) ship (slag 9 wire))
|
||||
::
|
||||
~? &(=(%2 veb) (gth retries 10))
|
||||
~? &(=(%2 veb) (gth tries 10))
|
||||
=+ arrow=?:(=(0 (end 0 bone)) "<-" "->")
|
||||
=+ closing=(~(has in closing.peer-state) bone)
|
||||
%+ weld "{arrow} ({(cite:title ship)}) bone=#{<bone>} "
|
||||
"closing={<closing>} msg=#{<msg>} frag=#{<frag>} #{<retries>}"
|
||||
"closing={<closing>} msg=#{<msg>} frag=#{<frag>} #{<tries>}"
|
||||
:- pags
|
||||
=? out (gth retries 10)
|
||||
=? out (gth tries 10)
|
||||
?: =(0 (end 0 bone))
|
||||
[b.out +(f.out)]
|
||||
[+(b.out) f.out]
|
||||
|
||||
@ -7,6 +7,15 @@
|
||||
:: basic helpers
|
||||
::
|
||||
|%
|
||||
++ crypto-core
|
||||
|% ++ nec (pit:nu:crub:crypto 512 (shaz 'nec'))
|
||||
++ bud (pit:nu:crub:crypto 512 (shaz 'bud'))
|
||||
++ sign
|
||||
|= [=ship data=@ux]
|
||||
%. data
|
||||
?:(=(ship ~nec) sigh:as:nec sigh:as:bud)
|
||||
--
|
||||
::
|
||||
++ make-gall
|
||||
|= =ship
|
||||
=/ gall-pupa (gall-raw ship)
|
||||
@ -15,24 +24,27 @@
|
||||
adult
|
||||
::
|
||||
++ ames-nec-bud
|
||||
|= [life=[nec=@ud bud=@ud] rift=[nec=@ud bud=@ud]]
|
||||
:: create ~nec
|
||||
::
|
||||
=/ nec (ames-raw ~nec)
|
||||
=. now.nec ~1111.1.1
|
||||
=. eny.nec 0xdead.beef
|
||||
=. life.ames-state.nec 2
|
||||
=. now.nec ~1111.1.1
|
||||
=. eny.nec 0xdead.beef
|
||||
=. life.ames-state.nec nec.life
|
||||
=. rift.ames-state.nec nec.rift
|
||||
=. rof.nec |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.nec (pit:nu:crub:crypto 512 (shaz 'nec'))
|
||||
=. crypto-core.ames-state.nec nec:crypto-core
|
||||
=/ nec-pub pub:ex:crypto-core.ames-state.nec
|
||||
=/ nec-sec sec:ex:crypto-core.ames-state.nec
|
||||
:: create ~bud
|
||||
::
|
||||
=/ bud (ames-raw ~bud)
|
||||
=. now.bud ~1111.1.1
|
||||
=. eny.bud 0xbeef.dead
|
||||
=. life.ames-state.bud 3
|
||||
=. now.bud ~1111.1.1
|
||||
=. eny.bud 0xbeef.dead
|
||||
=. life.ames-state.bud bud.life
|
||||
=. rift.ames-state.bud bud.rift
|
||||
=. rof.bud |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.bud (pit:nu:crub:crypto 512 (shaz 'bud'))
|
||||
=. crypto-core.ames-state.bud bud:crypto-core
|
||||
=/ bud-pub pub:ex:crypto-core.ames-state.bud
|
||||
=/ bud-sec sec:ex:crypto-core.ames-state.bud
|
||||
::
|
||||
@ -46,8 +58,8 @@
|
||||
=| =peer-state:ames
|
||||
=. -.peer-state
|
||||
:* symmetric-key=bud-sym
|
||||
life=3
|
||||
rift=0
|
||||
life=bud.life
|
||||
rift=bud.rift
|
||||
public-key=bud-pub
|
||||
sponsor=~bud
|
||||
==
|
||||
@ -60,8 +72,8 @@
|
||||
=| =peer-state:ames
|
||||
=. -.peer-state
|
||||
:* symmetric-key=nec-sym
|
||||
life=2
|
||||
rift=0
|
||||
life=nec.life
|
||||
rift=nec.rift
|
||||
public-key=nec-pub
|
||||
sponsor=~nec
|
||||
==
|
||||
@ -76,7 +88,7 @@
|
||||
--
|
||||
:: forward-declare to avoid repeated metamorphoses
|
||||
=/ gall-adult (make-gall ~zod)
|
||||
=/ ames-adult nec:ames-nec-bud
|
||||
=/ ames-adult nec:(ames-nec-bud [1 1] [0 0])
|
||||
:: main core
|
||||
::
|
||||
|%
|
||||
@ -84,7 +96,8 @@
|
||||
+$ ames-gate _ames-adult
|
||||
::
|
||||
++ nec-bud
|
||||
=/ a ames-nec-bud
|
||||
|= [life=[nec=@ud bud=@ud] rift=[nec=@ud bud=@ud]]
|
||||
=/ a (ames-nec-bud [nec bud]:life [nec bud]:rift)
|
||||
=/ gall-nec (make-gall ~nec)
|
||||
=. gall-nec (load-agent ~nec gall-nec %sub test-sub)
|
||||
=/ gall-bud (make-gall ~bud)
|
||||
@ -156,6 +169,37 @@
|
||||
=^ moves ames-gate (take:ames-core wire duct dud=~ sign)
|
||||
[(expect-eq !>(expected-moves) !>(moves)) ames-gate]
|
||||
::
|
||||
++ ames-scry-hunk
|
||||
|= $: =ames-gate
|
||||
[now=@da eny=@ =roof]
|
||||
our=ship
|
||||
[lop=@ud len=@ud pax=path]
|
||||
==
|
||||
^- [sig=@ux meows=(list @ux)]
|
||||
=/ =beam
|
||||
:- [our %$ da+now]
|
||||
(welp /fine/hunk/[(scot %ud lop)]/[(scot %ud len)] pax)
|
||||
=+ pat=(spat pax)
|
||||
=+ wid=(met 3 pat)
|
||||
?> (lte wid 384)
|
||||
=/ meows
|
||||
!< (list @ux)
|
||||
=< q
|
||||
%- need %- need
|
||||
(scry:(ames-gate now eny roof) ~ %x beam)
|
||||
::
|
||||
=/ paz=(list have:ames)
|
||||
%+ spun meows
|
||||
|= [blob=@ux num=_1]
|
||||
^- [have:ames _num]
|
||||
:_ +(num)
|
||||
[num (sift-meow:ames blob)]
|
||||
::
|
||||
:- sig:(sift-roar:ames-raw (lent paz) (flop paz))
|
||||
%+ turn meows
|
||||
|= meow=@ux
|
||||
(can 3 4^lop 2^wid wid^`@`pat (met 3 meow)^meow ~)
|
||||
:: ::
|
||||
++ ames-scry-peer
|
||||
|= $: =ames-gate
|
||||
[now=@da eny=@ =roof]
|
||||
@ -182,7 +226,7 @@
|
||||
=< q
|
||||
%- need %- need
|
||||
%- scry:(gall-gate now eny roof)
|
||||
[~ %n [[our dude da+now] [(scot %p ship.sub) [term wire]:sub]]]
|
||||
[~ %n [[our dude da+now] [%$ (scot %p ship.sub) [term wire]:sub]]]
|
||||
::
|
||||
++ load-agent
|
||||
|= [=ship =gall-gate =dude:gall =agent:gall]
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
|_ mud=@
|
||||
++ grow
|
||||
|%
|
||||
++ mime [/application/octet-stream (as-octs mud)]
|
||||
++ mime [/application/x-urb-jam (as-octs mud)]
|
||||
--
|
||||
++ grab
|
||||
|% :: convert from
|
||||
|
||||
@ -1 +1 @@
|
||||
[%zuse 414]
|
||||
[%zuse 413]
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
|%
|
||||
+| %global
|
||||
::
|
||||
++ arvo %239
|
||||
++ arvo %238
|
||||
::
|
||||
:: $arch: node identity
|
||||
:: $axal: fundamental node, recursive (trie)
|
||||
@ -20,7 +20,7 @@
|
||||
:: $mark: symbolic content type
|
||||
:: $mien: orientation
|
||||
:: $page: untyped cage
|
||||
:: +omen: namespace path and data
|
||||
:: $omen: fully-qualified namespace path
|
||||
:: $ship: network identity
|
||||
:: $sink: subscription
|
||||
::
|
||||
@ -39,10 +39,12 @@
|
||||
$% :: %da: date
|
||||
:: %tas: label
|
||||
:: %ud: sequence
|
||||
:: %uv: hash
|
||||
::
|
||||
[%da p=@da]
|
||||
[%tas p=@tas]
|
||||
[%ud p=@ud]
|
||||
[%uv p=@uv]
|
||||
==
|
||||
+$ cage (cask vase)
|
||||
++ cask |$ [a] (pair mark a)
|
||||
@ -52,7 +54,7 @@
|
||||
+$ mark @tas
|
||||
+$ mien [our=ship now=@da eny=@uvJ]
|
||||
+$ page (cask)
|
||||
++ omen |$ [a] (pair path (cask a))
|
||||
+$ omen [vis=view bem=beam]
|
||||
+$ ship @p
|
||||
+$ sink (trel bone ship path)
|
||||
::
|
||||
@ -109,18 +111,17 @@
|
||||
|$ [a]
|
||||
$~ =>(~ |~(* ~))
|
||||
$- $: lyc=gang :: leakset
|
||||
vis=view :: perspective
|
||||
bem=beam :: path
|
||||
omen :: perspective, path
|
||||
== ::
|
||||
%- unit :: ~: unknown
|
||||
%- unit :: ~ ~: invalid
|
||||
(cask a)
|
||||
(cask a) ::
|
||||
+$ roon :: partial namespace
|
||||
$~ =>(~ |~(* ~))
|
||||
$- [lyc=gang car=term bem=beam]
|
||||
(unit (unit cage))
|
||||
+$ root $-(^ (unit (unit)))
|
||||
+$ view $@(term [way=term car=term])
|
||||
+$ view $@(term [way=term car=term]) :: perspective
|
||||
::
|
||||
++ wind
|
||||
|$ :: a: forward
|
||||
@ -206,9 +207,9 @@
|
||||
==
|
||||
+$ heir
|
||||
$% $: %grub
|
||||
$% [_arvo =grub]
|
||||
$% [?(%240 %239 %238) =grub]
|
||||
== ==
|
||||
[_arvo =debt =soul]
|
||||
[?(%240 %239 %238) =debt =soul]
|
||||
==
|
||||
+$ plan (pair germ (list move))
|
||||
+$ soul
|
||||
@ -313,11 +314,12 @@
|
||||
^- (unit case)
|
||||
?^ num=(slaw %ud knot) `[%ud u.num]
|
||||
?^ wen=(slaw %da knot) `[%da u.wen]
|
||||
?^ hax=(slaw %uv knot) `[%uv u.hax]
|
||||
?~ lab=(slaw %tas knot) ~
|
||||
`[%tas u.lab]
|
||||
::
|
||||
++ en-omen
|
||||
|= [vis=view bem=beam]
|
||||
|= omen
|
||||
^- path
|
||||
:_ (en-beam bem)
|
||||
?@ vis vis
|
||||
@ -326,7 +328,7 @@
|
||||
++ de-omen
|
||||
~/ %de-omen
|
||||
|= pax=path
|
||||
^- (unit [vis=view bem=beam])
|
||||
^- (unit omen)
|
||||
?~ pax ~
|
||||
?~ bem=(de-beam t.pax) ~
|
||||
?: ((sane %tas) i.pax)
|
||||
@ -1043,7 +1045,8 @@
|
||||
:: |va: vane engine
|
||||
::
|
||||
++ va
|
||||
=> |%
|
||||
=> ~% %va-ctx ..va ~
|
||||
|%
|
||||
+$ vane-sample [now=@da eny=@uvJ rof=rook]
|
||||
::
|
||||
++ smit
|
||||
@ -1056,12 +1059,14 @@
|
||||
(slap sub (rain pax txt))
|
||||
::
|
||||
++ create
|
||||
~/ %create
|
||||
|= [our=ship zus=vase lal=term pax=path txt=@t]
|
||||
^- vase
|
||||
=/ cap "vane: %{(trip lal)}"
|
||||
(slym (smit cap zus pax txt) our)
|
||||
::
|
||||
++ settle
|
||||
~/ %settle
|
||||
|= van=vase
|
||||
^- (pair vase worm)
|
||||
=| sac=worm
|
||||
@ -1073,6 +1078,7 @@
|
||||
:: XX pass identity to preserve behavior?
|
||||
::
|
||||
++ update
|
||||
~/ %update
|
||||
|= [las=vase nex=vase]
|
||||
^- vase
|
||||
=/ sam=vase (slap (slym las *vane-sample) [%limb %stay])
|
||||
@ -1086,13 +1092,16 @@
|
||||
:: |plow:va: operate in time and space
|
||||
::
|
||||
++ plow
|
||||
~/ %plow
|
||||
|= [now=@da rok=rook]
|
||||
~% %plow-core + ~
|
||||
|%
|
||||
:: +peek:plow:va: read from a local namespace
|
||||
::
|
||||
++ peek
|
||||
~/ %peek
|
||||
^- rook
|
||||
|= [lyc=gang vis=view bem=beam]
|
||||
|= [lyc=gang omen]
|
||||
^- (unit (unit (cask meta)))
|
||||
:: namespace reads receive no entropy
|
||||
::
|
||||
@ -1360,11 +1369,11 @@
|
||||
::
|
||||
%+ turn
|
||||
(sort ~(tap by van.mod) |=([[a=@tas *] [b=@tas *]] (aor a b)))
|
||||
=/ bem=beam [[our %base da+now] /whey] ::TODO %base?
|
||||
=/ bem=beam [[our %$ da+now] //whey]
|
||||
|= [nam=term =vane]
|
||||
=; mas=(list mass)
|
||||
nam^|+(welp mas [dot+&+q.vase typ+&+p.vase sac+&+worm ~]:vane)
|
||||
?~ met=(peek [~ ~] nam bem) ~
|
||||
?~ met=(peek [~ ~] [nam %x] bem) ~
|
||||
?~ u.met ~
|
||||
~| mass+nam
|
||||
;;((list mass) q.q.u.u.met)
|
||||
@ -1372,7 +1381,7 @@
|
||||
::
|
||||
++ peek
|
||||
^- rook
|
||||
|= [lyc=gang vis=view bem=beam]
|
||||
|= [lyc=gang omen]
|
||||
^- (unit (unit (cask meta)))
|
||||
:: vane and care may be concatenated
|
||||
::
|
||||
@ -1728,7 +1737,6 @@
|
||||
%c %clay
|
||||
%d %dill
|
||||
%e %eyre
|
||||
%f %ford
|
||||
%g %gall
|
||||
%i %iris
|
||||
%j %jael
|
||||
@ -1756,7 +1764,7 @@
|
||||
::
|
||||
=. sol
|
||||
?- -.hir
|
||||
_arvo soul.hir
|
||||
?(%240 %239 %238) soul.hir
|
||||
==
|
||||
:: clear compiler caches
|
||||
::
|
||||
@ -1785,11 +1793,11 @@
|
||||
$= nom
|
||||
%+ each path
|
||||
$% [%once vis=view syd=desk tyl=spur]
|
||||
[%beam vis=view bem=beam]
|
||||
[%beam omen] :: XX unfortunate naming
|
||||
==
|
||||
==
|
||||
^- (unit (cask))
|
||||
=/ hap=(unit [pat=? vis=view bem=beam])
|
||||
=/ hap=(unit [pat=? omen])
|
||||
?- nom
|
||||
[%& *] ?~(mon=(de-omen p.nom) ~ `[| u.mon])
|
||||
[%| %beam *] `[| vis bem]:p.nom
|
||||
|
||||
@ -1869,7 +1869,6 @@
|
||||
?~ a b
|
||||
[i=i.a t=$(a t.a)]
|
||||
--
|
||||
::
|
||||
:: 2n: functional hacks
|
||||
+| %functional-hacks
|
||||
::
|
||||
@ -2035,12 +2034,28 @@
|
||||
+$ knot @ta :: ASCII text
|
||||
+$ noun * :: any noun
|
||||
+$ path (list knot) :: like unix path
|
||||
+$ pith (list iota) :: typed urbit path
|
||||
+$ stud :: standard name
|
||||
$@ mark=@tas :: auth=urbit
|
||||
$: auth=@tas :: standards authority
|
||||
type=path :: standard label
|
||||
== ::
|
||||
+$ tang (list tank) :: bottom-first error
|
||||
:: ::
|
||||
+$ iota :: typed path segment
|
||||
$~ [%n ~]
|
||||
$@ @tas
|
||||
$% [%ub @ub] [%uc @uc] [%ud @ud] [%ui @ui]
|
||||
[%ux @ux] [%uv @uv] [%uw @uw]
|
||||
[%sb @sb] [%sc @sc] [%sd @sd] [%si @si]
|
||||
[%sx @sx] [%sv @sv] [%sw @sw]
|
||||
[%da @da] [%dr @dr]
|
||||
[%f ?] [%n ~]
|
||||
[%if @if] [%is @is]
|
||||
[%t @t] [%ta @ta] :: @tas
|
||||
[%p @p] [%q @q]
|
||||
[%rs @rs] [%rd @rd] [%rh @rh] [%rq @rq]
|
||||
==
|
||||
::
|
||||
:: $tank: formatted print tree
|
||||
::
|
||||
@ -5895,6 +5910,39 @@
|
||||
~
|
||||
;~(pfix fas (most fas urs:ab))
|
||||
::
|
||||
++ stip :: typed path parser
|
||||
=< swot
|
||||
|%
|
||||
++ swot |=(n=nail (;~(pfix fas (more fas spot)) n))
|
||||
::
|
||||
++ spot
|
||||
%+ sear (soft iota)
|
||||
%- stew
|
||||
^. stet ^. limo
|
||||
:~ :- 'a'^'z' (stag %tas sym)
|
||||
:- '$' (cold [%tas %$] buc)
|
||||
:- '0'^'9' bisk:so
|
||||
:- '-' tash:so
|
||||
:- '.' zust:so
|
||||
:- '~' ;~(pfix sig ;~(pose crub:so (easy [%n ~])))
|
||||
:- '\'' (stag %t qut)
|
||||
==
|
||||
--
|
||||
::
|
||||
++ pout
|
||||
|= =pith
|
||||
^- path
|
||||
%+ turn pith
|
||||
|= i=iota
|
||||
?@(i i (scot i))
|
||||
::
|
||||
++ pave
|
||||
|= =path
|
||||
^- pith
|
||||
%+ turn path
|
||||
|= i=@ta
|
||||
(fall (rush i spot:stip) [%ta i])
|
||||
::
|
||||
:: 4n: virtualization
|
||||
+| %virtualization
|
||||
::
|
||||
@ -11695,6 +11743,45 @@
|
||||
(stag %clsg poor)
|
||||
==
|
||||
::
|
||||
++ reed
|
||||
;~ pfix fas
|
||||
(stag %clsg (more fas stem))
|
||||
==
|
||||
::
|
||||
++ stem
|
||||
%+ knee *hoon |. ~+
|
||||
%+ cook
|
||||
|= iota=$%([%hoon =hoon] iota)
|
||||
?@ iota [%rock %tas iota]
|
||||
?: ?=(%hoon -.iota) hoon.iota
|
||||
[%clhp [%rock %tas -.iota] [%sand iota]]
|
||||
|^ %- stew
|
||||
^. stet ^. limo
|
||||
:~ :- 'a'^'z' ;~ pose
|
||||
(spit (stag %cncl (ifix [pal par] (most ace wide))))
|
||||
(spit (ifix [sel ser] wide))
|
||||
(slot sym)
|
||||
==
|
||||
:- '$' (cold %$ buc)
|
||||
:- '0'^'9' (slot bisk:so)
|
||||
:- '-' (slot tash:so)
|
||||
:- '.' ;~(pfix dot zust:so)
|
||||
:- '~' (slot ;~(pfix sig ;~(pose crub:so (easy [%n ~]))))
|
||||
:- '\'' (stag %t qut)
|
||||
:- '[' (slip (ifix [sel ser] wide))
|
||||
:- '(' (slip (stag %cncl (ifix [pal par] (most ace wide))))
|
||||
==
|
||||
::
|
||||
++ slip |*(r=rule (stag %hoon r))
|
||||
++ slot |*(r=rule (sear (soft iota) r))
|
||||
++ spit
|
||||
|* r=rule
|
||||
%+ stag %hoon
|
||||
%+ cook
|
||||
|*([a=term b=*] `hoon`[%clhp [%rock %tas a] b])
|
||||
;~((glue lus) sym r)
|
||||
--
|
||||
::
|
||||
++ rupl
|
||||
%+ cook
|
||||
|= [a=? b=(list hoon) c=?]
|
||||
@ -12941,6 +13028,8 @@
|
||||
(ifix [gal gar] (stag %tell (most ace wide)))
|
||||
:- '>'
|
||||
(ifix [gar gal] (stag %yell (most ace wide)))
|
||||
:- '#'
|
||||
;~(pfix hax reed)
|
||||
==
|
||||
++ soil
|
||||
;~ pose
|
||||
@ -13021,6 +13110,68 @@
|
||||
(rune col %cncl exqz)
|
||||
==
|
||||
==
|
||||
:- '#'
|
||||
;~ pfix hax fas
|
||||
%+ stag %bccl
|
||||
%+ cook
|
||||
|= [[i=spec t=(list spec)] e=spec]
|
||||
[i (snoc t e)]
|
||||
;~ plug
|
||||
%+ most ;~(less ;~(plug fas tar) fas)
|
||||
%- stew
|
||||
^. stet ^. limo
|
||||
:~ :- ['a' 'z']
|
||||
;~ pose
|
||||
:: /name=@aura
|
||||
::
|
||||
%+ cook
|
||||
|= [=term =aura]
|
||||
^- spec
|
||||
:+ %bccl
|
||||
[%leaf %tas aura]
|
||||
:_ ~
|
||||
:+ %bcts term
|
||||
?+ aura [%base %atom aura]
|
||||
%f [%base %flag]
|
||||
%n [%base %null]
|
||||
==
|
||||
;~(plug sym ;~(pfix tis pat mota))
|
||||
::
|
||||
:: /constant
|
||||
::
|
||||
(stag %leaf (stag %tas ;~(pose sym (cold %$ buc))))
|
||||
==
|
||||
::
|
||||
:: /@aura
|
||||
::
|
||||
:- '@'
|
||||
%+ cook
|
||||
|= =aura
|
||||
^- spec
|
||||
:+ %bccl
|
||||
[%leaf %tas aura]
|
||||
[%base %atom aura]~
|
||||
;~(pfix pat mota)
|
||||
::
|
||||
:: /?
|
||||
::
|
||||
:- '?'
|
||||
(cold [%bccl [%leaf %tas %f] [%base %flag] ~] wut)
|
||||
::
|
||||
:: /~
|
||||
::
|
||||
:- '~'
|
||||
(cold [%bccl [%leaf %tas %n] [%base %null] ~] sig)
|
||||
==
|
||||
::
|
||||
:: open-ended or fixed-length
|
||||
::
|
||||
;~ pose
|
||||
(cold [%base %noun] ;~(plug fas tar))
|
||||
(easy %base %null)
|
||||
==
|
||||
==
|
||||
==
|
||||
==
|
||||
++ expression
|
||||
%- stew
|
||||
|
||||
@ -2,8 +2,9 @@
|
||||
:: %lull: arvo structures
|
||||
!:
|
||||
=> ..part
|
||||
~% %lull ..part ~
|
||||
|%
|
||||
++ lull %325
|
||||
++ lull %324
|
||||
:: :: ::
|
||||
:::: :: :: (1) models
|
||||
:: :: ::
|
||||
@ -36,6 +37,432 @@
|
||||
depth=_1
|
||||
==
|
||||
::
|
||||
:: +afx: polymorphic node type for finger trees
|
||||
::
|
||||
++ afx
|
||||
|$ [val]
|
||||
$% [%1 p=val ~]
|
||||
[%2 p=val q=val ~]
|
||||
[%3 p=val q=val r=val ~]
|
||||
[%4 p=val q=val r=val s=val ~]
|
||||
==
|
||||
::
|
||||
:: +pha: finger tree
|
||||
::
|
||||
++ pha
|
||||
|$ [val]
|
||||
$~ [%nul ~]
|
||||
$% [%nul ~]
|
||||
[%one p=val]
|
||||
[%big p=(afx val) q=(pha val) r=(afx val)]
|
||||
==
|
||||
::
|
||||
:: +mop: constructs and validates ordered ordered map based on key,
|
||||
:: val, and comparator gate
|
||||
::
|
||||
++ mop
|
||||
|* [key=mold value=mold]
|
||||
|= ord=$-([key key] ?)
|
||||
|= a=*
|
||||
=/ b ;;((tree [key=key val=value]) a)
|
||||
?> (apt:((on key value) ord) b)
|
||||
b
|
||||
::
|
||||
::
|
||||
++ ordered-map on
|
||||
:: +on: treap with user-specified horizontal order, ordered-map
|
||||
::
|
||||
:: WARNING: ordered-map will not work properly if two keys can be
|
||||
:: unequal under noun equality but equal via the compare gate
|
||||
::
|
||||
++ on
|
||||
~% %on ..part ~
|
||||
|* [key=mold val=mold]
|
||||
=> |%
|
||||
+$ item [key=key val=val]
|
||||
--
|
||||
:: +compare: item comparator for horizontal order
|
||||
::
|
||||
~% %comp +>+ ~
|
||||
|= compare=$-([key key] ?)
|
||||
~% %core + ~
|
||||
|%
|
||||
:: +all: apply logical AND boolean test on all values
|
||||
::
|
||||
++ all
|
||||
~/ %all
|
||||
|= [a=(tree item) b=$-(item ?)]
|
||||
^- ?
|
||||
|-
|
||||
?~ a
|
||||
&
|
||||
?&((b n.a) $(a l.a) $(a r.a))
|
||||
:: +any: apply logical OR boolean test on all values
|
||||
::
|
||||
++ any
|
||||
~/ %any
|
||||
|= [a=(tree item) b=$-(item ?)]
|
||||
|- ^- ?
|
||||
?~ a
|
||||
|
|
||||
?|((b n.a) $(a l.a) $(a r.a))
|
||||
:: +apt: verify horizontal and vertical orderings
|
||||
::
|
||||
++ apt
|
||||
~/ %apt
|
||||
|= a=(tree item)
|
||||
=| [l=(unit key) r=(unit key)]
|
||||
|- ^- ?
|
||||
:: empty tree is valid
|
||||
::
|
||||
?~ a %.y
|
||||
:: nonempty trees must maintain several criteria
|
||||
::
|
||||
?& :: if .n.a is left of .u.l, assert horizontal comparator
|
||||
::
|
||||
?~(l %.y (compare key.n.a u.l))
|
||||
:: if .n.a is right of .u.r, assert horizontal comparator
|
||||
::
|
||||
?~(r %.y (compare u.r key.n.a))
|
||||
:: if .a is not leftmost element, assert vertical order between
|
||||
:: .l.a and .n.a and recurse to the left with .n.a as right
|
||||
:: neighbor
|
||||
::
|
||||
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
||||
:: if .a is not rightmost element, assert vertical order
|
||||
:: between .r.a and .n.a and recurse to the right with .n.a as
|
||||
:: left neighbor
|
||||
::
|
||||
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
||||
==
|
||||
:: +bap: convert to list, right to left
|
||||
::
|
||||
++ bap
|
||||
~/ %bap
|
||||
|= a=(tree item)
|
||||
^- (list item)
|
||||
=| b=(list item)
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a r.a, b [n.a $(a l.a)])
|
||||
:: +del: delete .key from .a if it exists, producing value iff deleted
|
||||
::
|
||||
++ del
|
||||
~/ %del
|
||||
|= [a=(tree item) =key]
|
||||
^- [(unit val) (tree item)]
|
||||
?~ a [~ ~]
|
||||
:: we found .key at the root; delete and rebalance
|
||||
::
|
||||
?: =(key key.n.a)
|
||||
[`val.n.a (nip a)]
|
||||
:: recurse left or right to find .key
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=+ [found lef]=$(a l.a)
|
||||
[found a(l lef)]
|
||||
=+ [found rig]=$(a r.a)
|
||||
[found a(r rig)]
|
||||
:: +dip: stateful partial inorder traversal
|
||||
::
|
||||
:: Mutates .state on each run of .f. Starts at .start key, or if
|
||||
:: .start is ~, starts at the head. Stops when .f produces .stop=%.y.
|
||||
:: Traverses from left to right keys.
|
||||
:: Each run of .f can replace an item's value or delete the item.
|
||||
::
|
||||
++ dip
|
||||
~/ %dip
|
||||
|* state=mold
|
||||
|= $: a=(tree item)
|
||||
=state
|
||||
f=$-([state item] [(unit val) ? state])
|
||||
==
|
||||
^+ [state a]
|
||||
:: acc: accumulator
|
||||
::
|
||||
:: .stop: set to %.y by .f when done traversing
|
||||
:: .state: threaded through each run of .f and produced by +abet
|
||||
::
|
||||
=/ acc [stop=`?`%.n state=state]
|
||||
=< abet =< main
|
||||
|%
|
||||
++ this .
|
||||
++ abet [state.acc a]
|
||||
:: +main: main recursive loop; performs a partial inorder traversal
|
||||
::
|
||||
++ main
|
||||
^+ this
|
||||
:: stop if empty or we've been told to stop
|
||||
::
|
||||
?: =(~ a) this
|
||||
?: stop.acc this
|
||||
:: inorder traversal: left -> node -> right, until .f sets .stop
|
||||
::
|
||||
=. this left
|
||||
?: stop.acc this
|
||||
=^ del this node
|
||||
=? this !stop.acc right
|
||||
=? a del (nip a)
|
||||
this
|
||||
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
||||
::
|
||||
++ node
|
||||
^+ [del=*? this]
|
||||
:: run .f on node, updating .stop.acc and .state.acc
|
||||
::
|
||||
?> ?=(^ a)
|
||||
=^ res acc (f state.acc n.a)
|
||||
?~ res
|
||||
[del=& this]
|
||||
[del=| this(val.n.a u.res)]
|
||||
:: +left: recurse on left subtree, copying mutant back into .l.a
|
||||
::
|
||||
++ left
|
||||
^+ this
|
||||
?~ a this
|
||||
=/ lef main(a l.a)
|
||||
lef(a a(l a.lef))
|
||||
:: +right: recurse on right subtree, copying mutant back into .r.a
|
||||
::
|
||||
++ right
|
||||
^+ this
|
||||
?~ a this
|
||||
=/ rig main(a r.a)
|
||||
rig(a a(r a.rig))
|
||||
--
|
||||
:: +gas: put a list of items
|
||||
::
|
||||
++ gas
|
||||
~/ %gas
|
||||
|= [a=(tree item) b=(list item)]
|
||||
^- (tree item)
|
||||
?~ b a
|
||||
$(b t.b, a (put a i.b))
|
||||
:: +get: get val at key or return ~
|
||||
::
|
||||
++ get
|
||||
~/ %get
|
||||
|= [a=(tree item) b=key]
|
||||
^- (unit val)
|
||||
?~ a ~
|
||||
?: =(b key.n.a)
|
||||
`val.n.a
|
||||
?: (compare b key.n.a)
|
||||
$(a l.a)
|
||||
$(a r.a)
|
||||
:: +got: need value at key
|
||||
::
|
||||
++ got
|
||||
|= [a=(tree item) b=key]
|
||||
^- val
|
||||
(need (get a b))
|
||||
:: +has: check for key existence
|
||||
::
|
||||
++ has
|
||||
~/ %has
|
||||
|= [a=(tree item) b=key]
|
||||
^- ?
|
||||
!=(~ (get a b))
|
||||
:: +lot: take a subset range excluding start and/or end and all elements
|
||||
:: outside the range
|
||||
::
|
||||
++ lot
|
||||
~/ %lot
|
||||
|= $: tre=(tree item)
|
||||
start=(unit key)
|
||||
end=(unit key)
|
||||
==
|
||||
^- (tree item)
|
||||
|^
|
||||
?: ?&(?=(~ start) ?=(~ end))
|
||||
tre
|
||||
?~ start
|
||||
(del-span tre %end end)
|
||||
?~ end
|
||||
(del-span tre %start start)
|
||||
?> (compare u.start u.end)
|
||||
=. tre (del-span tre %start start)
|
||||
(del-span tre %end end)
|
||||
::
|
||||
++ del-span
|
||||
|= [a=(tree item) b=?(%start %end) c=(unit key)]
|
||||
^- (tree item)
|
||||
?~ a a
|
||||
?~ c a
|
||||
?- b
|
||||
%start
|
||||
:: found key
|
||||
?: =(key.n.a u.c)
|
||||
(nip a(l ~))
|
||||
:: traverse to find key
|
||||
?: (compare key.n.a u.c)
|
||||
:: found key to the left of start
|
||||
$(a (nip a(l ~)))
|
||||
:: found key to the right of start
|
||||
a(l $(a l.a))
|
||||
::
|
||||
%end
|
||||
:: found key
|
||||
?: =(u.c key.n.a)
|
||||
(nip a(r ~))
|
||||
:: traverse to find key
|
||||
?: (compare key.n.a u.c)
|
||||
:: found key to the left of end
|
||||
a(r $(a r.a))
|
||||
:: found key to the right of end
|
||||
$(a (nip a(r ~)))
|
||||
==
|
||||
--
|
||||
:: +nip: remove root; for internal use
|
||||
::
|
||||
++ nip
|
||||
~/ %nip
|
||||
|= a=(tree item)
|
||||
^- (tree item)
|
||||
?> ?=(^ a)
|
||||
:: delete .n.a; merge and balance .l.a and .r.a
|
||||
::
|
||||
|- ^- (tree item)
|
||||
?~ l.a r.a
|
||||
?~ r.a l.a
|
||||
?: (mor key.n.l.a key.n.r.a)
|
||||
l.a(r $(l.a r.l.a))
|
||||
r.a(l $(r.a l.r.a))
|
||||
::
|
||||
:: +pop: produce .head (leftmost item) and .rest or crash if empty
|
||||
::
|
||||
++ pop
|
||||
~/ %pop
|
||||
|= a=(tree item)
|
||||
^- [head=item rest=(tree item)]
|
||||
?~ a !!
|
||||
?~ l.a [n.a r.a]
|
||||
=/ l $(a l.a)
|
||||
:- head.l
|
||||
:: load .rest.l back into .a and rebalance
|
||||
::
|
||||
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
|
||||
a(l rest.l)
|
||||
rest.l(r a(r r.rest.l))
|
||||
:: +pry: produce head (leftmost item) or null
|
||||
::
|
||||
++ pry
|
||||
~/ %pry
|
||||
|= a=(tree item)
|
||||
^- (unit item)
|
||||
?~ a ~
|
||||
|-
|
||||
?~ l.a `n.a
|
||||
$(a l.a)
|
||||
:: +put: ordered item insert
|
||||
::
|
||||
++ put
|
||||
~/ %put
|
||||
|= [a=(tree item) =key =val]
|
||||
^- (tree item)
|
||||
:: base case: replace null with single-item tree
|
||||
::
|
||||
?~ a [n=[key val] l=~ r=~]
|
||||
:: base case: overwrite existing .key with new .val
|
||||
::
|
||||
?: =(key.n.a key) a(val.n val)
|
||||
:: if item goes on left, recurse left then rebalance vertical order
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=/ l $(a l.a)
|
||||
?> ?=(^ l)
|
||||
?: (mor key.n.a key.n.l)
|
||||
a(l l)
|
||||
l(r a(l r.l))
|
||||
:: item goes on right; recurse right then rebalance vertical order
|
||||
::
|
||||
=/ r $(a r.a)
|
||||
?> ?=(^ r)
|
||||
?: (mor key.n.a key.n.r)
|
||||
a(r r)
|
||||
r(l a(r l.r))
|
||||
:: +ram: produce tail (rightmost item) or null
|
||||
::
|
||||
++ ram
|
||||
~/ %ram
|
||||
|= a=(tree item)
|
||||
^- (unit item)
|
||||
?~ a ~
|
||||
|-
|
||||
?~ r.a `n.a
|
||||
$(a r.a)
|
||||
:: +run: apply gate to transform all values in place
|
||||
::
|
||||
++ run
|
||||
~/ %run
|
||||
|* [a=(tree item) b=$-(val *)]
|
||||
|-
|
||||
?~ a a
|
||||
[n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)]
|
||||
:: +tab: tabulate a subset excluding start element with a max count
|
||||
::
|
||||
++ tab
|
||||
~/ %tab
|
||||
|= [a=(tree item) b=(unit key) c=@]
|
||||
^- (list item)
|
||||
|^
|
||||
(flop e:(tabulate (del-span a b) b c))
|
||||
::
|
||||
++ tabulate
|
||||
|= [a=(tree item) b=(unit key) c=@]
|
||||
^- [d=@ e=(list item)]
|
||||
?: ?&(?=(~ b) =(c 0))
|
||||
[0 ~]
|
||||
=| f=[d=@ e=(list item)]
|
||||
|- ^+ f
|
||||
?: ?|(?=(~ a) =(d.f c)) f
|
||||
=. f $(a l.a)
|
||||
?: =(d.f c) f
|
||||
=. f [+(d.f) [n.a e.f]]
|
||||
?:(=(d.f c) f $(a r.a))
|
||||
::
|
||||
++ del-span
|
||||
|= [a=(tree item) b=(unit key)]
|
||||
^- (tree item)
|
||||
?~ a a
|
||||
?~ b a
|
||||
?: =(key.n.a u.b)
|
||||
r.a
|
||||
?: (compare key.n.a u.b)
|
||||
$(a r.a)
|
||||
a(l $(a l.a))
|
||||
--
|
||||
:: +tap: convert to list, left to right
|
||||
::
|
||||
++ tap
|
||||
~/ %tap
|
||||
|= a=(tree item)
|
||||
^- (list item)
|
||||
=| b=(list item)
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a l.a, b [n.a $(a r.a)])
|
||||
:: +uni: unify two ordered maps
|
||||
::
|
||||
:: .b takes precedence over .a if keys overlap.
|
||||
::
|
||||
++ uni
|
||||
~/ %uni
|
||||
|= [a=(tree item) b=(tree item)]
|
||||
^- (tree item)
|
||||
?~ b a
|
||||
?~ a b
|
||||
?: =(key.n.a key.n.b)
|
||||
[n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)]
|
||||
?: (mor key.n.a key.n.b)
|
||||
?: (compare key.n.b key.n.a)
|
||||
$(l.a $(a l.a, r.b ~), b r.b)
|
||||
$(r.a $(a r.a, l.b ~), b l.b)
|
||||
?: (compare key.n.a key.n.b)
|
||||
$(l.b $(b l.b, r.a ~), a r.a)
|
||||
$(r.b $(b r.b, l.a ~), a l.a)
|
||||
--
|
||||
::
|
||||
+$ deco ?(~ %bl %br %un) :: text decoration
|
||||
+$ json :: normal json value
|
||||
$@ ~ :: null
|
||||
@ -355,6 +782,12 @@
|
||||
:: %kroc: request to delete stale message flows
|
||||
:: %plea: request to send message
|
||||
::
|
||||
:: Remote Scry Tasks
|
||||
::
|
||||
:: %keen: peek: [ship /vane/care/case/spur]
|
||||
:: %yawn: cancel request from arvo
|
||||
:: %wham: cancels all scry request from any vane
|
||||
::
|
||||
:: System and Lifecycle Tasks
|
||||
::
|
||||
:: %born: process restart notification
|
||||
@ -375,6 +808,10 @@
|
||||
[%cork =ship]
|
||||
[%kroc dry=?]
|
||||
$>(%plea vane-task)
|
||||
::
|
||||
[%keen spar]
|
||||
[%yawn spar]
|
||||
[%wham spar]
|
||||
::
|
||||
$>(%born vane-task)
|
||||
$>(%init vane-task)
|
||||
@ -397,6 +834,10 @@
|
||||
:: %lost: notify vane that we crashed on %boon
|
||||
:: %send: packet to unix
|
||||
::
|
||||
:: Remote Scry Gifts
|
||||
::
|
||||
:: %tune: peek result
|
||||
::
|
||||
:: System and Lifecycle Gifts
|
||||
::
|
||||
:: %turf: domain report, relayed from jael
|
||||
@ -407,6 +848,8 @@
|
||||
[%done error=(unit error)]
|
||||
[%lost ~]
|
||||
[%send =lane =blob]
|
||||
::
|
||||
[%tune spar roar=(unit roar)]
|
||||
::
|
||||
[%turf turfs=(list turf)]
|
||||
==
|
||||
@ -418,7 +861,9 @@
|
||||
++ as ^? :: asym ops
|
||||
|% ++ seal |~([a=pass b=@] *@) :: encrypt to a
|
||||
++ sign |~(a=@ *@) :: certify as us
|
||||
++ sigh |~(a=@ *@) :: certification only
|
||||
++ sure |~(a=@ *(unit @)) :: authenticate from us
|
||||
++ safe |~([a=@ b=@] *?) :: authentication only
|
||||
++ tear |~([a=pass b=@] *(unit @)) :: accept from a
|
||||
-- ::as ::
|
||||
++ de |~([a=@ b=@] *(unit @)) :: symmetric de, soft
|
||||
@ -436,12 +881,15 @@
|
||||
++ com |~(a=pass ^?(..nu)) :: from pass
|
||||
-- ::nu ::
|
||||
-- ::acru ::
|
||||
:: +protocol-version: current version of the ames wire protocol
|
||||
::
|
||||
++ protocol-version `?(%0 %1 %2 %3 %4 %5 %6 %7)`%0
|
||||
:: $address: opaque atomic transport address to or from unix
|
||||
::
|
||||
+$ address @uxaddress
|
||||
:: $verb: verbosity flag for ames
|
||||
::
|
||||
+$ verb ?(%snd %rcv %odd %msg %ges %for %rot %kay)
|
||||
+$ verb ?(%snd %rcv %odd %msg %ges %for %rot %kay %fin)
|
||||
:: $blob: raw atom to or from unix, representing a packet
|
||||
::
|
||||
+$ blob @uxblob
|
||||
@ -461,6 +909,12 @@
|
||||
:: payload: semantic message contents
|
||||
::
|
||||
+$ plea [vane=@tas =path payload=*]
|
||||
:: $spar: pair of $ship and $path
|
||||
::
|
||||
:: Instead of fully qualifying a scry path, ames infers rift and
|
||||
:: life based on the ship.
|
||||
::
|
||||
+$ spar [=ship =path]
|
||||
::
|
||||
:: +| %atomics
|
||||
::
|
||||
@ -472,7 +926,39 @@
|
||||
+$ public-key @uwpublickey
|
||||
+$ symmetric-key @uwsymmetrickey
|
||||
::
|
||||
:: $hoot: request packet payload
|
||||
:: $yowl: serialized response packet payload
|
||||
:: $hunk: a slice of $yowl fragments
|
||||
::
|
||||
+$ hoot @uxhoot
|
||||
+$ yowl @uxyowl
|
||||
+$ hunk [lop=@ len=@]
|
||||
::
|
||||
:: +| %kinetics
|
||||
:: $dyad: pair of sender and receiver ships
|
||||
::
|
||||
+$ dyad [sndr=ship rcvr=ship]
|
||||
:: $shot: noun representation of an ames datagram packet
|
||||
::
|
||||
:: Roundtrips losslessly through atom encoding and decoding.
|
||||
::
|
||||
:: .origin is ~ unless the packet is being forwarded. If present,
|
||||
:: it's an atom that encodes a route to another ship, such as an IPv4
|
||||
:: address. Routes are opaque to Arvo and only have meaning in the
|
||||
:: interpreter. This enforces that Ames is transport-agnostic.
|
||||
::
|
||||
:: req: is a request
|
||||
:: sam: is using the ames protocol (not fine or another protocol)
|
||||
::
|
||||
+$ shot
|
||||
$: dyad
|
||||
req=?
|
||||
sam=?
|
||||
sndr-tick=@ubC
|
||||
rcvr-tick=@ubC
|
||||
origin=(unit @uxaddress)
|
||||
content=@uxcontent
|
||||
==
|
||||
:: $ack: positive ack, nack packet, or nack trace
|
||||
::
|
||||
+$ ack
|
||||
@ -501,6 +987,7 @@
|
||||
$: messages=(list [=duct =plea])
|
||||
packets=(set =blob)
|
||||
heeds=(set duct)
|
||||
keens=(jug path duct)
|
||||
==
|
||||
:: $peer-state: state for a peer with known life and keys
|
||||
::
|
||||
@ -539,7 +1026,51 @@
|
||||
heeds=(set duct)
|
||||
closing=(set bone)
|
||||
corked=(set bone)
|
||||
keens=(map path keen-state)
|
||||
==
|
||||
+$ keen-state
|
||||
$: wan=(pha want) :: request packets, sent
|
||||
nex=(list want) :: request packets, unsent
|
||||
hav=(list have) :: response packets, backward
|
||||
num-fragments=@ud
|
||||
num-received=@ud
|
||||
next-wake=(unit @da)
|
||||
listeners=(set duct)
|
||||
metrics=pump-metrics
|
||||
==
|
||||
+$ want
|
||||
$: fra=@ud
|
||||
=hoot
|
||||
packet-state
|
||||
==
|
||||
+$ have
|
||||
$: fra=@ud
|
||||
meow
|
||||
==
|
||||
::
|
||||
+$ meow :: response fragment
|
||||
$: sig=@ux :: signature
|
||||
num=@ud :: number of fragments
|
||||
dat=@ux :: contents
|
||||
==
|
||||
::
|
||||
+$ peep :: fragment request
|
||||
$: =path
|
||||
num=@ud
|
||||
==
|
||||
::
|
||||
+$ wail :: tagged request fragment
|
||||
$% [%0 peep] :: unsigned
|
||||
==
|
||||
::
|
||||
+$ roar :: response message
|
||||
(tale:pki:jael (pair path (unit (cask))))
|
||||
::
|
||||
+$ purr :: response packet payload
|
||||
$: peep
|
||||
meow
|
||||
==
|
||||
::
|
||||
:: $qos: quality of service; how is our connection to a peer doing?
|
||||
::
|
||||
:: .last-contact: last time we heard from peer, or if %unborn, when
|
||||
@ -637,9 +1168,21 @@
|
||||
::
|
||||
+$ packet-pump-state
|
||||
$: next-wake=(unit @da)
|
||||
live=(tree [live-packet-key live-packet-val])
|
||||
live=((mop live-packet-key live-packet-val) lte-packets)
|
||||
metrics=pump-metrics
|
||||
==
|
||||
:: +lte-packets: yes if a is before b
|
||||
::
|
||||
++ lte-packets
|
||||
|= [a=live-packet-key b=live-packet-key]
|
||||
^- ?
|
||||
::
|
||||
?: (lth message-num.a message-num.b)
|
||||
%.y
|
||||
?: (gth message-num.a message-num.b)
|
||||
%.n
|
||||
(lte fragment-num.a fragment-num.b)
|
||||
::
|
||||
:: $pump-metrics: congestion control state for a |packet-pump
|
||||
::
|
||||
:: This is an Ames adaptation of TCP's Reno congestion control
|
||||
@ -690,7 +1233,7 @@
|
||||
==
|
||||
+$ packet-state
|
||||
$: last-sent=@da
|
||||
retries=@ud
|
||||
tries=_1
|
||||
skips=@ud
|
||||
==
|
||||
:: $message-sink-state: state of |message-sink to assemble messages
|
||||
@ -718,7 +1261,183 @@
|
||||
num-received=fragment-num
|
||||
fragments=(map fragment-num fragment)
|
||||
==
|
||||
:: $rank: which kind of ship address, by length
|
||||
::
|
||||
:: 0b0: galaxy or star -- 2 bytes
|
||||
:: 0b1: planet -- 4 bytes
|
||||
:: 0b10: moon -- 8 bytes
|
||||
:: 0b11: comet -- 16 bytes
|
||||
::
|
||||
+$ rank ?(%0b0 %0b1 %0b10 %0b11)
|
||||
::
|
||||
:: +| %coding
|
||||
:: +sift-ship-size: decode a 2-bit ship type specifier into a byte width
|
||||
::
|
||||
:: Type 0: galaxy or star -- 2 bytes
|
||||
:: Type 1: planet -- 4 bytes
|
||||
:: Type 2: moon -- 8 bytes
|
||||
:: Type 3: comet -- 16 bytes
|
||||
::
|
||||
++ sift-ship-size
|
||||
|= rank=@ubC
|
||||
^- @
|
||||
::
|
||||
?+ rank !!
|
||||
%0b0 2
|
||||
%0b1 4
|
||||
%0b10 8
|
||||
%0b11 16
|
||||
==
|
||||
:: +is-valid-rank: does .ship match its stated .size?
|
||||
::
|
||||
++ is-valid-rank
|
||||
|= [=ship size=@ubC]
|
||||
^- ?
|
||||
.= size
|
||||
=/ wid (met 3 ship)
|
||||
?: (lte wid 1) 2
|
||||
?: =(2 wid) 2
|
||||
?: (lte wid 4) 4
|
||||
?: (lte wid 8) 8
|
||||
?> (lte wid 16) 16
|
||||
:: +sift-shot: deserialize packet from bytestream or crash
|
||||
::
|
||||
++ sift-shot
|
||||
|= =blob
|
||||
^- shot
|
||||
~| %sift-shot-fail
|
||||
:: first 32 (2^5) bits are header; the rest is body
|
||||
::
|
||||
=/ header (end 5 blob)
|
||||
=/ body (rsh 5 blob)
|
||||
:: read header; first two bits are reserved
|
||||
::
|
||||
=/ req =(& (cut 0 [2 1] header))
|
||||
=/ sam =(& (cut 0 [3 1] header))
|
||||
::
|
||||
=/ version (cut 0 [4 3] header)
|
||||
?. =(protocol-version version)
|
||||
~& [%ames-protocol-version protocol-version version]
|
||||
~| ames-protocol-version+version !!
|
||||
::
|
||||
=/ sndr-size (sift-ship-size (cut 0 [7 2] header))
|
||||
=/ rcvr-size (sift-ship-size (cut 0 [9 2] header))
|
||||
=/ checksum (cut 0 [11 20] header)
|
||||
=/ relayed (cut 0 [31 1] header)
|
||||
:: origin, if present, is 6 octets long, at the end of the body
|
||||
::
|
||||
=^ origin=(unit @) body
|
||||
?: =(| relayed)
|
||||
[~ body]
|
||||
=/ len (sub (met 3 body) 6)
|
||||
[`(end [3 6] body) (rsh [3 6] body)]
|
||||
:: .checksum does not apply to the origin
|
||||
::
|
||||
?. =(checksum (end [0 20] (mug body)))
|
||||
~& >>> %ames-checksum
|
||||
~| %ames-checksum !!
|
||||
:: read fixed-length sndr and rcvr life data from body
|
||||
::
|
||||
:: These represent the last four bits of the sender and receiver
|
||||
:: life fields, to be used for quick dropping of honest packets to
|
||||
:: or from the wrong life.
|
||||
::
|
||||
=/ sndr-tick (cut 0 [0 4] body)
|
||||
=/ rcvr-tick (cut 0 [4 4] body)
|
||||
:: read variable-length .sndr and .rcvr addresses
|
||||
::
|
||||
=/ off 1
|
||||
=^ sndr off [(cut 3 [off sndr-size] body) (add off sndr-size)]
|
||||
?. (is-valid-rank sndr sndr-size)
|
||||
~& >>> [%ames-sender-imposter sndr sndr-size]
|
||||
~| ames-sender-impostor+[sndr sndr-size] !!
|
||||
::
|
||||
=^ rcvr off [(cut 3 [off rcvr-size] body) (add off rcvr-size)]
|
||||
?. (is-valid-rank rcvr rcvr-size)
|
||||
~& >>> [%ames-receiver-imposter rcvr rcvr-size]
|
||||
~| ames-receiver-impostor+[rcvr rcvr-size] !!
|
||||
:: read variable-length .content from the rest of .body
|
||||
::
|
||||
=/ content (cut 3 [off (sub (met 3 body) off)] body)
|
||||
[[sndr rcvr] req sam sndr-tick rcvr-tick origin content]
|
||||
::
|
||||
++ sift-wail
|
||||
|= =hoot
|
||||
^- wail
|
||||
?> =(0 (end 3 hoot))
|
||||
[%0 +:(sift-peep (rsh 3 hoot))]
|
||||
::
|
||||
++ sift-purr
|
||||
|= =hoot
|
||||
^- purr
|
||||
=+ [wid peep]=(sift-peep hoot)
|
||||
[peep (sift-meow (rsh [3 wid] hoot))]
|
||||
::
|
||||
++ sift-peep
|
||||
|= =hoot
|
||||
^- [wid=@ =peep]
|
||||
=+ num=(cut 3 [0 4] hoot)
|
||||
=+ len=(cut 3 [4 2] hoot)
|
||||
=+ pat=(cut 3 [6 len] hoot)
|
||||
~| pat=pat
|
||||
[(add 6 len) [(stab pat) num]]
|
||||
::
|
||||
++ sift-meow
|
||||
|= =yowl
|
||||
:* sig=(cut 3 [0 64] yowl)
|
||||
num=(cut 3 [64 4] yowl)
|
||||
dat=(rsh 3^68 yowl)
|
||||
==
|
||||
:: +etch-shot: serialize a packet into a bytestream
|
||||
::
|
||||
++ etch-shot
|
||||
|= shot
|
||||
^- blob
|
||||
::
|
||||
=/ sndr-meta (ship-meta sndr)
|
||||
=/ rcvr-meta (ship-meta rcvr)
|
||||
::
|
||||
=/ body=@
|
||||
;: mix
|
||||
sndr-tick
|
||||
(lsh 2 rcvr-tick)
|
||||
(lsh 3 sndr)
|
||||
(lsh [3 +(size.sndr-meta)] rcvr)
|
||||
(lsh [3 +((add size.sndr-meta size.rcvr-meta))] content)
|
||||
==
|
||||
=/ checksum (end [0 20] (mug body))
|
||||
=? body ?=(^ origin) (mix u.origin (lsh [3 6] body))
|
||||
::
|
||||
=/ header=@
|
||||
%+ can 0
|
||||
:~ [2 reserved=0]
|
||||
[1 req]
|
||||
[1 sam]
|
||||
[3 protocol-version]
|
||||
[2 rank.sndr-meta]
|
||||
[2 rank.rcvr-meta]
|
||||
[20 checksum]
|
||||
[1 relayed=.?(origin)]
|
||||
==
|
||||
(mix header (lsh 5 body))
|
||||
::
|
||||
:: +ship-meta: produce size (in bytes) and address rank for .ship
|
||||
::
|
||||
:: 0: galaxy or star
|
||||
:: 1: planet
|
||||
:: 2: moon
|
||||
:: 3: comet
|
||||
::
|
||||
++ ship-meta
|
||||
|= =ship
|
||||
^- [size=@ =rank]
|
||||
::
|
||||
=/ size=@ (met 3 ship)
|
||||
::
|
||||
?: (lte size 2) [2 %0b0]
|
||||
?: (lte size 4) [4 %0b1]
|
||||
?: (lte size 8) [8 %0b10]
|
||||
[16 %0b11]
|
||||
-- ::ames
|
||||
:: ::::
|
||||
:::: ++behn :: (1b) timekeeping
|
||||
@ -815,11 +1534,6 @@
|
||||
== ::
|
||||
+$ care :: clay submode
|
||||
?(%a %b %c %d %e %f %p %r %s %t %u %v %w %x %y %z) ::
|
||||
+$ case :: ship desk case spur
|
||||
$% [%da p=@da] :: date
|
||||
[%tas p=@tas] :: label
|
||||
[%ud p=@ud] :: number
|
||||
== ::
|
||||
+$ cash :: case or tako
|
||||
$% [%tako p=tako] ::
|
||||
case ::
|
||||
@ -919,6 +1633,7 @@
|
||||
[%arch =path =(map path lobe)]
|
||||
==
|
||||
+$ rang :: repository
|
||||
$+ rang
|
||||
$: hut=(map tako yaki) :: changes
|
||||
lat=(map lobe page) :: data
|
||||
== ::
|
||||
@ -1354,6 +2069,11 @@
|
||||
:: ::::
|
||||
++ eyre ^?
|
||||
|%
|
||||
+$ cache-entry
|
||||
$: auth=?
|
||||
$= body
|
||||
$% [%payload =simple-payload:http]
|
||||
== ==
|
||||
+$ gift
|
||||
$% :: set-config: configures the external http server
|
||||
::
|
||||
@ -1373,6 +2093,9 @@
|
||||
:: not allowed.
|
||||
::
|
||||
[%bound accepted=? =binding]
|
||||
:: notification that a cache entry has changed
|
||||
::
|
||||
[%grow =path]
|
||||
==
|
||||
::
|
||||
+$ task
|
||||
@ -1428,6 +2151,9 @@
|
||||
:: %spew: set verbosity toggle
|
||||
::
|
||||
[%spew veb=@]
|
||||
:: remember (or update) a cache mapping
|
||||
::
|
||||
[%set-response url=@t entry=(unit cache-entry)]
|
||||
==
|
||||
:: +origin: request origin as specified in an Origin header
|
||||
::
|
||||
@ -1509,7 +2235,7 @@
|
||||
$% $>(%poke-ack sign:agent:gall)
|
||||
$>(%watch-ack sign:agent:gall)
|
||||
$>(%kick sign:agent:gall)
|
||||
[%fact =mark =noun]
|
||||
[%fact =desk =mark =noun]
|
||||
==
|
||||
:: channel: connection to the browser
|
||||
::
|
||||
@ -1525,7 +2251,8 @@
|
||||
:: events since then.
|
||||
::
|
||||
+$ channel
|
||||
$: :: channel-state: expiration time or the duct currently listening
|
||||
$: mode=?(%json %jam)
|
||||
:: channel-state: expiration time or the duct currently listening
|
||||
::
|
||||
:: For each channel, there is at most one open EventSource
|
||||
:: connection. A 400 is issues on duplicate attempts to connect to the
|
||||
@ -1880,18 +2607,21 @@
|
||||
+$ boat (map [=wire =ship =term] [acked=? =path]) :: outgoing subs
|
||||
+$ boar (map [=wire =ship =term] nonce=@) :: and their nonces
|
||||
+$ bowl :: standard app state
|
||||
$: $: our=ship :: host
|
||||
src=ship :: guest
|
||||
dap=term :: agent
|
||||
== ::
|
||||
$: wex=boat :: outgoing subs
|
||||
sup=bitt :: incoming subs
|
||||
== ::
|
||||
$: act=@ud :: change number
|
||||
eny=@uvJ :: entropy
|
||||
now=@da :: current time
|
||||
byk=beak :: load source
|
||||
== == ::
|
||||
$: $: our=ship :: host
|
||||
src=ship :: guest
|
||||
dap=term :: agent
|
||||
== ::
|
||||
$: wex=boat :: outgoing subs
|
||||
sup=bitt :: incoming subs
|
||||
$= sky :: scry bindings
|
||||
%+ map path ::
|
||||
((mop @ud (pair @da (each page @uvI))) lte) ::
|
||||
== ::
|
||||
$: act=@ud :: change number
|
||||
eny=@uvJ :: entropy
|
||||
now=@da :: current time
|
||||
byk=beak :: load source
|
||||
== == :: ::
|
||||
+$ dude term :: server identity
|
||||
+$ gill (pair ship term) :: general contact
|
||||
+$ load (list [=dude =beak =agent]) :: loadout
|
||||
@ -1902,11 +2632,6 @@
|
||||
== ::
|
||||
+$ suss (trel dude @tas @da) :: config report
|
||||
+$ well (pair desk term) ::
|
||||
+$ neat
|
||||
$% [%arvo =note-arvo]
|
||||
[%agent [=ship name=term] =deal]
|
||||
[%pyre =tang]
|
||||
==
|
||||
+$ deal
|
||||
$% [%raw-poke =mark =noun]
|
||||
task:agent
|
||||
@ -1930,6 +2655,10 @@
|
||||
$% [%agent [=ship name=term] =task]
|
||||
[%arvo note-arvo]
|
||||
[%pyre =tang]
|
||||
::
|
||||
[%grow =spur =page]
|
||||
[%tomb =case =spur]
|
||||
[%cull =case =spur]
|
||||
==
|
||||
+$ task
|
||||
$% [%watch =path]
|
||||
@ -2320,6 +3049,11 @@
|
||||
+$ mind [who=ship lyf=life] :: key identifier
|
||||
+$ name (pair @ta @t) :: ascii / unicode
|
||||
+$ oath @ :: signature
|
||||
++ tale :: urbit-signed *
|
||||
|$ [typ] :: payload mold
|
||||
$: dat=typ :: data
|
||||
syg=(map ship (pair life oath)) :: signatures
|
||||
== ::
|
||||
-- :: pki
|
||||
-- :: jael
|
||||
:: ::::
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -243,13 +243,6 @@
|
||||
=* lot=coin $/r.bem
|
||||
=* tyl s.bem
|
||||
::
|
||||
::TODO don't special-case whey scry
|
||||
::
|
||||
?: &(=(ren %$) =(tyl /whey))
|
||||
=/ maz=(list mass)
|
||||
:~ timers+&+timers.state
|
||||
==
|
||||
``mass+!>(maz)
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
@ -257,6 +250,7 @@
|
||||
=(%$ syd)
|
||||
==
|
||||
~
|
||||
:: /bx//whey (list mass) memory usage labels
|
||||
:: /bx/debug/timers (list [@da duct]) all timers and their ducts
|
||||
:: /bx/timers (list @da) all timer timestamps
|
||||
:: /bx/timers/next (unit @da) the very next timer to fire
|
||||
@ -264,6 +258,12 @@
|
||||
::
|
||||
?. ?=(%x ren) ~
|
||||
?+ tyl [~ ~]
|
||||
[%$ %whey ~]
|
||||
=/ maz=(list mass)
|
||||
:~ timers+&+timers.state
|
||||
==
|
||||
``mass+!>(maz)
|
||||
::
|
||||
[%debug %timers ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list [@da duct])
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -489,14 +489,7 @@
|
||||
::
|
||||
?. ?=(%& -.why) ~
|
||||
=* his p.why
|
||||
::TODO don't special-case whey scry
|
||||
::
|
||||
?: &(=(ren %$) =(tyl /whey))
|
||||
=/ maz=(list mass)
|
||||
:~ hey+&+hey.all
|
||||
dug+&+dug.all
|
||||
==
|
||||
``mass+!>(maz)
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
@ -504,10 +497,14 @@
|
||||
=(%$ syd)
|
||||
==
|
||||
~
|
||||
:: /%x//whey (list mass) memory usage labels
|
||||
:: /dy/sessions (set @tas) all existing sessions
|
||||
:: /du/sessions/[ses] ? does session ses exist?
|
||||
::
|
||||
?+ [ren tyl] ~
|
||||
[%x %$ %whey ~] =- ``mass+!>(`(list mass)`-)
|
||||
[hey+&+hey.all dug+&+dug.all ~]
|
||||
::
|
||||
[%y %sessions ~] ``noun+!>(~(key by dug.all))
|
||||
[%u %sessions @ ~] ``noun+!>((~(has by dug.all) (snag 1 tyl)))
|
||||
==
|
||||
|
||||
@ -67,8 +67,12 @@
|
||||
:: more structures
|
||||
::
|
||||
|%
|
||||
+$ axle
|
||||
$: %~2023.2.17
|
||||
++ axle
|
||||
$: :: date: date at which http-server's state was updated to this data structure
|
||||
::
|
||||
date=%~2023.4.11
|
||||
:: server-state: state of inbound requests
|
||||
::
|
||||
=server-state
|
||||
==
|
||||
:: +server-state: state relating to open inbound HTTP connections
|
||||
@ -84,6 +88,9 @@
|
||||
:: the :binding into a (map (unit @t) (trie knot =action)).
|
||||
::
|
||||
bindings=(list [=binding =duct =action])
|
||||
:: cache: mapping from url to versioned entry
|
||||
::
|
||||
cache=(map url=@t [aeon=@ud val=(unit cache-entry)])
|
||||
:: cors-registry: state used and managed by the +cors core
|
||||
::
|
||||
=cors-registry
|
||||
@ -118,9 +125,12 @@
|
||||
$% :: %ack: acknowledges that the client has received events up to :id
|
||||
::
|
||||
[%ack event-id=@ud]
|
||||
:: %poke: pokes an application, translating :json to :mark.
|
||||
:: %poke: pokes an application, validating :noun against :mark
|
||||
::
|
||||
[%poke request-id=@ud ship=@p app=term mark=@tas =json]
|
||||
[%poke request-id=@ud ship=@p app=term mark=@tas =noun]
|
||||
:: %poke-json: pokes an application, translating :json to :mark
|
||||
::
|
||||
[%poke-json request-id=@ud ship=@p app=term mark=@tas =json]
|
||||
:: %watch: subscribes to an application path
|
||||
::
|
||||
[%subscribe request-id=@ud ship=@p app=term =path]
|
||||
@ -197,13 +207,44 @@
|
||||
%+ ~(put by unacked) rid
|
||||
?: (lte u.sus ack) 0
|
||||
(sub u.sus ack)
|
||||
:: +find-channel-mode: deduce requested mode from headers
|
||||
::
|
||||
++ find-channel-mode
|
||||
|= [met=method:http hes=header-list:http]
|
||||
^- ?(%json %jam)
|
||||
=+ ^- [hed=@t jam=@t]
|
||||
?: ?=(%'GET' met) ['x-channel-format' 'application/x-urb-jam']
|
||||
['content-type' 'application/x-urb-jam']
|
||||
=+ typ=(bind (get-header:http hed hes) :(cork trip cass crip))
|
||||
?:(=(`jam typ) %jam %json)
|
||||
:: +parse-channel-request: parses a list of channel-requests
|
||||
::
|
||||
++ parse-channel-request
|
||||
|= [mode=?(%json %jam) body=octs]
|
||||
^- (each (list channel-request) @t)
|
||||
?- mode
|
||||
%json
|
||||
?~ maybe-json=(de-json:html q.body)
|
||||
|+'put body not json'
|
||||
?~ maybe-requests=(parse-channel-request-json u.maybe-json)
|
||||
|+'invalid channel json'
|
||||
&+u.maybe-requests
|
||||
::
|
||||
%jam
|
||||
?~ maybe-noun=(bind (slaw %uw q.body) cue)
|
||||
|+'invalid request format'
|
||||
?~ maybe-reqs=((soft (list channel-request)) u.maybe-noun)
|
||||
~& [%miss u.maybe-noun]
|
||||
|+'invalid request data'
|
||||
&+u.maybe-reqs
|
||||
==
|
||||
:: +parse-channel-request-json: parses a json list of channel-requests
|
||||
::
|
||||
:: Parses a json array into a list of +channel-request. If any of the items
|
||||
:: in the list fail to parse, the entire thing fails so we can 400 properly
|
||||
:: to the client.
|
||||
::
|
||||
++ parse-channel-request
|
||||
++ parse-channel-request-json
|
||||
|= request-list=json
|
||||
^- (unit (list channel-request))
|
||||
:: parse top
|
||||
@ -219,7 +260,9 @@
|
||||
?: =('ack' u.maybe-key)
|
||||
((pe %ack (ot event-id+ni ~)) item)
|
||||
?: =('poke' u.maybe-key)
|
||||
((pe %poke (ot id+ni ship+(su fed:ag) app+so mark+(su sym) json+some ~)) item)
|
||||
%. item
|
||||
%+ pe %poke-json
|
||||
(ot id+ni ship+(su fed:ag) app+so mark+(su sym) json+some ~)
|
||||
?: =('subscribe' u.maybe-key)
|
||||
%. item
|
||||
%+ pe %subscribe
|
||||
@ -672,6 +715,11 @@
|
||||
=- (fall - '*')
|
||||
(get-header:http 'access-control-request-headers' headers)
|
||||
==
|
||||
:: handle requests to the cache
|
||||
::
|
||||
=/ entry (~(get by cache.state) url.request)
|
||||
?: &(?=(^ entry) ?=(%'GET' method.request))
|
||||
(handle-cache-req authenticated request val.u.entry)
|
||||
::
|
||||
?- -.action
|
||||
%gen
|
||||
@ -771,6 +819,32 @@
|
||||
%^ return-static-data-on-duct status 'text/html'
|
||||
(error-page status authenticated url.request tape)
|
||||
--
|
||||
:: +handle-cache-req: respond with cached value, 404 or 500
|
||||
::
|
||||
++ handle-cache-req
|
||||
|= [authenticated=? =request:http entry=(unit cache-entry)]
|
||||
|^ ^- (quip move server-state)
|
||||
?~ entry
|
||||
(error-response 404 "cache entry for that binding was deleted")
|
||||
?: &(auth.u.entry !authenticated)
|
||||
(error-response 403 ~)
|
||||
=* body body.u.entry
|
||||
?- -.body
|
||||
%payload
|
||||
%- handle-response
|
||||
:* %start
|
||||
response-header.simple-payload.body
|
||||
data.simple-payload.body
|
||||
complete=%.y
|
||||
==
|
||||
==
|
||||
::
|
||||
++ error-response
|
||||
|= [status=@ud =tape]
|
||||
^- (quip move server-state)
|
||||
%^ return-static-data-on-duct status 'text/html'
|
||||
(error-page status authenticated url.request tape)
|
||||
--
|
||||
:: +handle-scry: respond with scry result, 404 or 500
|
||||
::
|
||||
++ handle-scry
|
||||
@ -1200,7 +1274,7 @@
|
||||
:: state.
|
||||
::
|
||||
++ update-timeout-timer-for
|
||||
|= channel-id=@t
|
||||
|= [mode=?(%json %jam) channel-id=@t]
|
||||
^+ ..update-timeout-timer-for
|
||||
:: when our callback should fire
|
||||
::
|
||||
@ -1212,7 +1286,7 @@
|
||||
%_ ..update-timeout-timer-for
|
||||
session.channel-state.state
|
||||
%+ ~(put by session.channel-state.state) channel-id
|
||||
[[%& expiration-time duct] 0 now ~ ~ ~ ~]
|
||||
[mode [%& expiration-time duct] 0 now ~ ~ ~ ~]
|
||||
::
|
||||
moves
|
||||
[(set-timeout-move channel-id expiration-time) moves]
|
||||
@ -1267,10 +1341,19 @@
|
||||
|= [channel-id=@t =request:http]
|
||||
^- [(list move) server-state]
|
||||
:: if there's no channel-id, we must 404
|
||||
::TODO but arm description says otherwise?
|
||||
::
|
||||
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
|
||||
%^ return-static-data-on-duct 404 'text/html'
|
||||
(error-page 404 %.y url.request ~)
|
||||
:: find the requested "mode" and make sure it doesn't conflict
|
||||
::
|
||||
=/ mode=?(%json %jam)
|
||||
(find-channel-mode %'GET' header-list.request)
|
||||
?. =(mode mode.u.maybe-channel)
|
||||
%^ return-static-data-on-duct 406 'text/html'
|
||||
=; msg=tape (error-page 406 %.y url.request msg)
|
||||
"channel already established in {(trip mode.u.maybe-channel)} mode"
|
||||
:: when opening an event-stream, we must cancel our timeout timer
|
||||
:: if there's no duct already bound. Else, kill the old request
|
||||
:: and replace it
|
||||
@ -1312,11 +1395,10 @@
|
||||
::NOTE these will only fail if the mark and/or json types changed,
|
||||
:: since conversion failure also gets caught during first receive.
|
||||
:: we can't do anything about this, so consider it unsupported.
|
||||
=/ sign
|
||||
(channel-event-to-sign u.maybe-channel request-id channel-event)
|
||||
?~ sign $
|
||||
?~ jive=(sign-to-json u.maybe-channel request-id u.sign) $
|
||||
$(events [(event-json-to-wall id +.u.jive) events])
|
||||
=/ said
|
||||
(channel-event-to-tape u.maybe-channel request-id channel-event)
|
||||
?~ said $
|
||||
$(events [(event-tape-to-wall id +.u.said) events])
|
||||
:: send the start event to the client
|
||||
::
|
||||
=^ http-moves state
|
||||
@ -1348,13 +1430,17 @@
|
||||
::
|
||||
=/ heartbeat-time=@da (add now ~s20)
|
||||
=/ heartbeat (set-heartbeat-move channel-id heartbeat-time)
|
||||
:: record the duct for future output and
|
||||
:: record heartbeat-time for possible future cancel
|
||||
:: record the mode & duct for future output,
|
||||
:: and record heartbeat-time for possible future cancel
|
||||
::
|
||||
=. session.channel-state.state
|
||||
%+ ~(jab by session.channel-state.state) channel-id
|
||||
|= =channel
|
||||
channel(state [%| duct], heartbeat (some [heartbeat-time duct]))
|
||||
%_ channel
|
||||
mode mode
|
||||
state [%| duct]
|
||||
heartbeat (some [heartbeat-time duct])
|
||||
==
|
||||
::
|
||||
[[heartbeat :(weld http-moves cancel-moves moves)] state]
|
||||
:: +acknowledge-events: removes events before :last-event-id on :channel-id
|
||||
@ -1386,19 +1472,19 @@
|
||||
?~ body.request
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "no put body")
|
||||
:: if the incoming body isn't json, this is a bad request, 400.
|
||||
::
|
||||
?~ maybe-json=(de-json:html q.u.body.request)
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "put body not json")
|
||||
:: parse the json into an array of +channel-request items
|
||||
=/ mode=?(%json %jam)
|
||||
(find-channel-mode %'PUT' header-list.request)
|
||||
:: if we cannot parse requests from the body, give an error
|
||||
::
|
||||
?~ maybe-requests=(parse-channel-request u.maybe-json)
|
||||
=/ maybe-requests=(each (list channel-request) @t)
|
||||
(parse-channel-request mode u.body.request)
|
||||
?: ?=(%| -.maybe-requests)
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "invalid channel json")
|
||||
(error-page 400 & url.request (trip p.maybe-requests))
|
||||
:: while weird, the request list could be empty
|
||||
::
|
||||
?: =(~ u.maybe-requests)
|
||||
?: =(~ p.maybe-requests)
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "empty list of actions")
|
||||
:: check for the existence of the channel-id
|
||||
@ -1407,10 +1493,10 @@
|
||||
:: :channel-timeout from now. if we have one which has a timer, update
|
||||
:: that timer.
|
||||
::
|
||||
=. ..on-put-request (update-timeout-timer-for channel-id)
|
||||
=. ..on-put-request (update-timeout-timer-for mode channel-id)
|
||||
:: for each request, execute the action passed in
|
||||
::
|
||||
=+ requests=u.maybe-requests
|
||||
=+ requests=p.maybe-requests
|
||||
:: gall-moves: put moves here first so we can flop for ordering
|
||||
::
|
||||
:: TODO: Have an error state where any invalid duplicate subscriptions
|
||||
@ -1441,7 +1527,7 @@
|
||||
requests t.requests
|
||||
==
|
||||
::
|
||||
%poke
|
||||
?(%poke %poke-json)
|
||||
::
|
||||
=. gall-moves
|
||||
:_ gall-moves
|
||||
@ -1449,7 +1535,12 @@
|
||||
:^ duct %pass /channel/poke/[channel-id]/(scot %ud request-id.i.requests)
|
||||
=, i.requests
|
||||
:* %g %deal `sock`[our ship] app
|
||||
`task:agent:gall`[%poke-as mark %json !>(json)]
|
||||
^- task:agent:gall
|
||||
:+ %poke-as mark
|
||||
?- -.i.requests
|
||||
%poke [%noun !>(noun)]
|
||||
%poke-json [%json !>(json)]
|
||||
==
|
||||
==
|
||||
::
|
||||
$(requests t.requests)
|
||||
@ -1584,20 +1675,22 @@
|
||||
:: if conversion succeeds, we *can* send it. if the client is actually
|
||||
:: connected, we *will* send it immediately.
|
||||
::
|
||||
=/ jive=(unit (quip move json))
|
||||
(sign-to-json u.channel request-id sign)
|
||||
=/ json=(unit json)
|
||||
?~(jive ~ `+.u.jive)
|
||||
=? moves ?=(^ jive)
|
||||
(weld moves -.u.jive)
|
||||
=* sending &(?=([%| *] state.u.channel) ?=(^ json))
|
||||
=/ maybe-channel-event=(unit channel-event)
|
||||
(sign-to-channel-event sign u.channel request-id)
|
||||
?~ maybe-channel-event [~ state]
|
||||
=/ =channel-event u.maybe-channel-event
|
||||
=/ said=(unit (quip move tape))
|
||||
(channel-event-to-tape u.channel request-id channel-event)
|
||||
=? moves ?=(^ said)
|
||||
(weld moves -.u.said)
|
||||
=* sending &(?=([%| *] state.u.channel) ?=(^ said))
|
||||
::
|
||||
=/ next-id next-id.u.channel
|
||||
:: if we can send it, store the event as unacked
|
||||
::
|
||||
=? events.u.channel ?=(^ json)
|
||||
=? events.u.channel ?=(^ said)
|
||||
%- ~(put to events.u.channel)
|
||||
[next-id request-id (sign-to-channel-event sign)]
|
||||
[next-id request-id channel-event]
|
||||
:: if it makes sense to do so, send the event to the client
|
||||
::
|
||||
=? moves sending
|
||||
@ -1611,11 +1704,11 @@
|
||||
::
|
||||
^= data
|
||||
%- wall-to-octs
|
||||
(event-json-to-wall next-id (need json))
|
||||
(event-tape-to-wall next-id +:(need said))
|
||||
::
|
||||
complete=%.n
|
||||
==
|
||||
=? next-id ?=(^ json) +(next-id)
|
||||
=? next-id ?=(^ said) +(next-id)
|
||||
:: update channel's unacked counts, find out if clogged
|
||||
::
|
||||
=^ clogged unacked.u.channel
|
||||
@ -1623,7 +1716,7 @@
|
||||
:: and of course don't count events we can't send as unacked.
|
||||
::
|
||||
?: ?| !?=(%fact -.sign)
|
||||
?=(~ json)
|
||||
?=(~ said)
|
||||
==
|
||||
[| unacked.u.channel]
|
||||
=/ num=@ud
|
||||
@ -1635,11 +1728,11 @@
|
||||
:: if we're clogged, or we ran into an event we can't serialize,
|
||||
:: kill this gall subscription.
|
||||
::
|
||||
=* msg=tape "on {(trip channel-id)} for {(trip request-id)}"
|
||||
=* msg=tape "on {(trip channel-id)} for {(scow %ud request-id)}"
|
||||
=/ kicking=?
|
||||
?: clogged
|
||||
((trace 0 |.("clogged {msg}")) &)
|
||||
?. ?=(~ json) |
|
||||
?. ?=(~ said) |
|
||||
((trace 0 |.("can't serialize event, kicking {msg}")) &)
|
||||
=? moves kicking
|
||||
:_ moves
|
||||
@ -1659,7 +1752,9 @@
|
||||
subscriptions (~(del by subscriptions.u.channel) request-id)
|
||||
unacked (~(del by unacked.u.channel) request-id)
|
||||
events %- ~(put to events.u.channel)
|
||||
[next-id request-id (sign-to-channel-event %kick ~)]
|
||||
:+ next-id
|
||||
request-id
|
||||
(need (sign-to-channel-event [%kick ~] u.channel request-id))
|
||||
==
|
||||
:: if a client is connected, send the kick event to them
|
||||
::
|
||||
@ -1671,8 +1766,8 @@
|
||||
::
|
||||
^= data
|
||||
%- wall-to-octs
|
||||
%+ event-json-to-wall next-id
|
||||
+:(need (sign-to-json u.channel request-id %kick ~))
|
||||
%+ event-tape-to-wall next-id
|
||||
+:(need (channel-event-to-tape u.channel request-id %kick ~))
|
||||
::
|
||||
complete=%.n
|
||||
==
|
||||
@ -1687,10 +1782,12 @@
|
||||
:: +sign-to-channel-event: strip the vase from a sign:agent:gall
|
||||
::
|
||||
++ sign-to-channel-event
|
||||
|= =sign:agent:gall
|
||||
^- channel-event
|
||||
?. ?=(%fact -.sign) sign
|
||||
[%fact [p q.q]:cage.sign]
|
||||
|= [=sign:agent:gall =channel request-id=@ud]
|
||||
^- (unit channel-event)
|
||||
?. ?=(%fact -.sign) `sign
|
||||
?~ desk=(app-to-desk channel request-id) ~
|
||||
:- ~
|
||||
[%fact u.desk [p q.q]:cage.sign]
|
||||
:: +app-to-desk
|
||||
::
|
||||
++ app-to-desk
|
||||
@ -1698,59 +1795,51 @@
|
||||
^- (unit desk)
|
||||
=/ sub (~(get by subscriptions.channel) request-id)
|
||||
?~ sub
|
||||
((trace 0 |.("no subscription for request-id {(trip request-id)}")) ~)
|
||||
((trace 0 |.("no subscription for request-id {(scow %ud request-id)}")) ~)
|
||||
=/ des=(unit (unit cage))
|
||||
(rof ~ %gd [our app.u.sub da+now] ~)
|
||||
(rof ~ %gd [our app.u.sub da+now] /$)
|
||||
?. ?=([~ ~ *] des)
|
||||
((trace 0 |.("no desk for app {<app.u.sub>}")) ~)
|
||||
`!<(=desk q.u.u.des)
|
||||
:: +channel-event-to-sign: attempt to recover a sign from a channel-event
|
||||
:: +channel-event-to-tape: render channel-event from request-id in specified mode
|
||||
::
|
||||
++ channel-event-to-sign
|
||||
~% %eyre-channel-event-to-sign ..part ~
|
||||
++ channel-event-to-tape
|
||||
|= [=channel request-id=@ud =channel-event]
|
||||
^- (unit (quip move tape))
|
||||
?- mode.channel
|
||||
%json %+ bind (channel-event-to-json channel request-id channel-event)
|
||||
|=((quip move json) [+<- (en-json:html +<+)])
|
||||
%jam =- `[~ (scow %uw (jam -))]
|
||||
[request-id channel-event]
|
||||
==
|
||||
:: +channel-event-to-json: render channel event as json channel event
|
||||
::
|
||||
++ channel-event-to-json
|
||||
~% %eyre-channel-event-to-json ..part ~
|
||||
|= [=channel request-id=@ud event=channel-event]
|
||||
^- (unit sign:agent:gall)
|
||||
?. ?=(%fact -.event) `event
|
||||
:: rebuild vase for fact data
|
||||
::
|
||||
=/ des=(unit desk) (app-to-desk channel request-id)
|
||||
?~ des ~
|
||||
=* have=mark mark.event
|
||||
=/ val=(unit (unit cage))
|
||||
(rof ~ %cb [our u.des da+now] /[have])
|
||||
?. ?=([~ ~ *] val)
|
||||
((trace 0 |.("no mark {(trip have)}")) ~)
|
||||
=+ !<(=dais:clay q.u.u.val)
|
||||
=/ res (mule |.((vale:dais noun.event)))
|
||||
?: ?=(%| -.res)
|
||||
((trace 0 |.("stale fact of mark {(trip have)}")) ~)
|
||||
`[%fact have p.res]
|
||||
:: +sign-to-json: render sign from request-id as json channel event
|
||||
::
|
||||
++ sign-to-json
|
||||
~% %sign-to-json ..part ~
|
||||
|= [=channel request-id=@ud =sign:agent:gall]
|
||||
^- (unit (quip move json))
|
||||
:: for facts, we try to convert the result to json
|
||||
::
|
||||
=/ [from=(unit [=desk =mark]) jsyn=(unit sign:agent:gall)]
|
||||
?. ?=(%fact -.sign) [~ `sign]
|
||||
?: ?=(%json p.cage.sign) [~ `sign]
|
||||
?. ?=(%fact -.event) [~ `event]
|
||||
?: ?=(%json mark.event)
|
||||
?~ jsin=((soft json) noun.event)
|
||||
%. [~ ~]
|
||||
(slog leaf+"eyre: dropping fake json for {(scow %ud request-id)}" ~)
|
||||
[~ `[%fact %json !>(u.jsin)]]
|
||||
:: find and use tube from fact mark to json
|
||||
::
|
||||
=/ des=(unit desk) (app-to-desk channel request-id)
|
||||
?~ des [~ ~]
|
||||
::
|
||||
=* have=mark p.cage.sign
|
||||
=* have=mark mark.event
|
||||
=/ convert=(unit vase)
|
||||
=/ cag=(unit (unit cage))
|
||||
(rof ~ %cf [our u.des da+now] /[have]/json)
|
||||
(rof ~ %cf [our desk.event da+now] /[have]/json)
|
||||
?. ?=([~ ~ *] cag) ~
|
||||
`q.u.u.cag
|
||||
?~ convert
|
||||
((trace 0 |.("no convert from {(trip have)} to json")) [~ ~])
|
||||
~| "conversion failed from {(trip have)} to json"
|
||||
[`[u.des have] `[%fact %json (slym u.convert q.q.cage.sign)]]
|
||||
[`[desk.event have] `[%fact %json (slym u.convert noun.event)]]
|
||||
?~ jsyn ~
|
||||
%- some
|
||||
:- ?~ from ~
|
||||
@ -1793,12 +1882,12 @@
|
||||
==
|
||||
==
|
||||
::
|
||||
++ event-json-to-wall
|
||||
~% %eyre-json-to-wall ..part ~
|
||||
|= [event-id=@ud =json]
|
||||
++ event-tape-to-wall
|
||||
~% %eyre-tape-to-wall ..part ~
|
||||
|= [event-id=@ud =tape]
|
||||
^- wall
|
||||
:~ (weld "id: " (format-ud-as-integer event-id))
|
||||
(weld "data: " (en-json:html json))
|
||||
(weld "data: " tape)
|
||||
""
|
||||
==
|
||||
::
|
||||
@ -2007,7 +2096,7 @@
|
||||
::
|
||||
=. connections.state
|
||||
%. (~(del by connections.state) duct)
|
||||
(trace 2 |.("{<duct>} completed"))
|
||||
(trace 2 |.("{<duct>} completed"))
|
||||
state
|
||||
::
|
||||
++ error-connection
|
||||
@ -2032,6 +2121,15 @@
|
||||
%leave ~
|
||||
==
|
||||
--
|
||||
:: +set-response: remember (or update) a cache mapping
|
||||
::
|
||||
++ set-response
|
||||
|= [url=@t entry=(unit cache-entry)]
|
||||
^- [(list move) server-state]
|
||||
=/ aeon ?^(prev=(~(get by cache.state) url) +(aeon.u.prev) 1)
|
||||
=. cache.state (~(put by cache.state) url [aeon entry])
|
||||
:_ state
|
||||
[outgoing-duct.state %give %grow /cache/(scot %ud aeon)/(scot %t url)]~
|
||||
:: +add-binding: conditionally add a pairing between binding and action
|
||||
::
|
||||
:: Adds =binding =action if there is no conflicting bindings.
|
||||
@ -2109,6 +2207,8 @@
|
||||
::
|
||||
=/ request-line (parse-request-line url)
|
||||
=/ parsed-url=(list @t) site.request-line
|
||||
=? parsed-url ?=([%'~' %channel-jam *] parsed-url)
|
||||
parsed-url(i.t %channel)
|
||||
::
|
||||
=/ bindings bindings.state
|
||||
|-
|
||||
@ -2318,6 +2418,12 @@
|
||||
:: save duct for future %give to unix
|
||||
::
|
||||
=. outgoing-duct.server-state.ax duct
|
||||
:: send all cache mappings to runtime
|
||||
::
|
||||
=/ cache-moves=(list move)
|
||||
%+ turn ~(tap by cache.server-state.ax)
|
||||
|= [url=@t cache-val=[aeon=@ud val=(unit cache-entry)]]
|
||||
[duct %give %grow /cache/(scot %u aeon.cache-val)/(scot %t url)]
|
||||
::
|
||||
:_ http-server-gate
|
||||
:* :: hand back default configuration for now
|
||||
@ -2328,7 +2434,7 @@
|
||||
=< give-session-tokens
|
||||
(per-server-event [eny duct now rof] server-state.ax)
|
||||
::
|
||||
closed-connections
|
||||
(zing ~[closed-connections cache-moves])
|
||||
==
|
||||
::
|
||||
?: ?=(%code-changed -.task)
|
||||
@ -2447,6 +2553,10 @@
|
||||
%spew
|
||||
=. verb.server-state.ax veb.task
|
||||
`http-server-gate
|
||||
::
|
||||
%set-response
|
||||
=^ moves server-state.ax (set-response:server +.task)
|
||||
[moves http-server-gate]
|
||||
==
|
||||
::
|
||||
++ take
|
||||
@ -2595,6 +2705,9 @@
|
||||
::
|
||||
?^ error.sign
|
||||
[[duct %slip %d %flog %crud %wake u.error.sign]~ http-server-gate]
|
||||
::NOTE we are not concerned with expiring channels that are still in
|
||||
:: use. we require acks for messages, which bump their session's
|
||||
:: timer. channels have their own expiry timer, too.
|
||||
:: remove cookies that have expired
|
||||
::
|
||||
=* sessions sessions.authentication-state.server-state.ax
|
||||
@ -2636,67 +2749,137 @@
|
||||
++ load
|
||||
=> |%
|
||||
+$ axle-any
|
||||
$% [%~2020.10.18 =server-state-0]
|
||||
[%~2022.7.26 =server-state-0]
|
||||
[%~2023.2.17 =server-state]
|
||||
$% [date=%~2020.10.18 server-state=server-state-0]
|
||||
[date=%~2022.7.26 server-state=server-state-0]
|
||||
[date=%~2023.2.17 server-state=server-state-1]
|
||||
[date=%~2023.3.16 server-state=server-state-2]
|
||||
[date=%~2023.4.11 =server-state]
|
||||
==
|
||||
::
|
||||
+$ server-state-0
|
||||
$: bindings=(list [=binding =duct =action])
|
||||
=cors-registry
|
||||
connections=(map duct outstanding-connection)
|
||||
=authentication-state
|
||||
=channel-state
|
||||
channel-state=channel-state-2
|
||||
domains=(set turf)
|
||||
=http-config
|
||||
ports=[insecure=@ud secure=(unit @ud)]
|
||||
outgoing-duct=duct
|
||||
==
|
||||
::
|
||||
+$ server-state-1
|
||||
$: bindings=(list [=binding =duct =action])
|
||||
=cors-registry
|
||||
connections=(map duct outstanding-connection)
|
||||
=authentication-state
|
||||
channel-state=channel-state-2
|
||||
domains=(set turf)
|
||||
=http-config
|
||||
ports=[insecure=@ud secure=(unit @ud)]
|
||||
outgoing-duct=duct
|
||||
verb=@ :: <- new
|
||||
==
|
||||
::
|
||||
+$ server-state-2
|
||||
$: bindings=(list [=binding =duct =action])
|
||||
cache=(map url=@t [aeon=@ud val=(unit cache-entry)]) :: <- new
|
||||
=cors-registry
|
||||
connections=(map duct outstanding-connection)
|
||||
=authentication-state
|
||||
channel-state=channel-state-2
|
||||
domains=(set turf)
|
||||
=http-config
|
||||
ports=[insecure=@ud secure=(unit @ud)]
|
||||
outgoing-duct=duct
|
||||
verb=@
|
||||
==
|
||||
+$ channel-state-2
|
||||
$: session=(map @t channel-2)
|
||||
duct-to-key=(map duct @t)
|
||||
==
|
||||
+$ channel-2
|
||||
$: state=(each timer duct)
|
||||
next-id=@ud
|
||||
last-ack=@da
|
||||
events=(qeu [id=@ud request-id=@ud channel-event=channel-event-2])
|
||||
unacked=(map @ud @ud)
|
||||
subscriptions=(map @ud [ship=@p app=term =path duc=duct])
|
||||
heartbeat=(unit timer)
|
||||
==
|
||||
+$ channel-event-2
|
||||
$% $>(%poke-ack sign:agent:gall)
|
||||
$>(%watch-ack sign:agent:gall)
|
||||
$>(%kick sign:agent:gall)
|
||||
[%fact =mark =noun]
|
||||
==
|
||||
--
|
||||
|= old=axle-any
|
||||
^+ ..^$
|
||||
^+ http-server-gate
|
||||
?- -.old
|
||||
::
|
||||
:: adds /~/name
|
||||
::
|
||||
%~2020.10.18
|
||||
=, server-state-0.old
|
||||
%= ..^$
|
||||
ax ^- axle
|
||||
:* %~2023.2.17
|
||||
(insert-binding [[~ /~/name] outgoing-duct [%name ~]] bindings)
|
||||
cors-registry
|
||||
connections
|
||||
authentication-state
|
||||
channel-state
|
||||
domains
|
||||
http-config
|
||||
ports
|
||||
outgoing-duct
|
||||
0
|
||||
== ==
|
||||
%= $
|
||||
date.old %~2022.7.26
|
||||
::
|
||||
bindings.server-state.old
|
||||
%+ insert-binding
|
||||
[[~ /~/name] outgoing-duct.server-state.old [%name ~]]
|
||||
bindings.server-state.old
|
||||
==
|
||||
::
|
||||
:: enables https redirects if certificate configured
|
||||
:: inits .verb
|
||||
::
|
||||
%~2022.7.26
|
||||
=, server-state-0.old
|
||||
%= ..^$
|
||||
ax ^- axle
|
||||
:* %~2023.2.17
|
||||
bindings
|
||||
cors-registry
|
||||
connections
|
||||
authentication-state
|
||||
channel-state
|
||||
domains
|
||||
http-config
|
||||
ports
|
||||
outgoing-duct
|
||||
0
|
||||
== ==
|
||||
::
|
||||
%~2023.2.17
|
||||
:: enable https redirects if certificate configured
|
||||
::
|
||||
=. redirect.http-config.server-state.old
|
||||
?& ?=(^ secure.ports.server-state.old)
|
||||
?=(^ secure.http-config.server-state.old)
|
||||
==
|
||||
..^$(ax old)
|
||||
$(old [%~2023.2.17 server-state.old(|8 [|8 verb=0]:server-state.old)])
|
||||
::
|
||||
:: inits .cache
|
||||
::
|
||||
%~2023.2.17
|
||||
$(old [%~2023.3.16 [bindings ~ +]:server-state.old])
|
||||
::
|
||||
:: inits channel mode and desks in unacked events
|
||||
::
|
||||
%~2023.3.16
|
||||
::
|
||||
:: Prior to this desks were not part of events.channel.
|
||||
:: When serializing we used to rely on the desk stored in
|
||||
:: subscriptions.channel, but this state is deleted when we clog.
|
||||
:: This migration adds the desk to events.channel, but we can not
|
||||
:: scry in +load to populate the desks in the old events,
|
||||
:: so we just kick all subscriptions on all channels.
|
||||
%= $
|
||||
date.old %~2023.4.11
|
||||
::
|
||||
server-state.old
|
||||
%= server-state.old
|
||||
session.channel-state
|
||||
%- ~(run by session.channel-state.server-state.old)
|
||||
|= c=channel-2
|
||||
=; new-events
|
||||
:- %json
|
||||
c(events new-events, unacked ~, subscriptions ~)
|
||||
=| events=(qeu [id=@ud request-id=@ud =channel-event])
|
||||
=/ l ~(tap in ~(key by subscriptions.c))
|
||||
|-
|
||||
?~ l events
|
||||
%= $
|
||||
l t.l
|
||||
next-id.c +(next-id.c)
|
||||
events (~(put to events) [next-id.c i.l %kick ~])
|
||||
==
|
||||
==
|
||||
==
|
||||
::
|
||||
%~2023.4.11
|
||||
http-server-gate(ax old)
|
||||
==
|
||||
:: +stay: produce current state
|
||||
::
|
||||
@ -2717,15 +2900,7 @@
|
||||
?. ?=(%& -.why)
|
||||
~
|
||||
=* who p.why
|
||||
?: =(tyl /whey)
|
||||
=/ maz=(list mass)
|
||||
:~ bindings+&+bindings.server-state.ax
|
||||
auth+&+authentication-state.server-state.ax
|
||||
connections+&+connections.server-state.ax
|
||||
channels+&+channel-state.server-state.ax
|
||||
axle+&+ax
|
||||
==
|
||||
``mass+!>(maz)
|
||||
::
|
||||
?. ?=(%$ -.lot)
|
||||
[~ ~]
|
||||
?. =(our who)
|
||||
@ -2733,9 +2908,17 @@
|
||||
[~ ~]
|
||||
~& [%r %scry-foreign-host who]
|
||||
~
|
||||
?: &(?=(%x ren) ?=(~ syd))
|
||||
?: &(?=(%x ren) ?=(%$ syd))
|
||||
=, server-state.ax
|
||||
?+ tyl [~ ~]
|
||||
[%$ %whey ~] =- ``mass+!>(`(list mass)`-)
|
||||
:~ bindings+&+bindings.server-state.ax
|
||||
auth+&+authentication-state.server-state.ax
|
||||
connections+&+connections.server-state.ax
|
||||
channels+&+channel-state.server-state.ax
|
||||
axle+&+ax
|
||||
==
|
||||
::
|
||||
[%cors ~] ``noun+!>(cors-registry)
|
||||
[%cors %requests ~] ``noun+!>(requests.cors-registry)
|
||||
[%cors %approved ~] ``noun+!>(approved.cors-registry)
|
||||
@ -2757,6 +2940,14 @@
|
||||
%- =< request-is-logged-in:authentication
|
||||
(per-server-event [eny *duct now rof] server-state.ax)
|
||||
%*(. *request:http header-list ['cookie' u.cookies]~)
|
||||
::
|
||||
[%cache @ @ ~]
|
||||
?~ aeon=(slaw %ud i.t.tyl) [~ ~]
|
||||
?~ url=(slaw %t i.t.t.tyl) [~ ~]
|
||||
?~ entry=(~(get by cache) u.url) [~ ~]
|
||||
?. =(u.aeon aeon.u.entry) [~ ~]
|
||||
?~ val=val.u.entry [~ ~]
|
||||
``noun+!>(u.val)
|
||||
==
|
||||
?. ?=(%$ ren)
|
||||
[~ ~]
|
||||
|
||||
@ -42,9 +42,9 @@
|
||||
:: $move: Arvo-level move
|
||||
::
|
||||
+$ move [=duct move=(wind note-arvo gift-arvo)]
|
||||
:: $state-11: overall gall state, versioned
|
||||
:: $state-12: overall gall state, versioned
|
||||
::
|
||||
+$ state-11 [%11 state]
|
||||
+$ state-12 [%12 state]
|
||||
:: $state: overall gall state
|
||||
::
|
||||
:: system-duct: TODO document
|
||||
@ -81,20 +81,31 @@
|
||||
:: agent: agent core
|
||||
:: beak: compilation source
|
||||
:: marks: mark conversion requests
|
||||
:: sky: scry bindings
|
||||
::
|
||||
+$ yoke
|
||||
$: control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=_1
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=*
|
||||
agent=(each agent vase)
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
$% [%nuke sky=(map spur @ud)]
|
||||
$: %live
|
||||
control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=_1
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=*
|
||||
agent=(each agent vase)
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
== ==
|
||||
::
|
||||
+$ path-state
|
||||
$: bob=(unit @ud)
|
||||
fan=((mop @ud (pair @da (each page @uvI))) lte)
|
||||
==
|
||||
::
|
||||
++ on-path ((on @ud (pair @da (each page @uvI))) lte)
|
||||
:: $blocked-move: enqueued move to an agent
|
||||
::
|
||||
+$ blocked-move [=duct =routes move=(each deal unto)]
|
||||
@ -149,7 +160,7 @@
|
||||
:: $spore: structures for update, produced by +stay
|
||||
::
|
||||
+$ spore
|
||||
$: %11
|
||||
$: %12
|
||||
system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
@ -160,22 +171,25 @@
|
||||
:: $egg: migratory agent state; $yoke with .old-state instead of .agent
|
||||
::
|
||||
+$ egg
|
||||
$: control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=@
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=~
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
==
|
||||
$% [%nuke sky=(map spur @ud)]
|
||||
$: %live
|
||||
control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=@
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=~
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
== ==
|
||||
--
|
||||
:: adult gall vane interface, for type compatibility with pupa
|
||||
::
|
||||
=| state=state-11
|
||||
=| state=state-12
|
||||
|= [now=@da eny=@uvJ rof=roof]
|
||||
=* gall-payload .
|
||||
~% %gall-top ..part ~
|
||||
@ -239,6 +253,7 @@
|
||||
(drop (bind (~(get by yokes.state) u.dude) (lead u.dude)))
|
||||
|- ^+ mo-core
|
||||
?~ apps mo-core
|
||||
?: ?=(%nuke -.q.i.apps) $(apps t.apps)
|
||||
=/ ap-core (ap-yoke:ap p.i.apps [~ our] q.i.apps)
|
||||
$(apps t.apps, mo-core ap-abet:(ap-doff:ap-core ship))
|
||||
:: +mo-rake: send %cork's for old subscriptions if needed
|
||||
@ -251,6 +266,7 @@
|
||||
(drop (bind (~(get by yokes.state) u.dude) (lead u.dude)))
|
||||
|- ^+ mo-core
|
||||
?~ apps mo-core
|
||||
?: ?=(%nuke -.q.i.apps) $(apps t.apps)
|
||||
=/ ap-core (ap-yoke:ap p.i.apps [~ our] q.i.apps)
|
||||
$(apps t.apps, mo-core ap-abet:(ap-rake:ap-core all))
|
||||
:: +mo-receive-core: receives an app core built by %ford.
|
||||
@ -273,6 +289,7 @@
|
||||
=/ yak (~(get by yokes.state) dap)
|
||||
=/ tex=(unit tape)
|
||||
?~ yak `"installing"
|
||||
?: ?=(%nuke -.u.yak) `"unnuking" ::TODO good message here?
|
||||
?- -.agent.u.yak
|
||||
%| `"reviving"
|
||||
%&
|
||||
@ -283,7 +300,7 @@
|
||||
=+ ?~ tex ~
|
||||
~> %slog.[0 leaf+"gall: {u.tex} {<dap>}"] ~
|
||||
::
|
||||
?^ yak
|
||||
?: ?=([~ %live *] yak)
|
||||
?: &(=(q.beak.u.yak q.bek) =(code.u.yak agent) =(-.agent.u.yak &))
|
||||
mo-core
|
||||
::
|
||||
@ -296,12 +313,15 @@
|
||||
::
|
||||
=. yokes.state
|
||||
%+ ~(put by yokes.state) dap
|
||||
%* . *yoke
|
||||
control-duct hen
|
||||
beak bek
|
||||
code agent
|
||||
agent &+agent
|
||||
run-nonce (scot %uw (end 5 (shas %yoke-nonce eny)))
|
||||
%* . *$>(%live yoke)
|
||||
control-duct hen
|
||||
beak bek
|
||||
code agent
|
||||
agent &+agent
|
||||
run-nonce (scot %uw (end 5 (shas %yoke-nonce eny)))
|
||||
sky
|
||||
?~ yak ~
|
||||
(~(run by sky.u.yak) (corl (late ~) (lead ~)))
|
||||
==
|
||||
::
|
||||
=/ old mo-core
|
||||
@ -594,7 +614,7 @@
|
||||
::
|
||||
=/ dap=term i.wire
|
||||
=/ yoke (~(get by yokes.state) dap)
|
||||
?~ yoke
|
||||
?. ?=([~ %live *] yoke)
|
||||
%- (slog leaf+"gall: {<dap>} dead, got {<+<.sign-arvo>}" ~)
|
||||
mo-core
|
||||
?. =(run-nonce.u.yoke i.t.wire)
|
||||
@ -695,7 +715,14 @@
|
||||
mo-core
|
||||
~> %slog.0^leaf/"gall: nuking {<dap>}"
|
||||
=. mo-core ap-abet:ap-nuke:(ap-abed:ap dap `our)
|
||||
mo-core(yokes.state (~(del by yokes.state) dap))
|
||||
=- mo-core(yokes.state -)
|
||||
%+ ~(jab by yokes.state) dap
|
||||
|= =yoke
|
||||
?: ?=(%nuke -.yoke) yoke
|
||||
:- %nuke
|
||||
%- ~(run by sky.yoke)
|
||||
|= path-state
|
||||
(fall (clap bob (bind (ram:on-path fan) head) max) 0)
|
||||
:: +mo-load: install agents
|
||||
::
|
||||
++ mo-load
|
||||
@ -708,7 +735,8 @@
|
||||
$(agents t.agents, mo-core (mo-receive-core i.agents))
|
||||
::
|
||||
=/ kil
|
||||
=/ lol (skim ~(tap by yokes.state) |=([term yoke] -.agent))
|
||||
=/ lol
|
||||
(skim ~(tap by yokes.state) |=([* y=yoke] &(?=(%live -.y) -.agent.y)))
|
||||
=/ mol (~(gas by *(map term yoke)) lol)
|
||||
=/ sol ~(key by mol)
|
||||
=/ new (silt (turn agents head))
|
||||
@ -735,8 +763,9 @@
|
||||
(mo-apply-sure dap routes deal)
|
||||
::
|
||||
%raw-poke
|
||||
=/ =case:clay da+now
|
||||
=/ =desk q.beak:(~(got by yokes.state) dap)
|
||||
=/ =case da+now
|
||||
=/ yok (~(got by yokes.state) dap)
|
||||
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
|
||||
=/ sky (rof ~ %cb [our desk case] /[mark.deal])
|
||||
?- sky
|
||||
?(~ [~ ~])
|
||||
@ -756,10 +785,11 @@
|
||||
==
|
||||
::
|
||||
%poke-as
|
||||
=/ =case:clay da+now
|
||||
=/ =case da+now
|
||||
=/ =mars:clay [p.cage mark]:deal
|
||||
=/ mars-path /[a.mars]/[b.mars]
|
||||
=/ =desk q.beak:(~(got by yokes.state) dap)
|
||||
=/ yok (~(got by yokes.state) dap)
|
||||
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
|
||||
=/ sky (rof ~ %cc [our desk case] mars-path)
|
||||
?- sky
|
||||
?(~ [~ ~])
|
||||
@ -796,7 +826,7 @@
|
||||
::
|
||||
=/ =routes [disclosing=~ attributing=ship]
|
||||
=/ running (~(get by yokes.state) agent)
|
||||
=/ is-running ?~(running %| ?=(%& -.agent.u.running))
|
||||
=/ is-running &(?=([~ %live *] running) ?=(%& -.agent.u.running))
|
||||
=/ is-blocked (~(has by blocked.state) agent)
|
||||
:: agent is running; deliver move normally
|
||||
::
|
||||
@ -867,7 +897,7 @@
|
||||
agent-duct=duct
|
||||
agent-moves=(list move)
|
||||
agent-config=(list (each suss tang))
|
||||
=yoke
|
||||
=$>(%live yoke)
|
||||
==
|
||||
::
|
||||
++ trace
|
||||
@ -892,11 +922,13 @@
|
||||
~/ %ap-abed
|
||||
|= [dap=term =routes]
|
||||
^+ ap-core
|
||||
(ap-yoke dap routes (~(got by yokes.state) dap))
|
||||
%^ ap-yoke dap routes
|
||||
=< ?>(?=(%live -) .)
|
||||
(~(got by yokes.state) dap)
|
||||
:: +ap-yoke: initialize agent state, starting from a $yoke
|
||||
::
|
||||
++ ap-yoke
|
||||
|= [dap=term =routes yak=^yoke]
|
||||
|= [dap=term =routes yak=$>(%live ^yoke)]
|
||||
^+ ap-core
|
||||
=. stats.yak
|
||||
:+ +(change.stats.yak)
|
||||
@ -944,6 +976,63 @@
|
||||
[%pass wire %agent dock %leave ~]
|
||||
=^ maybe-tang ap-core (ap-ingest ~ |.([will *agent]))
|
||||
ap-core
|
||||
:: +ap-grow: bind a path in the agent's scry namespace
|
||||
::
|
||||
++ ap-grow
|
||||
|= [=spur =page]
|
||||
^+ ap-core
|
||||
=- ap-core(sky.yoke -)
|
||||
%+ ~(put by sky.yoke) spur
|
||||
=/ ski (~(gut by sky.yoke) spur *path-state)
|
||||
=- ski(fan (put:on-path fan.ski -< -> &/page))
|
||||
?~ las=(ram:on-path fan.ski)
|
||||
[(fall bob.ski 0) now]
|
||||
:_ (max now +(p.val.u.las))
|
||||
?~(bob.ski +(key.u.las) +((max key.u.las u.bob.ski)))
|
||||
:: +ap-tomb: tombstone -- replace bound value with hash
|
||||
::
|
||||
++ ap-tomb
|
||||
|= [=case =spur]
|
||||
^+ ap-core
|
||||
=- ap-core(sky.yoke -)
|
||||
=/ yon ?>(?=(%ud -.case) p.case)
|
||||
=/ old (~(get by sky.yoke) spur)
|
||||
?~ old :: no-op if nonexistent
|
||||
%. sky.yoke
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf+"gall: {<agent-name>}: tomb {<[case spur]>} no sky"]~
|
||||
=/ val (get:on-path fan.u.old yon)
|
||||
?~ val :: no-op if nonexistent
|
||||
%. sky.yoke
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf+"gall: {<agent-name>}: tomb {<[case spur]>} no val"]~
|
||||
?- -.q.u.val
|
||||
%| :: already tombstoned, no-op
|
||||
%. sky.yoke
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf+"gall: {<agent-name>}: tomb {<[case spur]>} no-op"]~
|
||||
::
|
||||
%& :: replace with hash
|
||||
%+ ~(put by sky.yoke) spur
|
||||
u.old(fan (put:on-path fan.u.old yon u.val(q |/(shax (jam p.q.u.val)))))
|
||||
==
|
||||
:: +ap-cull: delete all bindings up to and including .case
|
||||
::
|
||||
:: Also store .case as the high water mark for .spur
|
||||
:: to prevent any deleted cases from being re-bound later.
|
||||
::
|
||||
++ ap-cull
|
||||
|= [=case =spur]
|
||||
^+ ap-core
|
||||
=- ap-core(sky.yoke -)
|
||||
=/ yon ?>(?=(%ud -.case) p.case)
|
||||
=/ old (~(get by sky.yoke) spur)
|
||||
?~ old :: no-op if nonexistent
|
||||
%. sky.yoke
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf+"gall: {<agent-name>}: cull {<[case spur]>} no-op"]~
|
||||
%+ ~(put by sky.yoke) spur :: delete all older paths
|
||||
[`yon (lot:on-path fan.u.old `+(yon) ~)]
|
||||
:: +ap-from-internal: internal move to move.
|
||||
::
|
||||
:: We convert from cards to duct-indexed moves when resolving
|
||||
@ -952,14 +1041,17 @@
|
||||
:: We accept %huck to "fake" being a message to a ship but
|
||||
:: actually send it to a vane.
|
||||
::
|
||||
+$ neet
|
||||
$% neat
|
||||
+$ carp $+ carp (wind neet gift:agent)
|
||||
+$ neet $+ neet
|
||||
$< ?(%grow %tomb %cull)
|
||||
$% note:agent
|
||||
[%agent [=ship name=term] task=[%raw-poke =mark =noun]]
|
||||
[%huck [=ship name=term] =note-arvo]
|
||||
==
|
||||
::
|
||||
++ ap-from-internal
|
||||
~/ %ap-from-internal
|
||||
|= card=(wind neet gift:agent)
|
||||
|= card=carp
|
||||
^- (list move)
|
||||
::
|
||||
?- -.card
|
||||
@ -991,7 +1083,7 @@
|
||||
?: =(mark p.cage)
|
||||
[duct %give %unto %fact cage.gift]~
|
||||
=/ =mars:clay [p.cage mark]
|
||||
=/ =case:clay da+now
|
||||
=/ =case da+now
|
||||
=/ bek=beak [our q.beak.yoke case]
|
||||
=/ mars-path /[a.mars]/[b.mars]
|
||||
=/ sky (rof ~ %cc bek mars-path)
|
||||
@ -1033,9 +1125,9 @@
|
||||
::
|
||||
=/ =note-arvo
|
||||
?- -.neet
|
||||
%arvo note-arvo.neet
|
||||
%arvo +.neet
|
||||
%huck note-arvo.neet
|
||||
%agent [%g %deal [our ship.neet] [name deal]:neet]
|
||||
%agent [%g %deal [our ship.neet] [name task]:neet]
|
||||
==
|
||||
[duct %pass wire note-arvo]~
|
||||
==
|
||||
@ -1201,6 +1293,7 @@
|
||||
== ::
|
||||
:* wex=boat.yoke :: outgoing
|
||||
sup=bitt.yoke :: incoming
|
||||
sky=(~(run by sky.yoke) tail) :: bindings
|
||||
== ::
|
||||
:* act=change.stats.yoke :: tick
|
||||
eny=eny.stats.yoke :: nonce
|
||||
@ -1291,7 +1384,7 @@
|
||||
=^ =sign:agent ap-core
|
||||
?. ?=(%raw-fact -.unto)
|
||||
[unto ap-core]
|
||||
=/ =case:clay da+now
|
||||
=/ =case da+now
|
||||
?: ?=(%spider agent-name)
|
||||
:- [%fact mark.unto !>(noun.unto)]
|
||||
ap-core
|
||||
@ -1600,7 +1693,7 @@
|
||||
=/ ack-moves=(list move)
|
||||
%- zing
|
||||
%- turn :_ ap-from-internal
|
||||
^- (list card:agent)
|
||||
^- (list carp)
|
||||
?- ack
|
||||
~ ~
|
||||
%poke-ack [%give %poke-ack maybe-tang]~
|
||||
@ -1620,9 +1713,25 @@
|
||||
`ap-core
|
||||
::
|
||||
=. agent.yoke &++.p.result
|
||||
=/ moves (zing (turn -.p.result ap-from-internal))
|
||||
=^ fex ap-core (ap-handle-sky -.p.result)
|
||||
=/ moves (zing (turn fex ap-from-internal))
|
||||
=. bitt.yoke (ap-handle-kicks moves)
|
||||
(ap-handle-peers moves)
|
||||
:: +ap-handle-sky: apply effects to the agent's scry namespace
|
||||
::
|
||||
++ ap-handle-sky
|
||||
=| fex=(list carp)
|
||||
|= caz=(list card:agent)
|
||||
^+ [fex ap-core]
|
||||
?~ caz [(flop fex) ap-core]
|
||||
?- i.caz
|
||||
[%pass * %grow *] $(caz t.caz, ap-core (ap-grow +.q.i.caz))
|
||||
[%pass * %tomb *] $(caz t.caz, ap-core (ap-tomb +.q.i.caz))
|
||||
[%pass * %cull *] $(caz t.caz, ap-core (ap-cull +.q.i.caz))
|
||||
[%pass * ?(%agent %arvo %pyre) *] $(caz t.caz, fex [i.caz fex])
|
||||
[%give *] $(caz t.caz, fex [i.caz fex])
|
||||
[%slip *] !!
|
||||
==
|
||||
:: +ap-handle-kicks: handle cancels of bitt.watches
|
||||
::
|
||||
++ ap-handle-kicks
|
||||
@ -1765,10 +1874,33 @@
|
||||
=? old ?=(%8 -.old) (spore-8-to-9 old)
|
||||
=? old ?=(%9 -.old) (spore-9-to-10 old)
|
||||
=? old ?=(%10 -.old) (spore-10-to-11 old)
|
||||
?> ?=(%11 -.old)
|
||||
=? old ?=(%11 -.old) (spore-11-to-12 old)
|
||||
?> ?=(%12 -.old)
|
||||
gall-payload(state old)
|
||||
::
|
||||
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10)
|
||||
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10 spore-11)
|
||||
+$ spore-11
|
||||
$: %11
|
||||
system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
eggs=(map term egg-11)
|
||||
blocked=(map term (qeu blocked-move))
|
||||
=bug
|
||||
==
|
||||
+$ egg-11
|
||||
$: control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=@
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=~
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
==
|
||||
+$ spore-10
|
||||
$: %10
|
||||
system-duct=duct
|
||||
@ -1878,19 +2010,33 @@
|
||||
%+ murn ~(tap to q)
|
||||
|=(r=remote-request-9 ?:(?=(%cork r) ~ `r))
|
||||
::
|
||||
:: added sky
|
||||
::
|
||||
++ spore-11-to-12
|
||||
|= old=spore-11
|
||||
^- spore
|
||||
%= old
|
||||
- %12
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-11]
|
||||
^- egg
|
||||
live/e(marks [marks.e sky:*$>(%live egg)])
|
||||
==
|
||||
::
|
||||
:: removed live
|
||||
:: changed old-state from (each vase vase) to [%| vase]
|
||||
:: added code
|
||||
::
|
||||
++ spore-10-to-11
|
||||
|= old=spore-10
|
||||
^- spore
|
||||
^- spore-11
|
||||
%= old
|
||||
- %11
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-10]
|
||||
^- egg
|
||||
^- egg-11
|
||||
e(|3 |4.e(|4 `|8.e(old-state [%| p.old-state.e])))
|
||||
==
|
||||
--
|
||||
@ -1901,37 +2047,26 @@
|
||||
^- roon
|
||||
|= [lyc=gang care=term bem=beam]
|
||||
^- (unit (unit cage))
|
||||
=/ =shop &/p.bem
|
||||
=* ship p.bem
|
||||
=* dap q.bem
|
||||
=/ =coin $/r.bem
|
||||
=* path s.bem
|
||||
::
|
||||
?. ?=(%.y -.shop)
|
||||
~
|
||||
=/ =ship p.shop
|
||||
?: &(=(care %$) =(path /whey))
|
||||
=/ blocked
|
||||
=/ queued (~(run by blocked.state) |=((qeu blocked-move) [%.y +<]))
|
||||
(sort ~(tap by queued) aor)
|
||||
::
|
||||
=/ running
|
||||
%+ turn (sort ~(tap by yokes.state) aor)
|
||||
|= [dap=term =yoke]
|
||||
^- mass
|
||||
=/ met=(list mass)
|
||||
=/ dat (mo-peek:mo | dap [~ ship] %x /whey/mass)
|
||||
?: ?=(?(~ [~ ~]) dat) ~
|
||||
(fall ((soft (list mass)) q.q.u.u.dat) ~)
|
||||
?~ met
|
||||
dap^&+yoke
|
||||
dap^|+(welp met dot+&+yoke ~)
|
||||
::
|
||||
=/ maz=(list mass)
|
||||
:~ [%foreign %.y contacts.state]
|
||||
[%blocked %.n blocked]
|
||||
[%active %.n running]
|
||||
?: ?& ?=(%da -.r.bem)
|
||||
(gth p.r.bem now)
|
||||
==
|
||||
``mass+!>(maz)
|
||||
~
|
||||
::
|
||||
?. ?=([%$ *] path) :: [%$ *] is for the vane, all else is for the agent
|
||||
?. ?& =(our ship)
|
||||
=([%$ %da now] coin)
|
||||
== ~
|
||||
?. (~(has by yokes.state) dap) [~ ~]
|
||||
?. ?=(^ path) ~
|
||||
=/ =routes [~ ship]
|
||||
(mo-peek:mo & dap routes care path)
|
||||
::
|
||||
=> .(path t.path)
|
||||
::
|
||||
?: ?& =(%u care)
|
||||
=(~ path)
|
||||
@ -1941,7 +2076,7 @@
|
||||
=; hav=?
|
||||
[~ ~ noun+!>(hav)]
|
||||
=/ yok=(unit yoke) (~(get by yokes.state) dap)
|
||||
?~(yok | -.agent.u.yok)
|
||||
&(?=([~ %live *] yok) -.agent.u.yok)
|
||||
::
|
||||
?: ?& =(%d care)
|
||||
=(~ path)
|
||||
@ -1949,7 +2084,7 @@
|
||||
=(our ship)
|
||||
==
|
||||
=/ yok=(unit yoke) (~(get by yokes.state) dap)
|
||||
?~ yok
|
||||
?. ?=([~ %live *] yok)
|
||||
[~ ~]
|
||||
[~ ~ desk+!>(q.beak.u.yok)]
|
||||
::
|
||||
@ -1963,7 +2098,9 @@
|
||||
=* syd=desk dap
|
||||
%+ roll ~(tap by yokes.state)
|
||||
|= [[=dude =yoke] acc=(set [=dude live=?])]
|
||||
?. =(syd q.beak.yoke)
|
||||
?. ?& ?=(%live -.yoke)
|
||||
=(syd q.beak.yoke)
|
||||
==
|
||||
acc
|
||||
(~(put in acc) [dude -.agent.yoke])
|
||||
::
|
||||
@ -1974,14 +2111,17 @@
|
||||
==
|
||||
:+ ~ ~
|
||||
:- %nonces !> ^- (map dude @)
|
||||
(~(run by yokes.state) |=(yoke sub-nonce))
|
||||
%- malt %+ murn ~(tap by yokes.state)
|
||||
|= [=dude =yoke]
|
||||
?: ?=(%nuke -.yoke) ~ `[dude sub-nonce.yoke]
|
||||
::
|
||||
?: ?& =(%n care)
|
||||
?=([@ @ ^] path)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
==
|
||||
?~ yok=(~(get by yokes.state) dap)
|
||||
=/ yok (~(get by yokes.state) dap)
|
||||
?. ?=([~ %live *] yok)
|
||||
[~ ~]
|
||||
=/ [=^ship =term =wire]
|
||||
[(slav %p i.path) i.t.path t.t.path]
|
||||
@ -1989,16 +2129,95 @@
|
||||
[~ ~]
|
||||
[~ ~ atom+!>(u.nonce)]
|
||||
::
|
||||
?. =(our ship)
|
||||
~
|
||||
?. =([%$ %da now] coin)
|
||||
~
|
||||
?. (~(has by yokes.state) dap)
|
||||
[~ ~]
|
||||
?. ?=(^ path)
|
||||
~
|
||||
=/ =routes [~ ship]
|
||||
(mo-peek:mo & dap routes care path)
|
||||
?: ?& =(%w care)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
==
|
||||
=/ yok (~(get by yokes.state) q.bem)
|
||||
?. ?=([~ %live *] yok) [~ ~]
|
||||
?~ ski=(~(get by sky.u.yok) path) [~ ~]
|
||||
?~ las=(ram:on-path fan.u.ski) [~ ~]
|
||||
``case/!>(ud/key.u.las)
|
||||
::
|
||||
?: ?=(%x care)
|
||||
?. =(p.bem our) ~
|
||||
::
|
||||
?: ?=(%$ q.bem) :: app %$ reserved
|
||||
?+ path ~
|
||||
[%whey ~]
|
||||
=/ blocked
|
||||
=/ queued (~(run by blocked.state) |=((qeu blocked-move) [%.y +<]))
|
||||
(sort ~(tap by queued) aor)
|
||||
::
|
||||
=/ running
|
||||
%+ turn (sort ~(tap by yokes.state) aor)
|
||||
|= [dap=term =yoke]
|
||||
^- mass
|
||||
=/ met=(list mass)
|
||||
=/ dat (mo-peek:mo | dap [~ ship] %x /whey/mass)
|
||||
?: ?=(?(~ [~ ~]) dat) ~
|
||||
(fall ((soft (list mass)) q.q.u.u.dat) ~)
|
||||
?~ met
|
||||
dap^&+yoke
|
||||
dap^|+(welp met dot+&+yoke ~)
|
||||
::
|
||||
=/ maz=(list mass)
|
||||
:~ [%foreign %.y contacts.state]
|
||||
[%blocked %.n blocked]
|
||||
[%active %.n running]
|
||||
==
|
||||
``mass+!>(maz)
|
||||
==
|
||||
::
|
||||
?~ yok=(~(get by yokes.state) q.bem) ~
|
||||
?: ?=(%nuke -.u.yok) ~
|
||||
=/ ski (~(get by sky.u.yok) path)
|
||||
?~ ski ~
|
||||
=/ res=(unit (each page @uvI))
|
||||
?+ -.r.bem ~
|
||||
%ud (bind (get:on-path fan.u.ski p.r.bem) tail)
|
||||
%da
|
||||
%- head
|
||||
%^ (dip:on-path (unit (each page @uvI)))
|
||||
fan.u.ski
|
||||
~
|
||||
|= [res=(unit (each page @uvI)) @ud =@da val=(each page @uvI)]
|
||||
^- [new=(unit [@da _val]) stop=? res=(unit _val)]
|
||||
:- `[da val]
|
||||
?:((lte da p.r.bem) |/`val &/res)
|
||||
==
|
||||
?. ?=([~ %& *] res) ~
|
||||
``p.u.res(q !>(q.p.u.res))
|
||||
::
|
||||
?: ?& =(%t care)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
==
|
||||
=/ yok (~(get by yokes.state) q.bem)
|
||||
?. ?=([~ %live *] yok) ~
|
||||
:^ ~ ~ %file-list !> ^- (list ^path)
|
||||
%+ skim ~(tap in ~(key by sky.u.yok))
|
||||
|= =spur
|
||||
?& =(path (scag (lent path) spur))
|
||||
!=(path spur)
|
||||
==
|
||||
::
|
||||
?: ?& =(%z care)
|
||||
=(our ship)
|
||||
==
|
||||
=/ yok (~(get by yokes.state) q.bem)
|
||||
?. ?=([~ %live *] yok) ~
|
||||
?~ ski=(~(get by sky.u.yok) path) ~
|
||||
=/ res=(unit (pair @da (each noun @uvI)))
|
||||
?+ -.r.bem ~
|
||||
%ud (get:on-path fan.u.ski p.r.bem)
|
||||
%da ?.(=(p.r.bem now) ~ (bind (ram:on-path fan.u.ski) tail))
|
||||
==
|
||||
?+ res ~
|
||||
[~ @ %| *] ``noun/!>(p.q.u.res)
|
||||
[~ @ %& *] ``noun/!>(`@uvI`(shax (jam p.q.u.res)))
|
||||
==
|
||||
~
|
||||
:: +stay: save without cache; suspend non-%base agents
|
||||
::
|
||||
:: TODO: superfluous? see +molt
|
||||
@ -2009,6 +2228,7 @@
|
||||
%- ~(run by yokes.state)
|
||||
|= =yoke
|
||||
^- egg
|
||||
?: ?=(%nuke -.yoke) yoke
|
||||
%= yoke
|
||||
code ~
|
||||
agent
|
||||
|
||||
@ -395,7 +395,7 @@
|
||||
::
|
||||
?. ?=(%& -.why) ~
|
||||
=* his p.why
|
||||
?: &(=(ren %$) =(tyl /whey))
|
||||
?: &(?=(%x ren) =(tyl //whey))
|
||||
=/ maz=(list mass)
|
||||
:~ nex+&+next-id.state.ax
|
||||
outbound+&+outbound-duct.state.ax
|
||||
|
||||
@ -1066,13 +1066,15 @@
|
||||
:: XX review for security, stability, cases other than now
|
||||
::
|
||||
?. =(lot [%$ %da now]) ~
|
||||
?. =(%$ ren) [~ ~]
|
||||
?: =(tyl /whey)
|
||||
::
|
||||
?: &(?=(%x ren) =(tyl //whey))
|
||||
=/ maz=(list mass)
|
||||
:~ pki+&+pki.lex
|
||||
etn+&+etn.lex
|
||||
==
|
||||
``mass+!>(maz)
|
||||
::
|
||||
?. =(%$ ren) [~ ~]
|
||||
?+ syd
|
||||
~
|
||||
::
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -21,10 +21,16 @@
|
||||
[%event who [/a/newt/0v1n.2m9vh %born ~]]~
|
||||
::
|
||||
++ handle-send
|
||||
|= [our=ship now=@da sndr=@p way=wire %send lan=lane:ames pac=@]
|
||||
=, ames
|
||||
|= [our=ship now=@da sndr=@p way=wire %send lan=lane pac=@]
|
||||
^- (list card:agent:gall)
|
||||
=/ rcvr=ship (lane-to-ship lan)
|
||||
=/ hear-lane (ship-to-lane sndr)
|
||||
=/ [ames=? =packet] (decode-packet pac)
|
||||
?: &(!ames !resp==(& (cut 0 [2 1] pac)))
|
||||
=/ [=peep =purr] (decode-request-info `@ux`(rsh 3^64 content.packet))
|
||||
%+ emit-aqua-events our
|
||||
[%read [rcvr path.peep] [hear-lane num.peep]]~
|
||||
%+ emit-aqua-events our
|
||||
[%event rcvr /a/newt/0v1n.2m9vh %hear hear-lane pac]~
|
||||
:: +lane-to-ship: decode a ship from an aqua lane
|
||||
|
||||
@ -15,7 +15,7 @@
|
||||
==
|
||||
^- form:m
|
||||
::
|
||||
;< [our=ship syd=desk =case:clay] bind:m get-beak:strandio
|
||||
;< [our=ship syd=desk =case] bind:m get-beak:strandio
|
||||
=/ now=@da ?>(?=(%da -.case) p.case)
|
||||
::
|
||||
;< ~ bind:m
|
||||
|
||||
24
pkg/arvo/ted/keen.hoon
Normal file
24
pkg/arvo/ted/keen.hoon
Normal file
@ -0,0 +1,24 @@
|
||||
/- spider
|
||||
/+ strandio
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=+ !<([~ =spar:ames] arg)
|
||||
;< dat=(unit roar:ames) bind:m
|
||||
(keen:strandio spar)
|
||||
?~ dat
|
||||
(pure:m !>(~))
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
=/ [=path data=(unit (cask))] dat.u.dat
|
||||
?~ data
|
||||
(pure:m !>(~))
|
||||
=+ .^ =dais:clay %cb
|
||||
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.data]
|
||||
==
|
||||
=/ res (mule |.((vale.dais q.u.data)))
|
||||
?: ?=(%| -.res)
|
||||
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
|
||||
(pure:m p.res)
|
||||
|
||||
13
pkg/arvo/ted/ph/keen.hoon
Normal file
13
pkg/arvo/ted/ph/keen.hoon
Normal file
@ -0,0 +1,13 @@
|
||||
/- spider
|
||||
/+ *ph-io
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= vase
|
||||
=/ m (strand ,vase)
|
||||
;< ~ bind:m start-simple
|
||||
;< ~ bind:m (init-ship ~bud &)
|
||||
;< ~ bind:m (init-ship ~dev &)
|
||||
;< ~ bind:m (dojo ~bud "-keen /cx/~dev/kids/1/desk/bill")
|
||||
;< ~ bind:m (wait-for-output ~bud "[ ~")
|
||||
;< ~ bind:m end
|
||||
(pure:m *vase)
|
||||
@ -18,7 +18,7 @@
|
||||
?~ desks (pure:m !>(ok=&))
|
||||
:: |merge %work our %base
|
||||
::
|
||||
;< [=ship =desk =case:clay] bind:m get-beak:strandio
|
||||
;< [=ship =desk =case] bind:m get-beak:strandio
|
||||
=/ kiln-merge [i.desks ship %base case %auto]
|
||||
;< ~ bind:m (poke-our:strandio %hood %kiln-merge !>(kiln-merge))
|
||||
;< ~ bind:m (trace:strandio leaf+"work: merged {<i.desks>}" ~)
|
||||
|
||||
@ -33,7 +33,6 @@
|
||||
|^ |=([sor=$-(^ ?) val=json] (apex val sor ""))
|
||||
:: :: ++apex:en-json:html
|
||||
++ apex
|
||||
=, en-json:html
|
||||
|= [val=json sor=$-(^ ?) rez=tape]
|
||||
^- tape
|
||||
?~ val (weld "null" rez)
|
||||
@ -46,7 +45,7 @@
|
||||
|-
|
||||
?~ t.p.val ^$(val i.p.val)
|
||||
^$(val i.p.val, rez [',' $(p.val t.p.val)])
|
||||
::
|
||||
::
|
||||
%b (weld ?:(p.val "true" "false") rez)
|
||||
%n (weld (trip p.val) rez)
|
||||
%s
|
||||
@ -60,7 +59,7 @@
|
||||
?: ?=([@ ~] hed)
|
||||
[i.hed $(viz t.viz)]
|
||||
(weld hed $(viz t.viz))
|
||||
::
|
||||
::
|
||||
%o
|
||||
:- '{'
|
||||
=. rez ['}' rez]
|
||||
@ -74,6 +73,15 @@
|
||||
=. rez [',' $(viz t.viz)]
|
||||
^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
|
||||
==
|
||||
::
|
||||
++ jesc
|
||||
=+ utf=|=(a=@ ['\\' 'u' ((x-co 4):co a)])
|
||||
|= a=@ ^- tape
|
||||
?+ a ?:(&((gth a 0x1f) !=(a 0x7f)) [a ~] (utf a))
|
||||
%10 "\\n"
|
||||
%34 "\\\""
|
||||
%92 "\\\\"
|
||||
==
|
||||
--
|
||||
:: %/lib/jose
|
||||
::
|
||||
|
||||
@ -184,6 +184,21 @@
|
||||
`[%done ~]
|
||||
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
|
||||
==
|
||||
++ take-tune
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %poke-ack *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
?~ p.sign.u.in.tin
|
||||
`[%done ~]
|
||||
`[%fail %poke-fail u.p.sign.u.in.tin]
|
||||
==
|
||||
|
||||
::
|
||||
++ take-poke-ack
|
||||
|= =wire
|
||||
@ -319,6 +334,16 @@
|
||||
;< ~ bind:m (send-wait until)
|
||||
(take-wake `until)
|
||||
::
|
||||
++ keen
|
||||
|= =spar:ames
|
||||
=/ m (strand ,(unit roar:ames))
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass /keen %arvo %a %keen spar]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
;< [wire sign=sign-arvo] bind:m take-sign-arvo
|
||||
?> ?=([%ames %tune *] sign)
|
||||
(pure:m roar.sign)
|
||||
::
|
||||
++ sleep
|
||||
|= for=@dr
|
||||
=/ m (strand ,~)
|
||||
@ -552,7 +577,7 @@
|
||||
(take-writ /warp)
|
||||
::
|
||||
++ read-file
|
||||
|= [[=ship =desk =case:clay] =spur]
|
||||
|= [[=ship =desk =case] =spur]
|
||||
=* arg +<
|
||||
=/ m (strand ,cage)
|
||||
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
|
||||
@ -561,13 +586,13 @@
|
||||
(pure:m r.u.riot)
|
||||
::
|
||||
++ check-for-file
|
||||
|= [[=ship =desk =case:clay] =spur]
|
||||
|= [[=ship =desk =case] =spur]
|
||||
=/ m (strand ,?)
|
||||
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
|
||||
(pure:m ?=(^ riot))
|
||||
::
|
||||
++ list-tree
|
||||
|= [[=ship =desk =case:clay] =spur]
|
||||
|= [[=ship =desk =case] =spur]
|
||||
=* arg +<
|
||||
=/ m (strand ,(list path))
|
||||
;< =riot:clay bind:m (warp ship desk ~ %sing %t case spur)
|
||||
|
||||
@ -5,12 +5,11 @@
|
||||
::
|
||||
=, eyre
|
||||
=, format
|
||||
=, html
|
||||
|_ hit=httr
|
||||
++ grad %noun
|
||||
++ grow |% ++ wall (turn wain trip)
|
||||
++ wain (to-wain cord)
|
||||
++ json (need (de-json cord))
|
||||
++ json (need (de:json:html cord))
|
||||
++ cord q:octs
|
||||
++ noun hit
|
||||
++ octs
|
||||
|
||||
@ -8,17 +8,17 @@
|
||||
=, eyre
|
||||
=, format
|
||||
=, html
|
||||
|_ jon=json
|
||||
|_ jon=^json
|
||||
::
|
||||
++ grow :: convert to
|
||||
|%
|
||||
++ mime [/application/json (as-octs:mimes -:txt)] :: convert to %mime
|
||||
++ txt [(crip (en-json jon))]~
|
||||
++ txt [(en:json jon)]~
|
||||
--
|
||||
++ grab
|
||||
|% :: convert from
|
||||
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de-json) *json))
|
||||
++ noun json :: clam from %noun
|
||||
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de:json) *^json))
|
||||
++ noun ^json :: clam from %noun
|
||||
++ numb numb:enjs
|
||||
++ time time:enjs
|
||||
--
|
||||
|
||||
@ -16,11 +16,10 @@
|
||||
^- response
|
||||
~| hit
|
||||
?: ?=(%2 (div p.hit 100))
|
||||
=, html
|
||||
%- json
|
||||
?~ r.hit
|
||||
a+~
|
||||
(need (de-json q:u.r.hit))
|
||||
(need (de:json:html q:u.r.hit))
|
||||
fail+hit
|
||||
++ json :: from json
|
||||
=, dejs-soft:format
|
||||
|
||||
@ -41,6 +41,7 @@
|
||||
[%pause-events who=ship]
|
||||
[%snap-ships lab=term hers=(list ship)]
|
||||
[%restore-snap lab=term]
|
||||
[%read [from=ship =path] [for=lane:ames num=@ud]]
|
||||
[%event who=ship ue=unix-event]
|
||||
==
|
||||
::
|
||||
|
||||
@ -13,6 +13,7 @@ export class Ames extends Component {
|
||||
this.loadPeers = this.loadPeers.bind(this);
|
||||
this.loadPeerDetails = this.loadPeerDetails.bind(this);
|
||||
this.renderFlow = this.renderFlow.bind(this);
|
||||
this.renderScry = this.renderScry.bind(this);
|
||||
}
|
||||
|
||||
componentDidMount() {
|
||||
@ -35,6 +36,16 @@ export class Ames extends Component {
|
||||
api.getPeer(who);
|
||||
}
|
||||
|
||||
renderPaths(paths) {
|
||||
const items = paths.map(path => {
|
||||
return {
|
||||
key: path,
|
||||
jsx: path
|
||||
}
|
||||
});
|
||||
return <SearchableList placeholder="path" items={items}/>;
|
||||
}
|
||||
|
||||
renderDucts(ducts) {
|
||||
const items = ducts.map(duct => {
|
||||
return {
|
||||
@ -91,7 +102,7 @@ export class Ames extends Component {
|
||||
<td>fragment-num</td>
|
||||
<td>num-fragments</td>
|
||||
<td>last-sent</td>
|
||||
<td>retries</td>
|
||||
<td>tries</td>
|
||||
<td>skips</td>
|
||||
</tr>
|
||||
<tr>
|
||||
@ -99,7 +110,7 @@ export class Ames extends Component {
|
||||
<td>{live['fragment-num']}</td>
|
||||
<td>{live['num-fragments']}</td>
|
||||
<td>{msToDa(live['last-sent'])}</td>
|
||||
<td>{live.retries}</td>
|
||||
<td>{live.tries}</td>
|
||||
<td>{live.skips}</td>
|
||||
</tr>
|
||||
</tbody></table>
|
||||
@ -199,6 +210,84 @@ export class Ames extends Component {
|
||||
return 'weird flow';
|
||||
}
|
||||
|
||||
renderScry(scry) {
|
||||
|
||||
const m = scry['keen-state'].metrics;
|
||||
const metrics = (<>
|
||||
<table><tbody>
|
||||
<tr class="inter">
|
||||
<td>rto</td>
|
||||
<td>rtt</td>
|
||||
<td>rttvar</td>
|
||||
<td>ssthresh</td>
|
||||
<td>cwnd</td>
|
||||
<td>counter</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>{m.rto}</td>
|
||||
<td>{m.rtt}</td>
|
||||
<td>{m.rttvar}</td>
|
||||
<td>{m.ssthresh}</td>
|
||||
<td>{m.cwnd}</td>
|
||||
<td>{m.counter}</td>
|
||||
</tr>
|
||||
</tbody></table>
|
||||
</>);
|
||||
|
||||
const wantItems = scry['keen-state'].wan.map(wan => {
|
||||
return {key: wan.frag, jsx: (
|
||||
<table><tbody>
|
||||
<tr>
|
||||
<td>fragment</td>
|
||||
<td>size</td>
|
||||
<td>last-sent</td>
|
||||
<td>tries</td>
|
||||
<td>skips</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>{wan.frag}</td>
|
||||
<td>{wan.size}</td>
|
||||
<td>{msToDa(wan['last-sent'])}</td>
|
||||
<td>{wan.tries}</td>
|
||||
<td>{wan.skips}</td>
|
||||
</tr>
|
||||
</tbody></table>
|
||||
)};
|
||||
});
|
||||
const wants = (
|
||||
<SearchableList placeholder="fragment" items={wantItems} />
|
||||
);
|
||||
|
||||
const summary = (<>
|
||||
<b>{scry['scry-path']}</b><br/>
|
||||
<h5 style={{marginTop: '1em'}}>listeners:</h5>
|
||||
{renderDuct(scry['keen-state'].listeners)}
|
||||
<h5 style={{marginTop: '1em'}}>scry state:</h5>
|
||||
<table><tbody>
|
||||
<tr class="inter">
|
||||
<td>num-fragments</td>
|
||||
<td>num-received</td>
|
||||
<td>next-wake</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>{scry['keen-state']['num-fragments']}</td>
|
||||
<td>{scry['keen-state']['num-received']}</td>
|
||||
<td>{msToDa(scry['keen-state']['next-wake'])}</td>
|
||||
</tr>
|
||||
</tbody></table>
|
||||
</>);
|
||||
|
||||
const details = (<>
|
||||
{metrics}
|
||||
{wants}
|
||||
</>);
|
||||
|
||||
return {key: scry['scry-path'], jsx: (
|
||||
<Summary summary={summary} details={details} />
|
||||
)};
|
||||
|
||||
}
|
||||
|
||||
//TODO use classes for styling?
|
||||
render() {
|
||||
const { props, state } = this;
|
||||
@ -213,6 +302,7 @@ export class Ames extends Component {
|
||||
Pending messages: {peer.alien.messages}
|
||||
Pending packets: {peer.alien.packets}
|
||||
Heeds: {this.renderDucts(peer.alien.heeds)}
|
||||
Keens: {this.renderPaths(peer.alien.keens)}
|
||||
</>);
|
||||
} else if (peer.known) {
|
||||
const p = peer.known;
|
||||
@ -273,6 +363,12 @@ export class Ames extends Component {
|
||||
{this.renderDucts(p.heeds)}
|
||||
</>);
|
||||
|
||||
const scryItems = p.scries.map(this.renderScry);
|
||||
const scry = (<>
|
||||
<h4 style={{marginTop: '1em'}}>scries</h4>
|
||||
<SearchableList placeholder="path" items={scryItems} />
|
||||
</>);
|
||||
|
||||
return (<>
|
||||
<button
|
||||
style={{position: 'absolute', top: 0, right: 0}}
|
||||
@ -285,6 +381,7 @@ export class Ames extends Component {
|
||||
{backward}
|
||||
{nax}
|
||||
{heeds}
|
||||
{scry}
|
||||
</>);
|
||||
} else {
|
||||
console.log('weird peer', peer);
|
||||
|
||||
@ -305,7 +305,7 @@
|
||||
=/ =mime-data:iris u.full-file.client-response.sign-arvo
|
||||
?> =('application/json' type.mime-data)
|
||||
=/ jon=json
|
||||
(fall (rush (@t q.data.mime-data) apex:de-json:html) *json)
|
||||
(fall (de:json:html (@t q.data.mime-data)) *json)
|
||||
=/ [sid=@t message=@t]
|
||||
%. jon
|
||||
%- ot:dejs:format
|
||||
|
||||
@ -4,16 +4,23 @@
|
||||
|%
|
||||
:: test that these trace hints
|
||||
:: are safe to run or ignore
|
||||
++ test-hilt-hela
|
||||
::
|
||||
:: XX disabled due to CI noise
|
||||
::
|
||||
++ disabled-test-hilt-hela
|
||||
~> %hela
|
||||
~
|
||||
++ test-hint-hela
|
||||
++ disabled-test-hint-hela
|
||||
~> %hela.[1 leaf+"test-hint-hela ~"]
|
||||
~
|
||||
++ test-hilt-nara
|
||||
%- need %- mole |.
|
||||
~| %hilt-nara
|
||||
~> %nara
|
||||
~
|
||||
++ test-hint-nara
|
||||
%- need %- mole |.
|
||||
~| %hint-nara
|
||||
~> %nara.[1 leaf+"test-hint-nara ~"]
|
||||
~
|
||||
:: test that theses bytecode-report hints
|
||||
|
||||
218
tests/sys/fine.hoon
Normal file
218
tests/sys/fine.hoon
Normal file
@ -0,0 +1,218 @@
|
||||
:: test fine, remote-scry request and response
|
||||
::
|
||||
/+ *test, v=test-ames-gall
|
||||
/* kelvin %hoon /sys/kelvin
|
||||
=> |%
|
||||
++ crypto-core
|
||||
|% ++ nec (pit:nu:crub:crypto 512 (shaz 'nec'))
|
||||
++ bud (pit:nu:crub:crypto 512 (shaz 'bud'))
|
||||
++ sign
|
||||
|= [=ship data=@ux]
|
||||
%. data
|
||||
?:(=(ship ~nec) sigh:as:nec sigh:as:bud)
|
||||
--
|
||||
::
|
||||
++ n-frags
|
||||
|= n=@
|
||||
^- @ux
|
||||
:: 6 chosen randomly to get some trailing zeros
|
||||
::
|
||||
%+ rsh 10
|
||||
%+ rep 13
|
||||
%+ turn (gulf 1 n)
|
||||
|=(x=@ (fil 3 1.024 (dis 0xff x)))
|
||||
::
|
||||
++ custom-roof
|
||||
^- roof
|
||||
::
|
||||
|= [lyc=gang vis=view bem=beam]
|
||||
^- (unit (unit cage))
|
||||
?+ vis ~
|
||||
%cp
|
||||
=/ black=dict:clay
|
||||
%*(. *dict:clay mod.rul %black)
|
||||
``noun+!>([black black])
|
||||
::
|
||||
%cz
|
||||
?+ -.r.bem !!
|
||||
%ud ``noun+!>((n-frags p.r.bem))
|
||||
==
|
||||
::
|
||||
%cx ``hoon+!>(kelvin)
|
||||
==
|
||||
::
|
||||
++ etch-request-content
|
||||
|= [our=@p =path num=@ud]
|
||||
^- @
|
||||
?> (lth num (bex 32))
|
||||
=+ pat=(spat path)
|
||||
=+ wid=(met 3 pat)
|
||||
%+ can 3
|
||||
:~ 1^0 :: tag byte
|
||||
4^num :: fragment number
|
||||
2^wid :: path size
|
||||
wid^`@`pat :: namespace path
|
||||
==
|
||||
--
|
||||
::
|
||||
|%
|
||||
++ test-fine
|
||||
%- run-chain
|
||||
|. :- %|
|
||||
=+ (nec-bud:v life=[nec=1 bud=1] rift=[nec=1 bud=1])
|
||||
:: uncomment to turn on verbose debug output
|
||||
::=^ * ames.nec
|
||||
:: (ames-call:v ames.nec ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
|
||||
::=^ * ames.bud
|
||||
:: (ames-call:v ames.bud ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
|
||||
=/ scry-path=path /c/x/1/kids/sys/kelvin
|
||||
=/ fine-behn-wire=wire (weld /fine/behn/wake/~bud scry-path)
|
||||
=/ future-path=path /c/x/5/kids/sys/kelvin
|
||||
=/ future-behn=wire (weld /fine/behn/wake/~bud future-path)
|
||||
=/ =task:ames [%keen ~bud scry-path]
|
||||
::
|
||||
=/ request=shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
req=& sam=|
|
||||
sndr-tick=0b1
|
||||
rcvr-tick=0b1
|
||||
origin=~
|
||||
content=(etch-request-content ~nec /~bud/1/1/c/x/1/kids/sys/kelvin 1)
|
||||
==
|
||||
~& > 'poke requester %ames with a %keen task'
|
||||
=^ t1 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-1] task]
|
||||
:~ :- ~[//unix]
|
||||
[%give %send [%& ~bud] (etch-shot:ames request)]
|
||||
[~[//unix] %pass fine-behn-wire %b %wait ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
::
|
||||
~& > 'poke requester %ames with a second %keen task'
|
||||
:- t1 |. :- %|
|
||||
=^ t2 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-2] task]
|
||||
~
|
||||
==
|
||||
::
|
||||
:- t2 |. :- %|
|
||||
=/ peer=peer-state:ames
|
||||
(ames-scry-peer:v ames.nec [~1111.1.8 0xbeef.dead *roof] [~nec ~bud])
|
||||
=/ listeners=(set duct)
|
||||
?~ keen=(~(get by keens.peer) scry-path)
|
||||
~
|
||||
listeners:u.keen
|
||||
~& > 'checks two listeners for the requested scry path'
|
||||
=/ t3=tang
|
||||
%+ expect-eq
|
||||
!>((sy ~[~[/keen-duct-1] ~[/keen-duct-2]]))
|
||||
!>(listeners)
|
||||
::
|
||||
:- t3 |. :- %|
|
||||
~& > 'gives a remote scry response to listeners'
|
||||
=/ [sig=@ux meows=(list @ux)]
|
||||
%: ames-scry-hunk:v ames.bud
|
||||
[~1111.1.2 0xbeef.dead custom-roof]
|
||||
~bud
|
||||
[1 16.384 /~bud/1/1/c/x/1/kids/sys/kelvin]
|
||||
==
|
||||
=/ response=shot:ames
|
||||
:* [sndr=~bud rcvr=~nec]
|
||||
req=| sam=|
|
||||
sndr-tick=0b1
|
||||
rcvr-tick=0b1
|
||||
origin=~
|
||||
:: we know that for /sys/kelvin its contents fit
|
||||
:: in one packet -- TODO multipacket response
|
||||
content=?>(?=([@ *] meows) i.meows)
|
||||
==
|
||||
::
|
||||
=/ roar=(unit roar:ames)
|
||||
:+ ~ [/~bud/1/1/c/x/1/kids/sys/kelvin `hoon+kelvin]
|
||||
[[~bud [1 sig]] ~ ~]
|
||||
=^ t4 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
:- ~[//fine]
|
||||
:* %hear [%& ~bud]
|
||||
(etch-shot:ames response)
|
||||
==
|
||||
:~ [~[//fine] %pass /qos %d %flog %text "; ~bud is your neighbor"]
|
||||
[~[/keen-duct-2] %give %tune [~bud scry-path] roar]
|
||||
[~[/keen-duct-1] %give %tune [~bud scry-path] roar]
|
||||
[~[//unix] %pass fine-behn-wire %b %rest ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
::
|
||||
:- t4 |. :- %|
|
||||
=/ request=shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
req=& sam=|
|
||||
sndr-tick=0b1
|
||||
rcvr-tick=0b1
|
||||
origin=~
|
||||
content=(etch-request-content ~nec /~bud/1/1/c/x/5/kids/sys/kelvin 1)
|
||||
==
|
||||
~& > 'poke requester %ames with a %keen task for a future case'
|
||||
=^ t5 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-3] %keen ~bud future-path]
|
||||
:~ [~[//unix] [%give %send [%& ~bud] (etch-shot:ames request)]]
|
||||
[~[//unix] %pass future-behn %b %wait ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
::
|
||||
:- t5 |. :- %|
|
||||
~& > 'cancel %keen task, from requester'
|
||||
=^ t6 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-3] %yawn ~bud future-path]
|
||||
[~[//unix] %pass future-behn %b %rest ~1111.1.1..00.00.01]~
|
||||
==
|
||||
::
|
||||
:- t6 |. :- %|
|
||||
~& > 'poke requester %ames with a new %keen task for a future case'
|
||||
=^ t7 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-4] %keen ~bud future-path]
|
||||
:~ [~[//unix] [%give %send [%& ~bud] (etch-shot:ames request)]]
|
||||
[~[//unix] %pass future-behn %b %wait ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
::
|
||||
:- t7 |. :- %|
|
||||
~& > 'poke requester %ames with a second %keen task for a future case'
|
||||
=^ t8 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-5] %keen ~bud future-path]
|
||||
~
|
||||
==
|
||||
:- t8 |. :- %|
|
||||
~& > 'cancel scry for all listeners (%wham)'
|
||||
=^ t9 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/wham-duct] %wham ~bud future-path]
|
||||
:~ [~[/keen-duct-4] [%give %tune [~bud /c/x/5/kids/sys/kelvin] ~]]
|
||||
[~[/keen-duct-5] [%give %tune [~bud /c/x/5/kids/sys/kelvin] ~]]
|
||||
[~[//unix] %pass future-behn %b %rest ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
:- t9 |. :- %&
|
||||
=/ peer=peer-state:ames
|
||||
(ames-scry-peer:v ames.nec [~1111.1.8 0xbeef.dead *roof] [~nec ~bud])
|
||||
=/ listeners=(set duct)
|
||||
?~ keen=(~(get by keens.peer) scry-path)
|
||||
~
|
||||
listeners:u.keen
|
||||
~& > 'checks no more listeners'
|
||||
(expect-eq !>(~) !>(listeners))
|
||||
--
|
||||
@ -5,7 +5,7 @@
|
||||
++ test-watch
|
||||
%- run-chain
|
||||
|. :- %|
|
||||
=+ nec-bud:v
|
||||
=+ (nec-bud:v [nec=2 bud=3] nec=0 bud=0)
|
||||
:: uncomment to turn on verbose debug output
|
||||
::=^ * ames.nec
|
||||
:: (ames-call:v ames.nec ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
|
||||
@ -68,7 +68,7 @@
|
||||
:* %hear [%& ~nec]
|
||||
0xae59.5b29.277b.22c1.20b7.a8db.9086.46df.31bd.f9bc.
|
||||
2633.7300.17d4.f5fc.8be5.8bfe.5c9d.36d9.2ea1.7cb3.
|
||||
8a00.0200.0132.8fd4.f000
|
||||
8a00.0200.0132.8fd4.f004
|
||||
==
|
||||
:~ :- ~[//unix] [%pass /qos %d %flog %text "; ~nec is your neighbor"]
|
||||
:- ~[//unix]
|
||||
@ -123,7 +123,7 @@
|
||||
:~ :- ~[//unix]
|
||||
:* %give %send [%& ~nec]
|
||||
0x2.0219.8100.0485.5530.3c88.9068.3cc6.484e.
|
||||
2d9d.076e.6d00.0100.0223.9ae9.5000
|
||||
2d9d.076e.6d00.0100.0223.9ae9.5004
|
||||
== ==
|
||||
==
|
||||
:- t8 |. :- %|
|
||||
@ -135,7 +135,7 @@
|
||||
:- ~[//unix]
|
||||
:* %hear [%& ~bud]
|
||||
0x2.0219.8100.0485.5530.3c88.9068.3cc6.484e.
|
||||
2d9d.076e.6d00.0100.0223.9ae9.5000
|
||||
2d9d.076e.6d00.0100.0223.9ae9.5004
|
||||
==
|
||||
:~ :- ~[//unix] [%pass /qos %d %flog %text "; ~bud is your neighbor"]
|
||||
:- :~ /sys/way/~bud/pub
|
||||
@ -228,7 +228,7 @@
|
||||
:- ~[//unix]
|
||||
:* %give %send [%& ~bud]
|
||||
0xfe.e208.da00.0491.bf7f.9594.2ddc.0948.
|
||||
9de0.3906.b678.6e00.0200.0132.e55d.5000
|
||||
9de0.3906.b678.6e00.0200.0132.e55d.5004
|
||||
== ==
|
||||
==
|
||||
:- t15 |. :- %|
|
||||
@ -318,7 +318,7 @@
|
||||
:- ~[//unix]
|
||||
:* %hear [%& ~nec]
|
||||
0xfe.e208.da00.0491.bf7f.9594.2ddc.0948.
|
||||
9de0.3906.b678.6e00.0200.0132.e55d.5000
|
||||
9de0.3906.b678.6e00.0200.0132.e55d.5004
|
||||
==
|
||||
:~ :- ~[/ames] [%pass /pump/~nec/1 %b %rest ~1111.1.4..00.00.01]
|
||||
==
|
||||
@ -332,7 +332,7 @@
|
||||
:- ~[//unix]
|
||||
:* %hear [%& ~nec]
|
||||
0xfe.9174.6d7c.e042.4ea7.cf3c.08da.3acf.68ec.3bd1.1f2c.abfe.f500.
|
||||
1897.c42e.a3ec.2159.86d6.e2f1.b344.9d06.b600.0200.0132.ebe7.8800
|
||||
1897.c42e.a3ec.2159.86d6.e2f1.b344.9d06.b600.0200.0132.ebe7.8804
|
||||
==
|
||||
:~ :- ~[//unix]
|
||||
[%pass /bone/~nec/0/5 %g %plea ~nec %g /ge/pub [%0 %s /foo]]
|
||||
@ -384,7 +384,7 @@
|
||||
:~ :- ~[//unix]
|
||||
:* %give %send [%& ~nec]
|
||||
0x5f5.c27c.c400.0587.8b0d.0a5d.eb8e.39fa.
|
||||
49f4.4848.bfa6.f600.0100.0223.c98c.8800
|
||||
49f4.4848.bfa6.f600.0100.0223.c98c.8804
|
||||
== ==
|
||||
==
|
||||
:: publisher ames hears %cork, passes to itself
|
||||
@ -396,7 +396,7 @@
|
||||
:- ~[//unix]
|
||||
:* %hear [%& ~nec]
|
||||
0xb.130c.ab37.ca24.49cd.aecb.23ba.70f1.6f1c.4d00.124e.c9a5.
|
||||
3413.3843.d81c.47c4.7040.6e62.3700.0200.0132.e1ab.9000
|
||||
3413.3843.d81c.47c4.7040.6e62.3700.0200.0132.e1ab.9004
|
||||
==
|
||||
:~ :- ~[//unix] [%pass /bone/~nec/0/1 %a %plea ~nec [%a /close ~]]
|
||||
==
|
||||
@ -424,7 +424,7 @@
|
||||
:~ :- ~[//unix]
|
||||
:* %give %send [%& ~nec]
|
||||
0x5f.f966.8e00.0449.bdec.9006.c7e5.1237.
|
||||
1d87.53fe.d7bb.ad00.0100.0223.c6a8.5800
|
||||
1d87.53fe.d7bb.ad00.0100.0223.c6a8.5804
|
||||
== ==
|
||||
==
|
||||
:: subscriber ames hears %watch-ack, gives to gall
|
||||
@ -436,7 +436,7 @@
|
||||
:- ~[//unix]
|
||||
:* %hear [%& ~bud]
|
||||
0x5f5.c27c.c400.0587.8b0d.0a5d.eb8e.39fa.
|
||||
49f4.4848.bfa6.f600.0100.0223.c98c.8800
|
||||
49f4.4848.bfa6.f600.0100.0223.c98c.8804
|
||||
==
|
||||
:~ :- :~ /sys/way/~bud/pub
|
||||
/use/sub/0w1.d6Isf/out/~bud/pub/2/sub-foo/~bud
|
||||
@ -483,7 +483,7 @@
|
||||
:- ~[//unix]
|
||||
:* %hear [%& ~bud]
|
||||
0x5f.f966.8e00.0449.bdec.9006.c7e5.1237.
|
||||
1d87.53fe.d7bb.ad00.0100.0223.c6a8.5800
|
||||
1d87.53fe.d7bb.ad00.0100.0223.c6a8.5804
|
||||
==
|
||||
[~[/ames] [%pass /pump/~bud/0 %b %rest ~1111.1.5..00.02.00]]~
|
||||
==
|
||||
|
||||
98
tests/sys/lull/deq.hoon
Normal file
98
tests/sys/lull/deq.hoon
Normal file
@ -0,0 +1,98 @@
|
||||
/+ *test
|
||||
=/ big-num
|
||||
100
|
||||
=/ de (deq ,@)
|
||||
=/ big-list
|
||||
(gulf 1 big-num)
|
||||
=/ big
|
||||
(apl:de *(pha @) big-list)
|
||||
=/ foo-list (gulf 1 8)
|
||||
|%
|
||||
++ foo
|
||||
(apl:de *(pha @) 1 2 3 4 5 6 7 8 ~)
|
||||
++ bar
|
||||
`(pha @)`(apl:de *(pha @) 8 9 10 11 12 13 14 15 ~)
|
||||
::
|
||||
++ test-tap
|
||||
=/ ls
|
||||
~> %bout.[1 %tap]
|
||||
(tap:de big)
|
||||
(expect-eq !>(ls) !>(big-list))
|
||||
::
|
||||
++ test-wyt
|
||||
=/ le
|
||||
~> %bout.[1 %wyt]
|
||||
(wyt:de big)
|
||||
(expect-eq !>(le) !>(big-num))
|
||||
::
|
||||
++ test-left
|
||||
^- tang
|
||||
=/ bar
|
||||
~> %bout.[1 %cons]
|
||||
(cons:de bar 7)
|
||||
=. bar
|
||||
~> %bout.[1 %apl]
|
||||
(apl:de bar 1 2 3 4 5 6 ~)
|
||||
%- zing
|
||||
:-
|
||||
~> %bout.[1 %eq-1]
|
||||
(expect-eq !>((tap:de bar)) !>((gulf 1 15)))
|
||||
=^ val=(unit @) bar
|
||||
~> %bout.[1 %pop-left]
|
||||
(pop-left:de bar)
|
||||
~> %bout.[1 %eq-2]
|
||||
:~ (expect-eq !>(1) !>((need val)))
|
||||
(expect-eq !>((gulf 2 15)) !>((tap:de bar)))
|
||||
==
|
||||
::
|
||||
++ test-cons-tree
|
||||
=/ foo
|
||||
(cons:de foo 1)
|
||||
~
|
||||
::
|
||||
++ test-cons-list
|
||||
=/ big-list
|
||||
[1 big-list]
|
||||
~
|
||||
::
|
||||
++ test-rear-tree
|
||||
=/ big big
|
||||
=/ res (peek-right:de big)
|
||||
~
|
||||
::
|
||||
++ test-rear-list
|
||||
=/ last (rear big-list)
|
||||
~
|
||||
::
|
||||
++ test-right
|
||||
^- tang
|
||||
=/ foo
|
||||
~> %bout.[1 %snoc]
|
||||
(snoc:de foo 9)
|
||||
=. foo
|
||||
(apr:de foo 10 11 12 13 14 15 ~)
|
||||
%- zing
|
||||
:- (expect-eq !>((tap:de foo)) !>((gulf 1 15)))
|
||||
=^ val=(unit @) foo
|
||||
(pop-right:de foo)
|
||||
:~ (expect-eq !>((need val)) !>(15))
|
||||
(expect-eq !>((gulf 1 14)) !>((tap:de foo)))
|
||||
==
|
||||
++ test-queue
|
||||
^- tang
|
||||
=/ foo foo
|
||||
=. foo
|
||||
(apr:de foo 9 10 11 12 13 14 15 ~)
|
||||
=/ expected (gulf 1 15)
|
||||
%- zing
|
||||
|- ^- (list tang)
|
||||
=^ val=(unit @) foo
|
||||
(pop-left:de foo)
|
||||
?~ val
|
||||
(expect-eq !>(~) !>(expected))^~
|
||||
~& got/u.val
|
||||
?~ expected
|
||||
~[leaf/"queue mismatch"]
|
||||
:- (expect-eq !>(i.expected) !>(u.val))
|
||||
$(expected t.expected)
|
||||
--
|
||||
@ -1,20 +1,22 @@
|
||||
/+ *test
|
||||
/= ames /sys/vane/ames
|
||||
/= jael /sys/vane/jael
|
||||
/* dojo %hoon /app/dojo/hoon
|
||||
:: construct some test fixtures
|
||||
::
|
||||
=/ nec (ames ~nec)
|
||||
=/ bud (ames ~bud)
|
||||
=/ marbud (ames ~marbud)
|
||||
=/ nec ^$:((ames ~nec))
|
||||
=/ bud ^$:((ames ~bud))
|
||||
=/ marbud ^$:((ames ~marbud))
|
||||
::
|
||||
=/ our-comet ~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud
|
||||
=/ our-comet2 ~togdut-rosled-fadlev-siddys--botmun-wictev-sapfus-marbud
|
||||
=/ comet (ames our-comet)
|
||||
=/ comet2 (ames our-comet2)
|
||||
=/ comet ^$:((ames our-comet))
|
||||
=/ comet2 ^$:((ames our-comet2))
|
||||
::
|
||||
=. now.nec ~1111.1.1
|
||||
=. eny.nec 0xdead.beef
|
||||
=. life.ames-state.nec 2
|
||||
=. rift.ames-state.nec 0
|
||||
=. rof.nec |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.nec (pit:nu:crub:crypto 512 (shaz 'nec'))
|
||||
=/ nec-pub pub:ex:crypto-core.ames-state.nec
|
||||
@ -23,6 +25,7 @@
|
||||
=. now.bud ~1111.1.1
|
||||
=. eny.bud 0xbeef.dead
|
||||
=. life.ames-state.bud 3
|
||||
=. rift.ames-state.bud 0
|
||||
=. rof.bud |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.bud (pit:nu:crub:crypto 512 (shaz 'bud'))
|
||||
=/ bud-pub pub:ex:crypto-core.ames-state.bud
|
||||
@ -31,6 +34,7 @@
|
||||
=. now.marbud ~1111.1.1
|
||||
=. eny.marbud 0xbeef.beef
|
||||
=. life.ames-state.marbud 4
|
||||
=. rift.ames-state.marbud 0
|
||||
=. rof.marbud |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.marbud (pit:nu:crub:crypto 512 (shaz 'marbud'))
|
||||
=/ marbud-pub pub:ex:crypto-core.ames-state.marbud
|
||||
@ -39,6 +43,7 @@
|
||||
=. now.comet ~1111.1.1
|
||||
=. eny.comet 0xbeef.cafe
|
||||
=. life.ames-state.comet 1
|
||||
=. rift.ames-state.comet 0
|
||||
=. rof.comet |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.comet
|
||||
%- nol:nu:crub:crypto
|
||||
@ -50,6 +55,7 @@
|
||||
=. now.comet2 ~1111.1.1
|
||||
=. eny.comet2 0xcafe.cafe
|
||||
=. life.ames-state.comet2 1
|
||||
=. rift.ames-state.comet2 0
|
||||
=. rof.comet2 |=(* ``[%noun !>(*(list turf))])
|
||||
=. crypto-core.ames-state.comet2 (pit:nu:crub:crypto 512 0v1eb4)
|
||||
=/ comet2-pub pub:ex:crypto-core.ames-state.comet2
|
||||
@ -183,6 +189,41 @@
|
||||
%+ snag index
|
||||
(skim moves is-move-send)
|
||||
::
|
||||
++ n-frags
|
||||
|= n=@
|
||||
^- @ux
|
||||
:: 6 chosen randomly to get some trailing zeros
|
||||
::
|
||||
%+ rsh 10
|
||||
%+ rep 13
|
||||
%+ turn (gulf 1 n)
|
||||
|=(x=@ (fil 3 1.024 (dis 0xff x)))
|
||||
::
|
||||
++ scry
|
||||
|= [vane=_nec car=term bem=beam]
|
||||
=/ =roof
|
||||
:: custom scry handler for +test-fine-response.
|
||||
:: could be refined further...
|
||||
::
|
||||
|= [lyc=gang vis=view bem=beam]
|
||||
^- (unit (unit cage))
|
||||
?+ vis ~
|
||||
%cp
|
||||
=/ black=dict:clay
|
||||
%*(. *dict:clay mod.rul %black)
|
||||
``noun+!>([black black])
|
||||
::
|
||||
%cz
|
||||
?+ -.r.bem !!
|
||||
%ud ``noun+!>((n-frags p.r.bem))
|
||||
==
|
||||
::
|
||||
%cx
|
||||
``hoon+!>(dojo)
|
||||
==
|
||||
=/ vane-core (vane(rof roof))
|
||||
(scry:vane-core ~ car bem)
|
||||
::
|
||||
++ call
|
||||
|= [vane=_nec =duct =task:ames]
|
||||
^- [moves=(list move:ames) _nec]
|
||||
@ -204,36 +245,38 @@
|
||||
|%
|
||||
++ test-packet-encoding ^- tang
|
||||
::
|
||||
=/ =packet:ames
|
||||
=/ =shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
req=& sam=&
|
||||
sndr-tick=0b10
|
||||
rcvr-tick=0b11
|
||||
origin=~
|
||||
content=0xdead.beef
|
||||
==
|
||||
::
|
||||
=/ encoded (encode-packet:ames packet)
|
||||
=/ decoded (decode-packet:ames encoded)
|
||||
=/ encoded (etch-shot:ames shot)
|
||||
=/ decoded (sift-shot:ames encoded)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> packet
|
||||
!> shot
|
||||
!> decoded
|
||||
::
|
||||
++ test-origin-encoding ^- tang
|
||||
::
|
||||
=/ =packet:ames
|
||||
=/ =shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
req=& sam=&
|
||||
sndr-tick=0b10
|
||||
rcvr-tick=0b11
|
||||
origin=`0xbeef.cafe.beef
|
||||
content=0xdead.beef
|
||||
==
|
||||
::
|
||||
=/ encoded (encode-packet:ames packet)
|
||||
=/ decoded (decode-packet:ames encoded)
|
||||
=/ encoded (etch-shot:ames shot)
|
||||
=/ decoded (sift-shot:ames encoded)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> packet
|
||||
!> shot
|
||||
!> decoded
|
||||
::
|
||||
++ test-shut-packet-encoding ^- tang
|
||||
@ -242,10 +285,10 @@
|
||||
:+ bone=17 message-num=18
|
||||
[%& num-fragments=1 fragment-num=1 fragment=`@`0xdead.beef]
|
||||
::
|
||||
=/ =packet:ames
|
||||
(encode-shut-packet:ames shut-packet nec-sym ~marnec ~marbud-marbud 3 17)
|
||||
=/ =shot:ames
|
||||
(etch-shut-packet:ames shut-packet nec-sym ~marnec ~marbud-marbud 3 17)
|
||||
::
|
||||
=/ decoded (decode-shut-packet:ames packet nec-sym 3 17)
|
||||
=/ decoded (sift-shut-packet:ames shot nec-sym 3 17)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> shut-packet
|
||||
@ -277,8 +320,8 @@
|
||||
[%& num-fragments=1 fragment-num=0 (jam plea)]
|
||||
==
|
||||
::
|
||||
=/ =packet:ames
|
||||
%: encode-shut-packet:ames
|
||||
=/ =shot:ames
|
||||
%: etch-shut-packet:ames
|
||||
shut-packet
|
||||
nec-sym
|
||||
~bus
|
||||
@ -287,7 +330,7 @@
|
||||
rcvr-life=3
|
||||
==
|
||||
::
|
||||
=/ =blob:ames (encode-packet:ames packet)
|
||||
=/ =blob:ames (etch-shot:ames shot)
|
||||
=^ moves1 bud (call bud ~[//unix] %hear lane-foo blob)
|
||||
=^ moves2 bud
|
||||
=/ =point:ames
|
||||
@ -460,6 +503,91 @@
|
||||
!> [~[/g/talk] %give %done `error]
|
||||
!> (snag 0 `(list move:ames)`moves5)
|
||||
::
|
||||
++ test-fine-request
|
||||
^- tang
|
||||
=/ want=path /c/z/1/kids/sys
|
||||
=^ moves1 nec (call nec ~[/g/talk] %keen ~bud want)
|
||||
=/ req=hoot:ames
|
||||
%+ snag 0
|
||||
%+ murn ;;((list move:ames) moves1)
|
||||
|= =move:ames
|
||||
^- (unit hoot:ames)
|
||||
?. ?=(%give -.card.move) ~
|
||||
?. ?=(%send -.p.card.move) ~
|
||||
`;;(@uxhoot blob.p.card.move)
|
||||
=/ =shot:ames (sift-shot:ames `@ux`req)
|
||||
?< sam.shot
|
||||
?> req.shot
|
||||
=/ =wail:ames
|
||||
(sift-wail:ames `@ux`content.shot)
|
||||
~& wail
|
||||
(expect-eq !>(1) !>(1))
|
||||
::
|
||||
++ test-fine-hunk
|
||||
^- tang
|
||||
%- zing
|
||||
%+ turn (gulf 1 10)
|
||||
|= siz=@
|
||||
=/ want=path /~bud/0/3/c/z/(scot %ud siz)/kids/sys
|
||||
::
|
||||
=/ =beam [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
|
||||
=/ [=mark =vase] (need (need (scry bud %x beam)))
|
||||
=+ !<(song=(list @uxyowl) vase)
|
||||
%+ expect-eq
|
||||
!>(siz)
|
||||
!>((lent song))
|
||||
::
|
||||
++ test-fine-response
|
||||
^- tang
|
||||
::%- zing
|
||||
::%+ turn (gulf 1 50)
|
||||
::|= siz=@
|
||||
::=/ want=path /~bud/0/1/c/z/(scot %ud siz)/kids/sys
|
||||
=/ want=path /~bud/0/3/c/x/1/kids/app/dojo/hoon
|
||||
=/ dit (jam %hoon dojo)
|
||||
=/ exp (cat 9 (fil 3 64 0xff) dit)
|
||||
=/ siz=@ud (met 13 exp)
|
||||
^- tang
|
||||
::
|
||||
=/ =beam [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
|
||||
=/ [=mark =vase] (need (need (scry bud %x beam)))
|
||||
=+ !<(song=(list @uxyowl) vase)
|
||||
=/ paz=(list have:ames)
|
||||
%+ spun song
|
||||
|= [blob=@ux num=_1]
|
||||
^- [have:ames _num]
|
||||
:_ +(num)
|
||||
=/ =meow:ames (sift-meow:ames blob)
|
||||
[num meow]
|
||||
::
|
||||
=/ num-frag=@ud (lent paz)
|
||||
~& num-frag=num-frag
|
||||
=/ ror (sift-roar:ames num-frag (flop paz)) :: XX rename
|
||||
=/ event-core
|
||||
~! nec
|
||||
=/ foo [*@da *@ rof.nec]
|
||||
(ev:(nec foo) [*@da *@ rof.nec] *duct ames-state.nec)
|
||||
=/ dat
|
||||
?> ?=(^ dat.ror)
|
||||
;;(@ux q.dat.ror)
|
||||
::
|
||||
;: welp
|
||||
(expect-eq !>(`@`dat) !>(`@`dojo))
|
||||
::
|
||||
^- tang
|
||||
%- zing
|
||||
%+ turn paz
|
||||
|= [fra=@ud sig=@ byts]
|
||||
%+ expect-eq
|
||||
!>(%.y)
|
||||
!>((veri-fra:keys:fi:(abed:pe:event-core ~bud) want fra dat sig))
|
||||
::
|
||||
~& %verifying-sig
|
||||
%+ expect-eq
|
||||
!>(%.y)
|
||||
!>((meri:keys:fi:(abed:pe:event-core ~bud) want [sig dat]:ror))
|
||||
==
|
||||
::
|
||||
++ test-old-ames-wire ^- tang
|
||||
=^ moves0 bud (call bud ~[/g/hood] %spew [%odd]~)
|
||||
=^ moves1 nec (call nec ~[/g/talk] %plea ~bud %g /talk [%get %post])
|
||||
|
||||
@ -643,17 +643,30 @@
|
||||
!> (rush '192.168.1.1' simplified-url-parser:eyre-gate)
|
||||
==
|
||||
::
|
||||
++ test-parse-channel-request
|
||||
++ test-parse-channel-request-jam
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> `[%ack 5]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
(need (de-json:html '[{"action": "ack", "event-id": 5}]'))
|
||||
!> &+[%ack 5]~
|
||||
!> %+ parse-channel-request:eyre-gate %jam
|
||||
(as-octs:mimes:html (scot %uw (jam [%ack 5]~)))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `[%poke 0 ~nec %app1 %app-type [%n '5']]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid request data'
|
||||
!> %+ parse-channel-request:eyre-gate %jam
|
||||
(as-octs:mimes:html (scot %uw (jam [%not %a %chanreq %list])))
|
||||
==
|
||||
::
|
||||
++ test-parse-channel-request-json
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> &+[%ack 5]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
(as-octs:mimes:html '[{"action": "ack", "event-id": 5}]')
|
||||
::
|
||||
%+ expect-eq
|
||||
!> &+[%poke-json 0 ~nec %app1 %app-type [%n '5']]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "poke",
|
||||
"id": 0,
|
||||
@ -664,9 +677,9 @@
|
||||
'''
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `[%subscribe 1 ~sampyl-sipnym %hall /this/path]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> &+[%subscribe 1 ~sampyl-sipnym %hall /this/path]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "subscribe",
|
||||
"id": 1,
|
||||
@ -676,9 +689,9 @@
|
||||
'''
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `[%unsubscribe 2 1]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> &+[%unsubscribe 2 1]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "unsubscribe",
|
||||
"id": 2,
|
||||
@ -686,30 +699,30 @@
|
||||
'''
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid channel json'
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'[{"noaction": "noaction"}]'
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid channel json'
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'[{"action": "bad-action"}]'
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid channel json'
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'[{"action": "ack", "event-id": 5}, {"action": "bad-action"}]'
|
||||
::
|
||||
%+ expect-eq
|
||||
!> :- ~
|
||||
!> :- %&
|
||||
:~ [%ack 9]
|
||||
[%poke 3 ~bud %wut %wut-type [%a [%n '2'] [%n '1'] ~]]
|
||||
[%poke-json 3 ~bud %wut %wut-type [%a [%n '2'] [%n '1'] ~]]
|
||||
==
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "ack", "event-id": 9},
|
||||
{"action": "poke",
|
||||
|
||||
17
tests/sys/zuse/balk.hoon
Normal file
17
tests/sys/zuse/balk.hoon
Normal file
@ -0,0 +1,17 @@
|
||||
/+ *test
|
||||
|%
|
||||
++ le-path `path`/~hastuc-dibtux/15/22/c/x/3/base/sys/kelvin
|
||||
++ hastuc-dibtux [~hastuc-dibtux 15 22]
|
||||
++ clay-x [%c %x %ud 3]
|
||||
++ test-en-path
|
||||
%+ expect-eq
|
||||
!>(le-path)
|
||||
!> %- en-path:balk
|
||||
[hastuc-dibtux clay-x /base/sys/kelvin]
|
||||
++ test-de-path
|
||||
=/ bal=balk
|
||||
(de-path:balk le-path)
|
||||
%+ expect-eq !>(bal)
|
||||
!> ^- balk
|
||||
[hastuc-dibtux clay-x /base/sys/kelvin]
|
||||
--
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user