urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-27 18:34:48 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'ford-fusion' (#3060)

Browse Source 
* ford-fusion: (259 commits)
  clay: remove scaffolding
  kiln: make otas continue even if they failed to apply
  metadata-store: add cleanup utility, use on-poke:def instead of no-op
  clay: flop syntax error trace
  landscape/img/codeeval.png: typo in filename
  invite-view: reinstate as potato
  goad: don't crash on pre-OTA sign
  chat-store: responded to comments, cleaned up
  -test: support other desks (full beams in args)
  arvo: use date instead of kelvin
  hoon: re-fix +slab; /tests: fix clay tests
  kiln: don't implicitly create syncs
  gall: don't make large stack trace
  ames: use +cut in +encrypt
  pill: solid
  dojo: print generator type errors
  Squashed commit of the following:
  ci: fix herb tests; update pills
  ford,kiln: nicer errors
  dojo: too many nouns
  ...

Signed-off-by: Philip Monk <phil@pcmonk.me>
This commit is contained in:
Philip Monk 2020-06-29 16:07:38 -07:00
commit 0574546b77
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
299 changed files with 10419 additions and 24043 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:29a948ebcf5d82577b3d1271cb8d0c6cf1fa8b63a324ad2ef43e73ad5dcfe62c
size 4846052
oid sha256:f738f60e9e028081864f317106f623d2f21a5fe5c2f6fdd83576e22d21a8c6a6
size 14862847

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:6c9cec5d3dd639a82b1b867375225e6becb9f234338ef0a4cb2626ae72ba8944
size 1265620
oid sha256:9fbfbe75a6685df444621ebd27677716fd0abf7113020f3274c3b5c209e3616e
size 1304972

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:f41c00b072d8b4a8e18908b038f65602e698b92d02846f44d463c4f3d425680c
size 7313574
oid sha256:19d6cb7e5a323590455d641161b911190b3dcd1a0f601bef1304b6b340fa0dc9
size 16662878

65
nix/ops/test/builder.sh
View File

@ -22,50 +22,59 @@ trap shutdown EXIT
herb ./ship -p hood -d '+hood/mass'
# Start the test app
# Run the unit tests and then print scrollback
herb ./ship -d '~& ~ ~& %test-unit-start ~'
herb ./ship -d '####-test %/tests'
herb ./ship -d '~& ~ ~& %test-unit-end ~'
# Start and run the test app
herb ./ship -p hood -d '+hood/start %test'
# Run the %cores tests
herb ./ship -d '~& ~ ~& %start-test-cores ~'
herb ./ship -p test -d ':- %cores /'
herb ./ship -d '~& %finish-test-cores ~'
herb ./ship -d '~& ~ ~& %test-agents-start ~'
herb ./ship -p test -d '%agents'
herb ./ship -d '~& ~ ~& %test-agents-end ~'
herb ./ship -d '~& ~ ~& %test-generators-start ~'
herb ./ship -p test -d '%generators'
herb ./ship -d '~& ~ ~& %test-generators-end ~'
herb ./ship -d '~& ~ ~& %test-marks-start ~'
herb ./ship -p test -d '%marks'
herb ./ship -d '~& ~ ~& %test-marks-end ~'
# compact the loom, comparing memory use before and after
herb ./ship -p hood -d '+hood/mass'
# Run the %renders tests
herb ./ship -d '~& ~ ~& %start-test-renders ~'
herb ./ship -p test -d ':- %renders /'
herb ./ship -d '~& %finish-test-renders ~'
# Run the test generator
herb ./ship -d '+test, =seed `@uvI`(shaz %reproducible)' > test-generator-output
cat test-generator-output || true
herb ./ship -p hood -d '+hood/mass'
herb ./ship -d '~& ~ ~& %start-pack ~'
herb ./ship -d '~& ~ ~& %pack-start ~'
herb ./ship -p hood -d '+hood/pack'
herb ./ship -d '~& ~ ~& %finish-pack ~'
herb ./ship -d '~& ~ ~& %pack-end ~'
herb ./ship -p hood -d '+hood/mass'
shutdown
# Collect output
cp urbit-output test-cores-output
cp urbit-output test-renders-output
cp urbit-output test-output-unit
cp urbit-output test-output-agents
cp urbit-output test-output-generators
cp urbit-output test-output-marks
rm urbit-output
sed -i '0,/start-test-renders/d' test-renders-output
sed -i '/finish-test-renders/,$d' test-renders-output
sed -i '0,/test-unit-start/d' test-output-unit
sed -i '/test-unit-end/,$d' test-output-unit
sed -i '0,/start-test-cores/d' test-cores-output
sed -i '/finish-test-cores/,$d' test-cores-output
sed -i '0,/test-agents-start/d' test-output-agents
sed -i '/test-agents-end/,$d' test-output-agents
sed -i '0,/test-generators-start/d' test-output-generators
sed -i '/test-generators-end/,$d' test-output-generators
sed -i '0,/test-marks-start/d' test-output-marks
sed -i '/test-marks-end/,$d' test-output-marks
mkdir $out
cp test-renders-output $out/renders
cp test-cores-output $out/cores
cp test-generator-output $out/generator
cp -r test-output-* $out/
set +x

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

@ -163,7 +163,9 @@
$
=. snap +.p.poke-result
=. ..abet-pe (publish-event tym ue)
=. ..abet-pe (handle-effects ((list ovum) -.p.poke-result))
=. ..abet-pe
~| ova=-.p.poke-result
(handle-effects ;;((list ovum) -.p.poke-result))
$
::
:: Peek
@ -380,13 +382,12 @@
%c %clay
%d %dill
%e %eyre
%f %ford
%g %gall
%j %jael
%g %gall
==
=/ pax
/(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/[vane]
/(scot %p our.hid)/work/(scot %da now.hid)/sys/vane/[vane]
=/ txt .^(@ %cx (weld pax /hoon))
[/vane/[vane] [%veer v pax txt]]
=> .(this ^+(this this))
@ -400,7 +401,7 @@
:_ ~
%- unix-event
%- %*(. file-ovum:pill-lib directories slim-dirs)
/(scot %p our.hid)/home/(scot %da now.hid)
/(scot %p our.hid)/work/(scot %da now.hid)
=^ ms all-state (poke-pill pil)
(emit-cards ms)
::

1
pkg/arvo/app/chat-cli.hoon
View File

@ -451,6 +451,7 @@
::
++ parser
|^
%+ stag |
%+ knee *command |. ~+
=- ;~(pose ;~(pfix mic -) message)
;~ pose

64
pkg/arvo/app/chat-hook.hoon
View File

@ -14,11 +14,17 @@
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ state-2
$: %2
state-base
==
::
+$ state-1
$: %1
loaded-cards=(list card)
loaded-cards=*
state-base
==
+$ state-0 [%0 state-base]
@ -39,7 +45,7 @@
$% [%chat-update update:store]
==
--
=| state-1
=| state-2
=* state -
::
%- agent:dbug
@ -66,29 +72,30 @@
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
:_ this(state old)
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] *]
^- (unit card)
?. &(?=([%mailbox *] wire) =(our.bol ship) =(%chat-store term))
~
`[%pass wire %agent [our.bol %chat-store] %leave ~]
:: path structure ugprade logic
::
=/ keys=(set path) (scry:cc (set path) %chat-store /keys)
=/ upgraded-state
%* . *state-1
synced synced
invite-created invite-created
allow-history allow-history
loaded-cards
%- zing
^- (list (list card))
%+ turn ~(tap in keys) generate-cards
==
:_ this(state upgraded-state)
loaded-cards.upgraded-state
=^ moves state
^- (quip card state-2)
?: ?=(%2 -.old)
^- (quip card state-2)
`old
::
?: ?=(%1 -.old)
^- (quip card state-2)
:_ [%2 +>.old]
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] *]
^- (unit card)
?. &(?=([%mailbox *] wire) =(our.bol ship) =(%chat-store term))
~
`[%pass wire %agent [our.bol %chat-store] %leave ~]
^- (quip card state-2)
:: path structure ugprade logic
::
=/ keys=(set path) (scry:cc (set path) %chat-store /keys)
:_ [%2 +.old]
%- zing
^- (list (list card))
(turn ~(tap in keys) generate-cards)
[moves this]
::
++ generate-cards
|= old-chat=path
@ -234,10 +241,7 @@
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun
?: =(%store-load q.vase)
[loaded-cards.state state(loaded-cards ~)]
[~ state]
%noun [~ state]
::
%chat-hook-action
(poke-chat-hook-action:cc !<(action:hook vase))
@ -459,7 +463,7 @@
(chats-of-group pax)
|= chat=path
^- (list card)
=/ owner (~(get by synced) chat)
=/ owner (~(get by synced.state) chat)
?~ owner ~
?. =(u.owner our.bol) ~
%- zing

72
pkg/arvo/app/chat-store.hoon
View File

@ -5,17 +5,20 @@
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
state-one
state-two
$% state-0
state-1
state-2
==
::
+$ state-zero [%0 =inbox:store]
+$ state-one [%1 =inbox:store]
+$ state-two [%2 =inbox:store]
+$ state-0 [%0 =inbox:store]
+$ state-1 [%1 =inbox:store]
+$ state-2 [%2 =inbox:store]
+$ admin-action
$% [%trim ~]
==
--
::
=| state-two
=| state-2
=* state -
::
%- agent:dbug
@ -33,15 +36,25 @@
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
?: ?=(%2 -.old)
[~ this(state old)]
=/ reversed-inbox=inbox:store
%- ~(run by inbox.old)
=? old ?=(%0 -.old)
(old-to-2 inbox.old)
=? old ?=(%1 -.old)
(old-to-2 inbox.old)
:_ this(state [%2 inbox.old])
[%pass /trim %agent [our.bowl %chat-store] %poke %noun !>([%trim ~])]~
::
++ old-to-2
|= =inbox:store
^- state-2
:- %2
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
[~ this(state [%2 reversed-inbox])]
--
::
++ on-poke
~/ %chat-store-poke
@ -52,6 +65,7 @@
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun [~ (poke-noun:cc !<(admin-action vase))]
==
[cards this]
::
@ -148,6 +162,32 @@
[~ ~ %noun !>((swag [start (sub end start)] envelopes))]
==
::
++ poke-noun
|= nou=admin-action
^- _state
~& %trimming-chat-store
%_ state
inbox
%- ~(urn by inbox)
|= [=path mailbox:store]
^- mailbox:store
=/ [a=* out=(list envelope:store)]
%+ roll envelopes
|= $: =envelope:store
o=[[hav=(set serial:store) curr=@] out=(list envelope:store)]
==
?: (~(has in hav.o) uid.envelope)
[[hav.o curr.o] out.o]
:-
^- [(set serial:store) @]
[(~(put in hav.o) uid.envelope) +(curr.o)]
^- (list envelope:store)
[envelope(number curr.o) out.o]
=/ len (lent out)
~? !=(len (lent envelopes)) [path [%old (lent envelopes)] [%new len]]
[[len len] (flop out)]
==
::
++ poke-json
|= jon=json
^- (quip card _state)
@ -197,8 +237,11 @@
[~ state]
=. letter.envelope.action (evaluate-letter [author letter]:envelope.action)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.action)
:- (send-diff path.action action(envelope envelope))
state(inbox (~(put by inbox) path.action u.mailbox))
:_ state(inbox (~(put by inbox) path.action u.mailbox))
?: =((mod number.envelope 5.000) 0)
:- [%pass /trim %agent [our.bol %chat-store] %poke %noun !>([%trim ~])]
(send-diff path.action action(envelope envelope))
(send-diff path.action action(envelope envelope))
::
++ handle-messages
|= act=action:store
@ -213,6 +256,7 @@
|- ^- (quip card _state)
?~ envelopes.act
:_ state(inbox (~(put by inbox) path.act u.mailbox))
:- [%pass /trim %agent [our.bol %chat-store] %poke %noun !>([%trim ~])]
%+ send-diff path.act
[%messages path.act 0 (lent evaluated-envelopes) evaluated-envelopes]
=. letter.i.envelopes.act (evaluate-letter [author letter]:i.envelopes.act)

37
pkg/arvo/app/chat-view.hoon
View File

@ -1,19 +1,19 @@
:: chat-view: sets up chat JS client, paginates data, and combines commands
:: into semantic actions for the UI
::
/- *permission-store,
*permission-hook,
*group-store,
*invite-store,
*metadata-store,
*permission-group-hook,
*chat-hook,
*metadata-hook,
*rw-security,
hook=chat-hook
/+ *server, default-agent, verb, dbug,
store=chat-store,
view=chat-view
/- *permission-store
/- *permission-hook
/- *group-store
/- *invite-store
/- *metadata-store
/- *permission-group-hook
/- *chat-hook
/- *metadata-hook
/- *rw-security
/- hook=chat-hook
/+ *server, default-agent, verb, dbug
/+ store=chat-store
/+ view=chat-view
::
~% %chat-view-top ..is ~
|%
@ -96,7 +96,9 @@
++ truncated-inbox
^- inbox:store
=/ =inbox:store
.^(inbox:store %gx /=chat-store/(scot %da now.bol)/all/noun)
=/ our (scot %p our.bol)
=/ now (scot %da now.bol)
.^(inbox:store %gx /[our]/chat-store/[now]/all/noun)
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
@ -403,7 +405,12 @@
++ chat-scry
|= pax=path
^- (unit mailbox:store)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
=. pax
;: weld
/(scot %p our.bol)/chat-store/(scot %da now.bol)/mailbox
pax
/noun
==
.^((unit mailbox:store) %gx pax)
::
++ maybe-group-from-chat

18
pkg/arvo/app/contact-hook.hoon
View File

@ -456,20 +456,30 @@
++ contacts-scry
|= pax=path
^- (unit contacts)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contacts pax /noun)
=. pax
;: weld
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contacts
pax
/noun
==
.^((unit contacts) %gx pax)
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax
/=invite-store/(scot %da now.bol)/invite/contacts/(scot %uv uid)/noun
;: weld
/(scot %p our.bol)/invite-store/(scot %da now.bol)
/invite/contacts/(scot %uv uid)/noun
==
.^((unit invite) %gx pax)
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
.^ (unit group)
%gx
;:(weld /(scot %p our.bol)/group-store/(scot %da now.bol) pax /noun)
==
::
++ pull-wire
|= pax=path

26
pkg/arvo/app/contact-view.hoon
View File

@ -1,14 +1,15 @@
:: contact-view: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/- *group-store,
*group-hook,
*invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
*permission-group-hook,
*permission-hook
/- *group-store
/- *group-hook
/- *invite-store
/- *contact-hook
/- *metadata-store
/- *metadata-hook
/- *permission-group-hook
/- *permission-hook
::
/+ *server, *contact-json, default-agent, dbug
|%
+$ versioned-state
@ -256,11 +257,16 @@
::
++ all-scry
^- rolodex
.^(rolodex %gx /=contact-store/(scot %da now.bol)/all/noun)
.^(rolodex %gx /(scot %p our.bol)/contact-store/(scot %da now.bol)/all/noun)
::
++ contact-scry
|= pax=path
^- (unit contact)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contact pax /noun)
=. pax
;: weld
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contact
pax
/noun
==
.^((unit contact) %gx pax)
--

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

@ -360,12 +360,13 @@
:- %a
%+ turn
%+ sort ~(tap by sessions:auth-state:v-eyre)
|= [[@uv a=@da] [@uv b=@da]]
(gth a b)
|= [[@uv a=session:eyre] [@uv b=session:eyre]]
(gth expiry-time.a expiry-time.b)
|= [cookie=@uv session:eyre]
%- pairs
:~ 'cookie'^s+(end 3 4 (rsh 3 2 (scot %x (shax cookie))))
'expiry'^(time expiry-time)
'channels'^(numb ~(wyt in channels))
==
::
:: /eyre/channels.json

4
pkg/arvo/app/debug/index.html
View File

@ -12,8 +12,8 @@
<body class="w-100 h-100">
<div id="root" class="w-100 h-100">
</div>
<script src="/~channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~debug/js/index.js"></script>
</body>

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

@ -23,10 +23,10 @@
poy/(unit dojo-project) :: working
$: :: sur: structure imports
::
sur=(list cable:ford)
sur=(list cable:clay)
:: lib: library imports
::
lib=(list cable:ford)
lib=(list cable:clay)
==
var/(map term cage) :: variable state
old/(set term) :: used TLVs
@ -89,7 +89,7 @@
$: mad/dojo-command :: operation
num/@ud :: number of tasks
cud/(unit dojo-source) :: now solving
pux/(unit path) :: ford working
pux/(unit path) :: working
pro/(unit vase) :: prompting loop
per/(unit sole-edit) :: pending reverse
job/(map @ud dojo-build) :: problems
@ -100,6 +100,17 @@
--
=>
|%
:: TODO: move to zuse? copied from clay
::
++ with-face |=([face=@tas =vase] vase(p [%face face p.vase]))
++ with-faces
=| res=(unit vase)
|= vaz=(list [face=@tas =vase])
^- vase
?~ vaz (need res)
=/ faz (with-face i.vaz)
=. res `?~(res faz (slop faz u.res))
$(vaz t.vaz)
:: |parser-at: parsers for dojo expressions using :dir as working directory
::
++ parser-at
@ -177,13 +188,13 @@
::
++ parse-cables
%+ cook
|= cables=(list cable:ford)
|= cables=(list cable:clay)
:+ 0 %ex
^- hoon
::
:- %clsg
%+ turn cables
|= cable=cable:ford
|= cable=cable:clay
^- hoon
::
:+ %clhp
@ -194,7 +205,7 @@
(most ;~(plug com gaw) parse-cable)
::
++ parse-cable
%+ cook |=(a=cable:ford a)
%+ cook |=(a=cable:clay a)
;~ pose
(stag ~ ;~(pfix tar sym))
(cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym))
@ -312,23 +323,22 @@
dir
dir(r [%da now.hid])
::
++ he-disc `disc:ford`[p q]:he-beam
++ he-beak `beak`[p q r]:he-beam
++ he-rail `rail:ford`[[p q] s]:he-beam
++ he-parser (parser-at our.hid he-beam)
::
++ dy :: project work
|_ dojo-project ::
++ dy-abet +>(poy `+<) :: resolve
++ dy-amok +>(poy ~) :: terminate
++ dy-ford :: send work to ford
|= [way=wire schematic=schematic:ford]
:: +dy-sing: make a clay read request
::
++ dy-sing
|= [way=wire =care:clay =path]
^+ +>+>
?> ?=($~ pux)
:: pin all builds to :now.hid so they don't get cached forever
::
?> ?=(~ pux)
%- he-card(poy `+>+<(pux `way))
[%pass way %arvo %f %build live=%.n schematic]
=/ [=ship =desk =case:clay] he-beak
[%pass way %arvo %c %warp ship desk ~ %sing care case path]
::
++ dy-request
|= [way=wire =request:http]
@ -348,12 +358,8 @@
:: really shoud stop the thread as well
::
[%pass u.pux %agent [our.hid %spider] %leave ~]
[%pass u.pux %arvo %f %kill ~]
::
++ dy-slam :: call by ford
|= {way/wire gat/vase sam/vase}
^+ +>+>
(dy-ford way `schematic:ford`[%call [%$ %noun gat] [%$ %noun sam]])
=/ [=ship =desk =case:clay] he-beak
[%pass u.pux %arvo %c %warp ship desk ~]
::
++ dy-errd :: reject change, abet
|= {rev/(unit sole-edit) err/@u}
@ -479,7 +485,11 @@
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
~& %dy-no-prompt
(dy-diff %bel ~)
(dy-slam /dial u.pro !>(txt))
=/ res (mule |.((slam u.pro !>(txt))))
?: ?=(%| -.res)
%- (slog >%dy-done< p.res)
(dy-rash %bel ~) :: TODO: or +dy-abet(per ~) ?
(dy-made-dial %noun p.res)
::
++ dy-cast
|* {typ/_* bun/vase}
@ -516,13 +526,13 @@
$lib
%_ .
lib
((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay)
((dy-cast (list cable:clay) !>(*(list cable:clay))) q.cay)
==
::
$sur
%_ .
sur
((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay)
((dy-cast (list cable:clay) !>(*(list cable:clay))) q.cay)
==
::
$dir =+ ^= pax ^- path
@ -637,7 +647,12 @@
~& %dy-edit-busy
=^ lic say (~(transmit sole say) dat)
(dy-diff %mor [%det lic] [%bel ~] ~)
(dy-slam(per `dat) /edit u.pro !>((tufa buf.say)))
=> .(per `dat)
=/ res (mule |.((slam u.pro !>((tufa buf.say)))))
?: ?=(%| -.res)
%- (slog >%dy-edit< p.res)
(dy-rash %bel ~) :: TODO: or +dy-abet(per ~) ?
(dy-made-edit %noun p.res)
::
++ dy-type :: sole action
|= act/sole-action
@ -657,43 +672,78 @@
!>(~)
(slop (dy-vase p.i.src) $(src t.src))
::
++ dy-silk-vase |=(vax/vase [%$ %noun vax]) :: vase to silk
++ dy-silk-sources :: arglist to silk
|= src/(list dojo-source)
^- schematic:ford
[%$ %noun (dy-sore src)]
::
++ dy-silk-config :: configure
|= {cay/cage cig/dojo-config}
^- [wire schematic:ford]
++ dy-run-generator
!.
|= [cay=cage cig=dojo-config]
^+ +>+>
?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay)
::
:: naked gate
:: naked generator; takes one argument
::
?. &(?=({* ~} p.cig) ?=(~ q.cig))
~|(%one-argument !!)
:- /noun
:+ %call [%$ %noun q.cay]
[%$ %noun (dy-vase p.i.p.cig)]
::
=/ res (mule |.((slam q.cay (dy-vase p.i.p.cig))))
?: ?=(%| -.res)
(he-diff(poy ~) %tan p.res) :: TODO: or +dy-rash ?
(dy-hand %noun p.res)
:: normal generator
::
:- ?+ -.q.q.cay ~|(%bad-gen ~_((sell (slot 2 q.cay)) !!))
$say /gent
$ask /dial
:: A normal generator takes as arguments:
:: - event args: date, entropy, beak (network location)
:: - positional arguments, as a list
:: - optional keyword arguments, as name-value pairs
::
:: The generator is a pair of a result mark and a gate.
:: TODO: test %ask generators
::
=/ wat (mule |.(!<(?(%ask %say) (slot 2 q.cay))))
?: ?=(%| -.wat)
(he-diff(poy ~) %tan p.wat)
=- =/ res (mule -)
?: ?=(%| -.res)
(he-diff(poy ~) %tan leaf+"dojo: generator failure" p.res)
?- p.wat
%ask (dy-made-dial %noun p.res)
%say (dy-made-gent %noun p.res)
==
=+ gat=(slot 3 q.cay)
:+ %call [%$ %noun gat]
:+ [%$ %noun !>([now=now.hid eny=eny.hid bec=he-beak])]
(dy-silk-sources p.cig)
:+ %mute [%$ %noun (fall (slew 27 gat) !>(~))]
^- (list [wing schematic:ford])
%+ turn ~(tap by q.cig)
|= {a/term b/(unit dojo-source)}
^- [wing schematic:ford]
:- [a ~]
:+ %$ %noun
?~(b !>([~ ~]) (dy-vase p.u.b))
:: gat: generator gate
:: som: default gat sample
:: ven: event arguments
:: poz: positional arguments
:: kev: key-value named arguments
:: kuv: default keyword arguments
:: sam: fully populated sample
:: rog: default gat sample
::
|. ^- vase
=/ gat=vase (slot 3 q.cay)
=/ som=vase (slot 6 gat)
=/ ven=vase !>([now=now.hid eny=eny.hid bec=he-beak])
=/ poz=vase (dy-sore p.cig)
=/ kev=vase
=/ kuv=(unit vase) (slew 7 som)
?: =(~ q.cig)
(fall kuv !>(~))
=/ soz=(list [var=term vax=vase])
%~ tap by
%- ~(run by q.cig)
|=(val=(unit dojo-source) ?~(val !>([~ ~]) (dy-vase p.u.val)))
~| keyword-arg-failure+~(key by q.cig)
%+ slap
(with-faces kuv+(need kuv) rep+(with-faces soz) ~)
:+ %cncb [%kuv]~
%+ turn soz
|= [var=term *]
^- [wing hoon]
[[var]~ [%wing var %rep ~]]
::
=/ sam=vase :(slop ven poz kev)
?. (~(nest ut p.som) | p.sam)
~> %slog.1^leaf+"dojo: nest-need"
~> %slog.0^(skol p.som)
~> %slog.1^leaf+"dojo: nest-have"
~> %slog.0^(skol p.sam)
!!
(slam gat sam)
::
++ dy-made-dial :: dialog product
|= cag/cage
@ -742,51 +792,81 @@
++ dy-make :: build step
^+ +>
?> ?=(^ cud)
=+ bil=q.u.cud :: XX =*
?: ?=($ur -.bil)
(dy-request /hand `request:http`[%'GET' p.bil ~ ~])
?: ?=($te -.bil)
(dy-wool-poke p.bil q.bil)
%- dy-ford
^- [path schematic:ford]
?- -.bil
$ge (dy-silk-config (dy-cage p.p.p.bil) q.p.bil)
$dv [/hand [%core [he-disc (weld /hoon (flop p.bil))]]]
$ex [/hand (dy-mare p.bil)]
$sa [/hand [%bunt he-disc p.bil]]
$as [/hand [%cast he-disc p.bil [%$ (dy-cage p.q.bil)]]]
$do [/hand [%call (dy-mare p.bil) [%$ (dy-cage p.q.bil)]]]
$tu :- /hand
:+ %$ %noun
|- ^- vase
?~ p.bil !!
=+ hed=(dy-vase p.i.p.bil)
?~ t.p.bil hed
(slop hed $(p.bil t.p.bil))
=/ bil q.u.cud
?- -.bil
%ur (dy-request /hand `request:http`[%'GET' p.bil ~ ~])
%te (dy-wool-poke p.bil q.bil)
%ex (dy-mere p.bil)
%dv (dy-sing hand+p.bil %a (snoc p.bil %hoon))
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa
=+ .^(=dais:clay cb+(en-beam:format he-beak /[p.bil]))
(dy-hand p.bil bunt:dais)
::
%as
=/ cag=cage (dy-cage p.q.bil)
=+ .^(=tube:clay cc+(en-beam:format he-beak /[p.bil]/[p.cag]))
(dy-hand p.bil (tube q.cag))
::
%do
=/ gat (dy-eval p.bil)
?: ?=(%| -.gat)
(he-diff(poy ~) %tan p.gat)
=/ res (mule |.((slam q.p.gat (dy-vase p.q.bil))))
?: ?=(%| -.res)
(he-diff(poy ~) %tan p.res)
(dy-hand %noun p.res)
::
%tu
%+ dy-hand %noun
|- ^- vase
?~ p.bil !!
=/ hed (dy-vase p.i.p.bil)
?~ t.p.bil hed
(slop hed $(p.bil t.p.bil))
==
:: +dy-hoon-var: if input is a dojo variable lookup, perform it
::
++ dy-hoon-mark :: XX architect
:: If the expression is a bare reference to a Dojo variable,
:: produce that variable's value; otherwise, produce ~.
::
++ dy-hoon-var
=+ ^= ope
|= gen/hoon ^- hoon
?: ?=(?($sgld $sgbn) -.gen)
$(gen q.gen)
=+ ~(open ap gen)
?.(=(gen -) $(gen -) gen)
|= gen/hoon ^- (unit mark)
|= gen/hoon ^- (unit cage)
=. gen (ope gen)
?: ?=({$cnts {@ ~} ~} gen)
(bind (~(get by var) i.p.gen) head)
(~(get by var) i.p.gen)
~
:: +dy-mere: execute hoon and complete construction step
::
++ dy-mare :: build expression
|= gen/hoon
^- schematic:ford
=+ too=(dy-hoon-mark gen)
=- ?~(too - [%cast he-disc u.too -])
:+ %ride gen
:- [%$ he-hoon-head]
:^ %plan he-rail `coin`blob+**
`scaffold:ford`[he-rail zuse sur lib ~ ~]
++ dy-mere
|= =hoon
=/ res (dy-eval hoon)
?: ?=(%| -.res)
(he-diff(poy ~) %tan p.res)
(dy-hand p.res)
:: +dy-eval: run hoon source against the dojo subject
::
:: TODO: use /lib and /sur imports to construct subject
::
++ dy-eval
|= =hoon
^- (each cage tang)
?^ val=(dy-hoon-var hoon)
&+u.val
!.
%- mule |.
:- %noun
=/ vaz=(list [term vase])
(turn ~(tap by var) |=([lal=term cag=cage] [lal q.cag]))
=/ sut (slop !>([our=our now=now eny=eny]:hid) !>(..zuse))
=? sut ?=(^ vaz) (slop (with-faces vaz) sut)
(slap sut hoon)
::
++ dy-step :: advance project
|= nex/@ud
@ -875,38 +955,17 @@
:- %pro
[& %$ (weld he-prow ?~(buf "> " "< "))]
::
++ he-made :: result from ford
|= $: way=wire
date=@da
$= result
$% [%complete build-result=build-result:ford]
[%incomplete =tang]
== ==
++ he-writ
|= [way=wire =riot:clay]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.result
%incomplete
(he-diff(poy ~) %tan tang.result)
::
%complete
?- -.build-result.result
::
%success
::
%. (result-to-cage:ford build-result.result)
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
{$hand ~} dy-hand:dye
{$dial ~} dy-made-dial:dye
{$gent ~} dy-made-gent:dye
{$noun ~} dy-made-noun:dye
{$edit ~} dy-made-edit:dye
==
::
%error
(he-diff(poy ~) %tan message.build-result.result)
== ==
?+ way !!
[%hand *]
?~ riot
(he-diff(poy ~) %tan >%generator-build-fail< >(snoc t.way %hoon)< ~)
(~(dy-hand dy u.poy(pux ~)) noun+!<(vase q.r.u.riot))
==
::
++ he-unto :: result from agent
|= {way/wire cit/sign:agent:gall}
@ -1449,7 +1508,7 @@
=^ moves state
=< he-abet
?+ +<.sign-arvo ~|([%dojo-bad-take +<.sign-arvo] !!)
%made (he-made:he-full t.wire +>.sign-arvo)
%writ (he-writ:he-full t.wire +>.sign-arvo)
%http-response (he-http-response:he-full t.wire +>.sign-arvo)
==
[moves ..on-init]

13
pkg/arvo/app/file-server.hoon
View File

@ -139,7 +139,7 @@
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
-.u.clay-path
(lowercase -.u.clay-path)
==
?. .^(? %cu scry-path) [not-found:gen %.n]
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
@ -151,6 +151,17 @@
[~ %png] (png-response:gen file)
==
::
++ lowercase
|= upper=(list @t)
%+ turn upper
|= word=@t
%- crip
%+ turn (rip 3 word)
|= char=@t
?. &((gte char 'A') (lte char 'Z'))
char
(add char ^~((sub 'a' 'A')))
::
++ get-clay-path
|= pax=path
^- (unit [path ?])

50
pkg/arvo/app/goad.hoon
View File

@ -3,30 +3,15 @@
^- agent:gall
=>
|%
++ warp
|= =bowl:gall
[%pass /clay %arvo %c %warp our.bowl %home ~ %next %z da+now.bowl /sys]
::
++ wait
|= =bowl:gall
[%pass /behn %arvo %b %wait +(now.bowl)]
::
++ goad
|= force=?
:~ [%pass /gall %arvo %g %goad force ~]
==
--
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
++ on-init
:: subscribe to /sys and do initial goad
::
[[(warp bowl) (wait bowl) ~] this]
::
++ on-save on-save:def
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
?: ?=([%noun * %go] +<)
@ -35,32 +20,19 @@
[(goad &) this]
(on-poke:def mark vase)
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
?+ wire (on-arvo:def wire sign-arvo)
[%clay ~]
:: on writ, wait
::
?> ?=(%writ +<.sign-arvo)
:_ this
:~ (warp bowl)
(wait bowl)
==
::
[%behn ~]
:: on wake, goad
::
?> ?=(%wake +<.sign-arvo)
?^ error.sign-arvo
:_ this :_ ~
[%pass /dill %arvo %d %flog %crud %goad-fail u.error.sign-arvo]
%- (slog leaf+"goad: recompiling all apps" ~)
[(goad &) this]
|= [wir=wire sin=sign-arvo]
?+ wir (on-arvo:def wir sin)
[%clay ~] `this
[%behn ~] `this :: backcompat
==
::
++ on-agent on-agent:def
++ on-fail on-fail:def
++ on-init on-init:def
++ on-leave on-leave:def
++ on-load on-load:def
++ on-peek on-peek:def
++ on-save on-save:def
++ on-watch on-watch:def
--

11
pkg/arvo/app/group-hook.hoon
View File

@ -68,7 +68,7 @@
?. (~(has by synced.state) t.path)
(on-watch:def path)
=/ scry-path=^path
:(welp /=group-store/(scot %da now.bowl) t.path /noun)
:(welp /(scot %p our.bowl)/group-store/(scot %da now.bowl) t.path /noun)
=/ grp=(unit group)
.^((unit group) %gx scry-path)
?~ grp
@ -242,8 +242,13 @@
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
.^ (unit group)
%gx
(scot %p our.bol)
%group-store
(scot %da now.bol)
(weld pax /noun)
==
::
++ update-subscribers
|= [pax=path diff=group-update]

295
pkg/arvo/app/hood.hoon
View File

@ -1,228 +1,107 @@
:: :: ::
:::: /hoon/hood/app :: ::
:: :: ::
/? 310 :: zuse version
/- *sole
/+ sole, :: libraries
:: XX these should really be separate apps, as
:: none of them interact with each other in
:: any fashion; however, to reduce boot-time
:: complexity and work around the current
:: non-functionality of end-to-end acknowledgments,
:: they have been bundled into :hood
::
:: |command handlers
hood-helm, hood-kiln, hood-drum, hood-write
:: :: ::
:::: :: ::
:: :: ::
/+ default-agent
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
++ hood-module
:: each hood module follows this general shape
=> |%
+$ part [%module %0 pith]
+$ pith ~
++ take
|~ [wire sign-arvo]
*(quip card:agent:gall part)
++ take-agent
|~ [wire gift:agent:gall]
*(quip card:agent:gall part)
++ poke
|~ [mark vase]
*(quip card:agent:gall part)
--
|= [bowl:gall own=part]
|_ moz=(list card:agent:gall)
++ abet [(flop moz) own]
--
+$ state
$: %7
drum=state:drum
helm=state:helm
kiln=state:kiln
==
+$ any-state
$% state
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
==
+$ any-state-tuple
$: drum=any-state:drum
helm=any-state:helm
kiln=any-state:kiln
==
+$ fin-any-state
$% [%drum any-state:drum]
[%helm any-state:helm]
[%kiln any-state:kiln]
[%write *] :: gets deleted
==
--
:: :: ::
:::: :: :: state handling
:: :: ::
!:
=> |% ::
++ hood-old :: unified old-state
{?($1 $2 $3 $4 $5 $6) lac/(map @tas hood-part-old)}
++ hood-1 :: unified state
{$6 lac/(map @tas hood-part)} ::
++ hood-good :: extract specific
=+ hed=$:hood-head
|@ ++ $
|: paw=$:hood-part
?- hed
$drum ?>(?=($drum -.paw) `part:hood-drum`paw)
$helm ?>(?=($helm -.paw) `part:hood-helm`paw)
$kiln ?>(?=($kiln -.paw) `part:hood-kiln`paw)
$write ?>(?=($write -.paw) `part:hood-write`paw)
==
--
++ hood-head _-:$:hood-part :: initialize state
++ hood-make ::
=+ $:{our/@p hed/hood-head} ::
|@ ++ $
?- hed
$drum (make:hood-drum our)
$helm *part:hood-helm
$kiln *part:hood-kiln
$write *part:hood-write
==
--
++ hood-part-old hood-part :: old state for ++prep
++ hood-port :: state transition
|: paw=$:hood-part-old ^- hood-part ::
paw ::
:: ::
++ hood-part :: current module state
$% {$drum $2 pith-2:hood-drum} ::
{$helm $0 pith:hood-helm} ::
{$kiln $0 pith:hood-kiln} ::
{$write $0 pith:hood-write} ::
== ::
-- ::
:: :: ::
:::: :: :: app proper
:: :: ::
^- agent:gall
=| hood-1 :: module states
=> |%
++ help
|= hid/bowl:gall
|%
++ able :: find+make part
=+ hed=$:hood-head
|@ ++ $
=+ rep=(~(get by lac) hed)
=+ par=?^(rep u.rep `hood-part`(hood-make our.hid hed))
((hood-good hed) par)
--
::
++ ably :: save part
=+ $:{(list) hood-part}
|@ ++ $
[+<- (~(put by lac) +<+< +<+)]
--
:: :: ::
:::: :: :: generic handling
:: :: ::
++ prep
|= old/(unit hood-old) ^- (quip _!! _+>)
:- ~
?~ old +>
+>(lac (~(run by lac.u.old) hood-port))
::
++ poke-hood-load :: recover lost brain
|= dat/hood-part
?> =(our.hid src.hid)
~& loaded+-.dat
[~ (~(put by lac) -.dat dat)]
::
::
++ from-module :: create wrapper
|* _[identity=%module start=..$ finish=_abet]:(hood-module)
=- [wrap=- *start] :: usage (wrap handle-arm):from-foo
|* handle/_finish
|= a=_+<.handle
=. +>.handle (start hid (able identity))
^- (quip card:agent:gall _lac)
%- ably
^- (quip card:agent:gall hood-part)
(handle a)
:: per-module interface wrappers
++ from-drum (from-module %drum [..$ _se-abet]:(hood-drum))
++ from-helm (from-module %helm [..$ _abet]:(hood-helm))
++ from-kiln (from-module %kiln [..$ _abet]:(hood-kiln))
++ from-write (from-module %write [..$ _abet]:(hood-write))
--
--
|_ hid/bowl:gall :: gall environment
=| =state
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
drum-core (drum bowl drum.state)
helm-core (helm bowl helm.state)
kiln-core (kiln bowl kiln.state)
::
++ on-fail on-fail:def
++ on-init
`..on-init
::
++ on-save
!>([%6 lac])
^- step:agent:gall
=^ d drum.state on-init:drum-core
[d this]
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-save !>(state)
++ on-load
|= =old-state=vase
=/ old-state !<(hood-old old-state-vase)
=^ cards lac
=. lac lac.old-state
?- -.old-state
%1 ((wrap on-load):from-drum:(help hid) %1)
%2 ((wrap on-load):from-drum:(help hid) %2)
%3 ((wrap on-load):from-drum:(help hid) %3)
%4 ((wrap on-load):from-drum:(help hid) %4)
%5 ((wrap on-load):from-drum:(help hid) %5)
%6 `lac
^- step:agent:gall
=+ !<(old=any-state old-state-vase)
=/ tup=any-state-tuple
?+ -.old +.old
?(%1 %2 %3 %4 %5 %6)
:* =-(?>(?=(%drum -<) ->) (~(got by lac.old) %drum))
=-(?>(?=(%helm -<) ->) (~(got by lac.old) %helm))
=-(?>(?=(%kiln -<) ->) (~(got by lac.old) %kiln))
==
==
[cards ..on-init]
=^ d drum.state (on-load:drum-core -.old drum.tup)
=^ h helm.state (on-load:helm-core -.old helm.tup)
=^ k kiln.state (on-load:kiln-core -.old kiln.tup)
[:(weld d h k) this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
=/ h (help hid)
=^ cards lac
?: =(%helm (end 3 4 mark))
((wrap poke):from-helm:h mark vase)
?: =(%drum (end 3 4 mark))
((wrap poke):from-drum:h mark vase)
?: =(%kiln (end 3 4 mark))
((wrap poke):from-kiln:h mark vase)
?: =(%write (end 3 5 mark))
((wrap poke):from-write:h mark vase)
:: XX should rename and move to libs
::
?+ mark ~|([%poke-hood-bad-mark mark] !!)
%hood-load (poke-hood-load:h !<(hood-part vase))
%atom ((wrap poke-atom):from-helm:h !<(@ vase))
%dill-belt ((wrap poke-dill-belt):from-drum:h !<(dill-belt:dill vase))
%dill-blit ((wrap poke-dill-blit):from-drum:h !<(dill-blit:dill vase))
%hood-sync ((wrap poke-sync):from-kiln:h !<([desk ship desk] vase))
==
[cards ..on-init]
^- step:agent:gall
|^
=/ fin (end 3 4 mark)
?: =(%drum fin) poke-drum
?: =(%helm fin) poke-helm
?: =(%kiln fin) poke-kiln
::
?+ mark (on-poke:def mark vase)
%atom poke-helm(mark %helm-atom)
%dill-belt poke-drum(mark %drum-dill-belt)
%dill-blit poke-drum(mark %drum-dill-blit)
%hood-sync poke-kiln(mark %kiln-sync)
%write-sec-atom poke-helm(mark %helm-write-sec-atom)
==
++ poke-drum =^(c drum.state (poke:drum-core mark vase) [c this])
++ poke-helm =^(c helm.state (poke:helm-core mark vase) [c this])
++ poke-kiln =^(c kiln.state (poke:kiln-core mark vase) [c this])
--
::
++ on-watch
|= =path
=/ h (help hid)
=^ cards lac
?+ path ~|([%hood-bad-path wire] !!)
[%drum *] ((wrap peer):from-drum:h t.path)
==
[cards ..on-init]
::
++ on-leave
|= path
`..on-init
::
++ on-peek
|= path
*(unit (unit cage))
^- step:agent:gall
?+ path (on-watch:def +<)
[%drum *] =^(c drum.state (peer:drum-core +<) [c this])
==
::
++ on-agent
|= [=wire =sign:agent:gall]
=/ h (help hid)
=^ cards lac
?+ wire ~|([%hood-bad-wire wire] !!)
[%helm *] ((wrap take-agent):from-helm:h wire sign)
[%kiln *] ((wrap take-agent):from-kiln:h wire sign)
[%drum *] ((wrap take-agent):from-drum:h wire sign)
[%write *] ((wrap take-agent):from-write:h wire sign)
==
[cards ..on-init]
^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-agent:drum-core +<) [c this])
[%helm *] =^(c helm.state (take-agent:helm-core +<) [c this])
[%kiln *] =^(c kiln.state (take-agent:kiln-core +<) [c this])
==
:: TODO: symmetry between adding and stripping wire prefixes
::
++ on-arvo
|= [=wire =sign-arvo]
=/ h (help hid)
=^ cards lac
?+ wire ~|([%hood-bad-wire wire] !!)
[%helm *] ((wrap take):from-helm:h t.wire sign-arvo)
[%drum *] ((wrap take):from-drum:h t.wire sign-arvo)
[%kiln *] ((wrap take-general):from-kiln:h t.wire sign-arvo)
[%write *] ((wrap take):from-write:h t.wire sign-arvo)
==
[cards ..on-init]
::
++ on-fail
|= [term tang]
`..on-init
|= [=wire syn=sign-arvo]
^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-arvo:drum-core t.wire syn) [c this])
[%helm *] =^(c helm.state (take-arvo:helm-core t.wire syn) [c this])
[%kiln *] =^(c kiln.state (take-arvo:kiln-core t.wire syn) [c this])
==
--

12
pkg/arvo/app/invite-hook.hoon
View File

@ -100,14 +100,22 @@
|= pax=path
^- (unit invitatory)
=. pax
;:(weld /=invite-store/(scot %da now.bowl)/invitatory pax /noun)
;: weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invitatory
pax
/noun
==
.^((unit invitatory) %gx pax)
::
++ invite-scry
|= [pax=path uid=serial]
^- (unit invite)
=. pax
;:(weld /=invite-store/(scot %da now.bowl)/invite pax /(scot %uv uid)/noun)
;: weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invite
pax
/(scot %uv uid)/noun
==
.^((unit invite) %gx pax)
--

17
pkg/arvo/app/invite-view.hoon Normal file
View File

@ -0,0 +1,17 @@
/+ default-agent
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
step `step:agent:gall`[~ this]
++ on-init on-init:def
++ on-save on-save:def
++ on-load on-load:def
++ on-poke |=(* step)
++ on-watch on-watch:def
++ on-leave |=(* step)
++ on-peek |=(* ~)
++ on-agent |=(* step)
++ on-arvo |=(* step)
++ on-fail on-fail:def
--

0
pkg/arvo/app/landscape/img/Chat.png → pkg/arvo/app/landscape/img/.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 4.7 KiB

After

Width:  |  Height:  |  Size: 4.7 KiB

BIN
pkg/arvo/app/landscape/img/chat.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.7 KiB

0
pkg/arvo/app/landscape/img/ChatSwitcherClosed.png → pkg/arvo/app/landscape/img/chatswitcherclosed.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

0
pkg/arvo/app/landscape/img/ChatSwitcherLink.png → pkg/arvo/app/landscape/img/chatswitcherlink.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.4 KiB

After

Width:  |  Height:  |  Size: 1.4 KiB

0
pkg/arvo/app/landscape/img/Chevron.png → pkg/arvo/app/landscape/img/chevron.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 453 B

After

Width:  |  Height:  |  Size: 453 B

0
pkg/arvo/app/landscape/img/CodeEval.png → pkg/arvo/app/landscape/img/codeeval.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 611 B

After

Width:  |  Height:  |  Size: 611 B

0
pkg/arvo/app/landscape/img/Dojo.png → pkg/arvo/app/landscape/img/dojo.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

0
pkg/arvo/app/landscape/img/Favicon.png → pkg/arvo/app/landscape/img/favicon.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

0
pkg/arvo/app/landscape/img/Icon-Home.png → pkg/arvo/app/landscape/img/icon-home.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 255 B

After

Width:  |  Height:  |  Size: 255 B

0
pkg/arvo/app/landscape/img/ImageUpload.png → pkg/arvo/app/landscape/img/imageupload.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 865 B

After

Width:  |  Height:  |  Size: 865 B

0
pkg/arvo/app/landscape/img/Link.png → pkg/arvo/app/landscape/img/link.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

0
pkg/arvo/app/landscape/img/Links.png → pkg/arvo/app/landscape/img/links.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

0
pkg/arvo/app/landscape/img/Publish.png → pkg/arvo/app/landscape/img/publish.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.7 KiB

After

Width:  |  Height:  |  Size: 3.7 KiB

0
pkg/arvo/app/landscape/img/Send.png → pkg/arvo/app/landscape/img/send.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1010 B

After

Width:  |  Height:  |  Size: 1010 B

0
pkg/arvo/app/landscape/img/Spinner.png → pkg/arvo/app/landscape/img/spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

94
pkg/arvo/app/language-server.hoon
View File

@ -101,7 +101,7 @@
=^ cards state
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%e %bound *] `state
[%f *] (handle-build:lsp wire +.sign-arvo)
[%c *] (handle-build:lsp wire +.sign-arvo)
==
[cards this]
::
@ -192,13 +192,10 @@
^- (quip card _state)
~& > %lsp-shutdown
:_ *state-zero
%- zing
%+ turn
~(tap in ~(key by builds))
|= uri=@t
:+ [%pass /ford/[uri] %arvo %f %kill ~]
[%pass /ford/[uri]/deps %arvo %f %kill ~]
~
[%pass /ford/[uri] %arvo %c %warp our.bow %home ~]
::
++ handle-did-close
|= [uri=@t version=(unit @)]
@ -210,10 +207,7 @@
=. builds
(~(del by builds) uri)
:_ state
:~
[%pass /ford/[uri] %arvo %f %kill ~]
[%pass /ford/[uri]/deps %arvo %f %kill ~]
==
[%pass /ford/[uri] %arvo %c %warp our.bow %home ~]~
::
++ handle-did-save
|= [uri=@t version=(unit @)]
@ -240,43 +234,25 @@
`state
::
++ handle-build
|= [=path =gift:able:ford]
|= [=path =gift:able:clay]
^- (quip card _state)
?. ?=([%made *] gift)
[~ state]
?. ?=([%complete *] result.gift)
[~ state]
?> ?=([%writ *] gift)
=/ uri=@t
(snag 1 path)
=/ =build-result:ford
build-result.result.gift
?+ build-result [~ state]
::
[%success %plan *]
=. preludes
(~(put by preludes) uri -:vase.build-result)
=; res=(quip card _state)
[(snoc -.res (build-file | uri path)) +.res]
?~ p.gift
[~ state]
::
[%success %core *]
=. builds
(~(put by builds) uri vase.build-result)
=. ford-diagnostics
(~(del by ford-diagnostics) uri)
:_ state
(give-rpc-notification (get-diagnostics uri))
::
[%error *]
=/ error-ranges=(list =range:lsp-sur)
(get-errors-from-tang:build uri message.build-result)
?~ error-ranges
[~ state]
=. ford-diagnostics
%+ ~(put by ford-diagnostics)
uri
[i.error-ranges 1 'Build Error']~
:_ state
(give-rpc-notification (get-diagnostics uri))
==
=. builds
(~(put by builds) uri q.r.u.p.gift)
=. ford-diagnostics
(~(del by ford-diagnostics) uri)
=+ .^(=open:clay %cs /(scot %p our.bow)/home/(scot %da now.bow)/open)
=/ =type -:(open (uri-to-path:build uri))
=. preludes
(~(put by preludes) uri type)
:_ state
(give-rpc-notification (get-diagnostics uri))
::
++ get-diagnostics
|= uri=@t
@ -287,20 +263,14 @@
(~(gut by ford-diagnostics) uri ~)
(get-parser-diagnostics uri)
::
++ get-build-deps
|= [=path buf=wall]
^- schematic:ford
=/ parse=(like scaffold:ford)
%+ (lsp-parser [byk.bow path]) [1 1]
(zing (join "\0a" buf))
=/ =scaffold:ford
?~ q.parse *scaffold:ford
p.u.q.parse
:* %plan
[[our.bow %home] (flop path)]
*coin
scaffold(sources `(list hoon)`~[[%cnts ~[[%& 1]] ~]])
==
++ build-file
|= [eager=? uri=@t =path]
^- card
=/ =rave:clay
?: eager
[%sing %a da+now.bow path]
[%next %a da+now.bow path]
[%pass /ford/[uri] %arvo %c %warp our.bow %home `rave]
::
++ handle-did-open
|= item=text-document-item:lsp-sur
@ -311,18 +281,10 @@
(~(put by bufs) uri.item buf)
=/ =path
(uri-to-path:build uri.item)
=/ =schematic:ford
[%core [our.bow %home] (flop path)]
=/ dep-schematic=schematic:ford
(get-build-deps path buf)
:_ state
%+ weld
(give-rpc-notification (get-diagnostics uri.item))
^- (list card)
:~
[%pass /ford/[uri.item] %arvo %f %build live=%.y schematic]
[%pass /ford/[uri.item]/deps %arvo %f %build live=%.y dep-schematic]
==
[(build-file & uri.item path) ~]
::
++ get-parser-diagnostics
|= uri=@t
@ -330,7 +292,7 @@
=/ t=tape
(zing (join "\0a" `wall`(~(got by bufs) uri)))
=/ parse
(lily:auto t (lsp-parser *beam))
(lily:auto t (lsp-parser (uri-to-path:build uri)))
?. ?=(%| -.parse)
~
=/ loc=position:lsp-sur

4
pkg/arvo/app/lens.hoon
View File

@ -1,7 +1,6 @@
/- lens, *sole
/+ base64, *server, default-agent
/= lens-mark /: /===/mar/lens/command
/!noun/
/= lens-mark /mar/lens/command :: TODO: ask clay to build a $tube
=, format
|%
:: +lens-out: json or named octet-stream
@ -15,7 +14,6 @@
job=(unit [eyre-id=@ta com=command:lens])
==
==
::
--
::
=| =state

24
pkg/arvo/app/link-listen-hook.hoon
View File

@ -14,8 +14,8 @@
:: to expede this process, we prod other potential listeners when we add
:: them to our metadata+groups definition.
::
/- link-listen-hook, *metadata-store, *link, group-store
/+ mdl=metadata, default-agent, verb, dbug
/- *link, listen-hook=link-listen-hook, *metadata-store, group-store
/+ mdl=metadata, default-agent, verb, dbug, store=link-store
::
~% %link-listen-hook-top ..is ~
|%
@ -167,7 +167,7 @@
?> (team:title [our src]:bowl)
=^ cards state
~| p.vase
(handle-listen-action:do !<(action:link-listen-hook vase))
(handle-listen-action:do !<(action:listen-hook vase))
[cards this]
==
::
@ -218,7 +218,7 @@
:: user actions & updates
::
++ handle-listen-action
|= =action:link-listen-hook
|= =action:listen-hook
^- (quip card _state)
::NOTE no-opping where appropriate happens further down the call stack.
:: we *could* no-op here, as %watch when we're already listening should
@ -250,7 +250,7 @@
$(cards (weld cards more-cards), groups t.groups)
::
++ send-update
|= =update:link-listen-hook
|= =update:listen-hook
^- card
[%give %fact ~[/listening] %link-listen-update !>(update)]
::
@ -500,11 +500,11 @@
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-initial
%- handle-link-initial
[who.target where.target !<(initial vase)]
[who.target where.target !<(initial:store vase)]
::
%link-update
%- handle-link-update
[who.target where.target !<(update vase)]
[who.target where.target !<(update:store vase)]
==
==
::
@ -546,7 +546,7 @@
group-path
::
++ do-link-action
|= [=wire =action]
|= [=wire =action:store]
^- card
:* %pass
wire
@ -558,7 +558,7 @@
==
::
++ handle-link-initial
|= [who=ship where=path =initial]
|= [who=ship where=path =initial:store]
^- (quip card _state)
?> =(src.bowl who)
?+ -.initial ~|([dap.bowl %unexpected-initial -.initial] !!)
@ -580,7 +580,7 @@
==
::
++ handle-link-update
|= [who=ship where=path =update]
|= [who=ship where=path =update:store]
^- (quip card _state)
?> =(src.bowl who)
:_ state
@ -594,11 +594,11 @@
::
%annotations
%+ turn notes.update
|= =note
|= =^note
^- card
%+ do-link-action
[%forward %annotation (scot %p who) where]
[%read where url.update who note]
[%read where url.update `comment`[who note]]
==
::
++ take-forward-sign

6
pkg/arvo/app/link-proxy-hook.hoon
View File

@ -19,8 +19,8 @@
:: when adding support for new paths, the only things you'll likely want
:: to touch are +permitted, +initial-response, & +kick-proxies.
::
/- group-store, *metadata-store
/+ *link, metadata, default-agent, verb, dbug
/- *link, group-store, *metadata-store
/+ store=link-store, metadata, default-agent, verb, dbug
~% %link-proxy-hook-top ..is ~
|%
+$ state-0
@ -269,7 +269,7 @@
++ initial-response
|= =path
^- card
=; =initial
=; =initial:store
[%give %fact ~ %link-initial !>(initial)]
?+ path !!
[%local-pages ^]

39
pkg/arvo/app/link-store.hoon
View File

@ -50,7 +50,8 @@
:: ?
:: /seen/wood-url/some-path have we seen this here
::
/+ *link, default-agent, verb, dbug
/- *link
/+ store=link-store, default-agent, verb, dbug
::
|%
+$ state-0
@ -101,8 +102,8 @@
=^ cards state
?+ mark (on-poke:def mark vase)
::TODO move json conversion into mark once mark performance improves
%json (do-action:do (action:de-json !<(json vase)))
%link-action (do-action:do !<(action vase))
%json (do-action:do (action:dejs:store !<(json vase)))
%link-action (do-action:do !<(action:store vase))
==
[cards this]
::
@ -121,7 +122,7 @@
::
[%y ?(%annotations %discussions) *]
=/ [spath=^path surl=url]
(break-discussion-path t.t.path)
(break-discussion-path:store t.t.path)
=- ``noun+!>(-)
::
?: =(~ surl)
@ -174,22 +175,22 @@
|^ ?+ path (on-watch:def path)
[%local-pages *]
%+ give %link-initial
^- initial
^- initial:store
[%local-pages (get-local-pages:do t.path)]
::
[%submissions *]
%+ give %link-initial
^- initial
^- initial:store
[%submissions (get-submissions:do t.path)]
::
[%annotations *]
%+ give %link-initial
^- initial
^- initial:store
[%annotations (get-annotations:do t.path)]
::
[%discussions *]
%+ give %link-initial
^- initial
^- initial:store
[%discussions (get-discussions:do t.path)]
::
[%seen ~]
@ -218,7 +219,7 @@
:: writing
::
++ do-action
|= =action
|= =action:store
^- (quip card _state)
?- -.action
%save (save-page +.action)
@ -284,8 +285,8 @@
:+ %give %fact
:+ :~ /annotations
[%annotations %$ path]
[%annotations (build-discussion-path url)]
[%annotations (build-discussion-path path url)]
[%annotations (build-discussion-path:store url)]
[%annotations (build-discussion-path:store path url)]
==
%link-update
!>([%annotations path url [note]~])
@ -324,11 +325,11 @@
?: ?=(^ (find ~[submission] submissions.links))
[| submissions.links]
:- &
(submissions:merge submissions.links ~[submission])
(submissions:merge:store submissions.links ~[submission])
=. by-group (~(put by by-group) path links)
:: add submission to global sites
::
=/ =site (site-from-url url.submission)
=/ =site (site-from-url:store url.submission)
=. by-site (~(add ja by-site) site [path submission])
:: send updates to subscribers
::
@ -354,7 +355,7 @@
?: ?=(^ (find ~[comment] comments.discussion))
[| comments.discussion]
:- &
(comments:merge comments.discussion ~[comment])
(comments:merge:store comments.discussion ~[comment])
=. urls (~(put by urls) url discussion)
=. discussions (~(put by discussions) path urls)
:: send updates to subscribers
@ -365,8 +366,8 @@
:+ %give %fact
:+ :~ /discussions
[%discussions '' path]
[%discussions (build-discussion-path url)]
[%discussions (build-discussion-path path url)]
[%discussions (build-discussion-path:store url)]
[%discussions (build-discussion-path:store path url)]
==
%link-update
!>([%discussions path url [comment]~])
@ -420,7 +421,7 @@
|= =path
^- ?
=/ [=^path =url]
(break-discussion-path path)
(break-discussion-path:store path)
%. url
%~ has in
seen:(~(gut by by-group) path *links)
@ -430,7 +431,7 @@
|= =path
^- (per-path-url notes)
=/ args=[=^path =url]
(break-discussion-path path)
(break-discussion-path:store path)
|^ ?~ path
:: all paths
::
@ -460,7 +461,7 @@
|= =path
^- (per-path-url comments)
=/ args=[=^path =url]
(break-discussion-path path)
(break-discussion-path:store path)
|^ ?~ path
:: all paths
::

58
pkg/arvo/app/link-view.hoon
View File

@ -10,12 +10,12 @@
:: /json/[n]/submission/[wood-url]/[collection] nth matching submission
:: /json/seen mark-as-read updates
::
/- *link-view,
*invite-store, group-store,
link-listen-hook,
group-hook, permission-hook, permission-group-hook,
metadata-hook, contact-view
/+ *link, metadata, *server, default-agent, verb, dbug
/- *link, view=link-view
/- *invite-store, group-store
/- listen-hook=link-listen-hook
/- group-hook, permission-hook, permission-group-hook
/- metadata-hook, contact-view
/+ store=link-store, metadata, *server, default-agent, verb, dbug
~% %link-view-top ..is ~
::
|%
@ -89,10 +89,10 @@
:_ this
?+ mark (on-poke:def mark vase)
%link-action
[(handle-action:do !<(action vase)) ~]
[(handle-action:do !<(action:store vase)) ~]
::
%link-view-action
(handle-view-action:do !<(view-action vase))
(handle-view-action:do !<(action:view vase))
==
::
++ on-watch
@ -117,11 +117,11 @@
::
[%submission @ ^]
:_ this
(give-specific-submission:do p (break-discussion-path t.t.t.path))
(give-specific-submission:do p (break-discussion-path:store t.t.t.path))
::
[%discussions @ ^]
:_ this
(give-initial-discussions:do p (break-discussion-path t.t.t.path))
(give-initial-discussions:do p (break-discussion-path:store t.t.t.path))
==
::
++ on-agent
@ -145,7 +145,7 @@
::
%link-update
:_ this
:- (send-update:do !<(update vase))
:- (send-update:do !<(update:store vase))
?: =(/discussions wire) ~
~[give-tile-data:do]
==
@ -221,12 +221,12 @@
==
::
++ handle-action
|= =action
|= =action:store
^- card
[%pass /action %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ handle-view-action
|= act=view-action
|= act=action:view
^- (list card)
?- -.act
%create (handle-create +.act)
@ -235,7 +235,7 @@
==
::
++ handle-create
|= [=path title=@t description=@t members=create-members real-group=?]
|= [=path title=@t description=@t members=create-members:view real-group=?]
^- (list card)
=/ group-path=^path
?- -.members
@ -273,7 +273,7 @@
::
%^ do-poke %link-listen-hook
%link-listen-action
!> ^- action:link-listen-hook
!> ^- action:listen-hook
[%watch path]
==
?: ?=(%group -.members) ~
@ -453,6 +453,7 @@
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'initial-submissions'
%- pairs:enjs:format
%+ turn
@ -486,7 +487,7 @@
submissions
|= =submission
^- json
=/ =json (submission:en-json submission)
=/ =json (submission:enjs:store submission)
?> ?=([%o *] json)
:: add in seen status
::
@ -494,7 +495,7 @@
%+ ~(put by p.json) 'seen'
:- %b
%+ scry-for ?
[%seen (build-discussion-path path url.submission)]
[%seen (build-discussion-path:store path url.submission)]
:: add in comment count
::
=; comment-count=@ud
@ -507,18 +508,19 @@
=- (~(got by (~(got by -) path)) url.submission)
%+ scry-for (per-path-url comments)
:- %discussions
(build-discussion-path path url.submission)
(build-discussion-path:store path url.submission)
::
++ give-specific-submission
|= [n=@ud =path =url]
:_ [%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'submission'
^- json
=; sub=(unit submission)
?~ sub ~
(submission:en-json u.sub)
(submission:enjs:store u.sub)
=/ =submissions
=- (~(got by -) path)
%+ scry-for (map ^path submissions)
@ -538,35 +540,39 @@
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'initial-discussions'
%^ page-to-json p
%+ get-paginated `p
=- (~(got by (~(got by -) path)) url)
%+ scry-for (per-path-url comments)
[%discussions (build-discussion-path path url)]
comment:en-json
[%discussions (build-discussion-path:store path url)]
comment:enjs:store
::
++ send-update
|= =update
|= =update:store
^- card
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%submissions
%+ give-json
(update:en-json update)
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
:~ /json/0/submissions
(weld /json/0/submissions path.update)
==
::
%discussions
%+ give-json
(update:en-json update)
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
:_ ~
%+ weld /json/0/discussions
(build-discussion-path [path url]:update)
(build-discussion-path:store [path url]:update)
::
%observation
%+ give-json
(update:en-json update)
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
~[/json/seen]
==
::

11
pkg/arvo/app/metadata-hook.hoon
View File

@ -47,7 +47,7 @@
::
%metadata-action
[(poke-action:hc !<(metadata-action vase)) this]
==
==
::
++ on-watch
|= =path
@ -162,7 +162,12 @@
++ metadata-scry
|= pax=^path
^- associations
=. pax ;:(weld /=metadata-store/(scot %da now.bowl)/group pax /noun)
=. pax
;: weld
/(scot %p our.bowl)/metadata-store/(scot %da now.bowl)/group
pax
/noun
==
.^(associations %gx pax)
--
::
@ -240,7 +245,7 @@
^- ?
=. pax
;: weld
/=permission-store/(scot %da now.bowl)/permitted
/(scot %p our.bowl)/permission-store/(scot %da now.bowl)/permitted
[(scot %p ship) pax]
/noun
==

22
pkg/arvo/app/metadata-store.hoon
View File

@ -61,9 +61,27 @@
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?: ?=(%metadata-action mark)
?+ mark (on-poke:def mark vase)
%metadata-action
(poke-metadata-action:mc !<(metadata-action vase))
(on-poke:def mark vase)
%noun
=/ val=(each [%cleanup path] tang)
(mule |.(!<([%cleanup path] vase)))
?. ?=(%& -.val)
(on-poke:def mark vase)
=/ group=path +.p.val
=/ res=(set resource) (~(get ju group-indices) group)
=. group-indices (~(del by group-indices) group)
:- ~
%+ roll ~(tap in res)
|= [r=resource out=_state]
=. resource-indices.out (~(del by resource-indices.out) r)
=. app-indices.out
%- ~(del ju app-indices.out)
[app-name.r group app-path.r]
=. associations.out (~(del by associations.out) group r)
out
==
[cards this]
::
++ on-watch

3
pkg/arvo/app/permission-group-hook.hoon
View File

@ -202,7 +202,8 @@
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bowl) pax /noun))
=/ bek=path /(scot %p our.bowl)/group-store/(scot %da now.bowl)
.^((unit group) %gx :(weld bek pax /noun))
::
++ add-members
|= [pax=path mem=(set ship) perms=(set path)]

7
pkg/arvo/app/permission-hook.hoon
View File

@ -296,7 +296,12 @@
++ permission-scry
|= pax=path
^- permission
=. pax ;:(weld /=permission-store/(scot %da now.bowl)/permission pax /noun)
=. pax
;: weld
/(scot %p our.bowl)/permission-store/(scot %da now.bowl)/permission
pax
/noun
==
(need .^((unit permission) %gx pax))
::
++ permitted

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

@ -71,7 +71,7 @@
++ stop-ping-ship
|= [our=@p now=@da =ship =old=rift =ship-state]
^- (quip card _state)
=+ .^(=new=rift %j /=rift/(scot %da now)/(scot %p ship))
=+ .^(=new=rift %j /(scot %p our)/rift/(scot %da now)/(scot %p ship))
:: if nothing's changed about us, don't cancel
::
?: ?& =(old-rift new-rift)
@ -96,7 +96,7 @@
(send-ping our now ship)
::
;< new-state=_state (rind card state)
=+ .^(=rift %j /=rift/(scot %da now)/(scot %p ship))
=+ .^(=rift %j /(scot %p our)/rift/(scot %da now)/(scot %p ship))
:_ state(ships (~(put by ships.state) ship rift %idle ~))
[%pass /jael/(scot %p ship) %arvo %j %public-keys (silt ship ~)]~
=. state new-state

129
pkg/arvo/app/publish.hoon
View File

@ -1,13 +1,13 @@
/- *publish,
*group-store,
*group-hook,
*permission-hook,
*permission-group-hook,
*permission-store,
*invite-store,
*metadata-store,
*metadata-hook,
*rw-security
/- *publish
/- *group-store
/- *group-hook
/- *permission-hook
/- *permission-group-hook
/- *permission-store
/- *invite-store
/- *metadata-store
/- *metadata-hook
/- *rw-security
/+ *server, *publish, cram, default-agent, dbug
::
~% %publish ..is ~
@ -127,7 +127,6 @@
::
cards
;: weld
(kill-builds pubs.zero)
kick-cards
init-cards
(move-files old-subs)
@ -225,21 +224,6 @@
[~ subs]
[[%give %kick paths ~]~ subs]
::
++ kill-builds
|= pubs=(map @tas collection-zero)
^- (list card)
%- zing
%+ turn ~(tap by pubs)
|= [col-name=@tas col-data=collection-zero]
^- (list card)
:- [%pass /collection/[col-name] %arvo %f %kill ~]
%- zing
%+ turn ~(tap by pos.col-data)
|= [pos-name=@tas *]
:~ [%pass /post/[col-name]/[pos-name] %arvo %f %kill ~]
[%pass /comments/[col-name]/[pos-name] %arvo %f %kill ~]
==
::
++ send-invites
|= [book=@tas subscribers=(set @p)]
^- (list card)
@ -431,8 +415,13 @@
[%subscribe @ @ ~]
=/ who=@p (slav %p i.t.wir)
=/ book=@tas i.t.t.wir
=/ wen=(unit @da) (get-last-update:main who book)
=/ pax=path
?~ wen
/notebook/[book]
/notebook/[book]/(scot %da u.wen)
:_ this
[%pass wir %agent [who %publish] %watch /notebook/[book]]~
[%pass wir %agent [who %publish] %watch pax]~
::
[%permissions ~]
:_ this
@ -518,6 +507,59 @@
::
|_ bol=bowl:gall
::
++ get-last-update
|= [host=@p book-name=@tas]
^- (unit @da)
=/ book (~(get by books) host book-name)
?~ book ~
=/ wen date-created.u.book
%- some
%- ~(rep by notes.u.book)
|= [[@tas =note] out=_wen]
^- @da
%+ max out
%+ max last-edit.note
%- ~(rep by comments.note)
|= [[@da =comment] out=_out]
(max date-created.comment out)
::
++ get-notebook-from-date
|= [host=@p book-name=@tas wen=@da]
^- notebook
=/ book (~(got by books) host book-name)
%= book
notes
%- ~(rep by notes.book)
|= [[nom=@tas not=note] out=(map @tas note)]
^- (map @tas note)
?: (gth last-edit.not wen)
(~(put by out) nom not)
=. comments.not
%- ~(rep by comments.not)
|= [[nam=@da com=comment] out=(map @da comment)]
?: (gth date-created.com wen)
(~(put by out) nam com)
out
?~ comments.not
out
(~(put by out) nom not)
==
::
++ merge-notebooks
|= [base=notebook diff=notebook]
^- notebook
%= diff
notes
%- ~(rep by notes.diff)
|= [[nom=@tas not=note] out=_notes.base]
=/ base-note=(unit note) (~(get by out) nom)
?~ base-note
(~(put by out) nom not)
=. comments.u.base-note
(~(uni by comments.u.base-note) comments.not)
(~(put by out) nom u.base-note)
==
::
++ read-paths
|= ran=rant:clay
^- (quip card _state)
@ -857,6 +899,19 @@
%.n
==
::
++ get-subscriber-paths
|= [book-name=@tas who=@p]
^- (list path)
%+ roll ~(val by sup.bol)
|= [[whom=@p pax=path] out=(list path)]
?. =(who whom)
out
?. ?=([%notebook @ *] pax)
out
?. =(i.t.pax book-name)
out
[pax out]
::
++ handle-permission-update
|= upd=permission-update
^- (quip card _state)
@ -877,7 +932,7 @@
%+ turn ~(tap in who.upd)
|= who=@p
?. (allowed who %read u.book)
[%give %kick [/notebook/[u.book]]~ `who]~
[%give %kick (get-subscriber-paths u.book who) `who]~
?: ?|(?=(%remove -.upd) (is-managed path.upd))
~
=/ uid (sham %publish who u.book eny.bol)
@ -913,11 +968,15 @@
::
++ watch-notebook
|= pax=path
?> ?=([%notebook @ ~] pax)
?> ?=([%notebook @ *] pax)
=/ book-name i.t.pax
?. (allowed src.bol %read book-name)
~|("not permitted" !!)
=/ book (~(got by books) our.bol book-name)
=/ book
?: ?=([%notebook @ @ ~] pax)
=/ wen=@da (slav %da i.t.t.pax)
(get-notebook-from-date our.bol book-name wen)
(~(got by books) our.bol book-name)
=/ delta=notebook-delta
[%add-book our.bol book-name book]
:_ state
@ -1070,7 +1129,11 @@
^- [(list card) write=path read=path]
?> ?=(^ group-path.group)
=/ scry-path
;:(weld /=group-store/(scot %da now.bol) group-path.group /noun)
;: weld
/(scot %p our.bol)/group-store/(scot %da now.bol)
group-path.group
/noun
==
=/ grp .^((unit ^group) %gx scry-path)
?: use-preexisting.group
?~ grp !!
@ -1766,7 +1829,7 @@
%+ turn ~(tap in dif-peeps)
|= who=@p
^- card
[%give %kick [/notebook/[book.act]]~ `who]
[%give %kick (get-subscriber-paths book.act who) `who]
==
::
++ get-subscribers
@ -1910,6 +1973,8 @@
date-created.data.del
==
==
=? data.del (~(has by books) host.del book.del)
(merge-notebooks (~(got by books) host.del book.del) data.del)
=^ cards state
(emit-updates-and-state host.del book.del data.del del sty)
:_ state

4
pkg/arvo/app/shoe.hoon
View File

@ -40,8 +40,8 @@
::
++ command-parser
|= sole-id=@ta
^+ |~(nail *(like command))
(cold ~ (jest 'demo'))
^+ |~(nail *(like [? command]))
(cold [& ~] (jest 'demo'))
::
++ tab-list
|= sole-id=@ta

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

@ -12,15 +12,34 @@
$~ [*thread-form ~]
[=thread-form kid=(map tid trie)]
::
+$ trying ?(%find %build %none)
+$ trying ?(%build %none)
+$ state
$: starting=(map yarn [=trying =vase])
running=trie
tid=(map tid yarn)
==
::
+$ clean-slate-any
$^ clean-slate-ket
$% clean-slate-sig
clean-slate
==
::
+$ clean-slate
$: starting=(map yarn [=trying =vase])
$: %1
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ clean-slate-ket
$: starting=(map yarn [trying=?(%build %find %none) =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ clean-slate-sig
$: starting=~
running=(list yarn)
tid=(map tid yarn)
==
@ -87,9 +106,10 @@
==
::
++ tap-yarn
=| =yarn
|= =trie
^- (list [=^yarn =thread-form])
%- flop :: preorder
=| =yarn
|- ^- (list [=^yarn =thread-form])
%+ welp
?~ yarn
~
@ -116,12 +136,17 @@
++ on-init on-init:def
++ on-save clean-state:sc
++ on-load
|^
|= old-state=vase
=+ !<(=clean-slate old-state)
=. tid.state tid.clean-slate
=+ !<(any=clean-slate-any old-state)
=? any ?=(^ -.any) (old-to-1 any)
=? any ?=(~ -.any) (old-to-1 any)
?> ?=(%1 -.any)
::
=. tid.state tid.any
=/ yarns=(list yarn)
%+ welp running.clean-slate
~(tap in ~(key by starting.clean-slate))
%+ welp running.any
~(tap in ~(key by starting.any))
|- ^- (quip card _this)
?~ yarns
`this
@ -130,10 +155,18 @@
=^ cards-2 this
$(yarns t.yarns)
[(weld cards-1 cards-2) this]
::
++ old-to-1
|= old=clean-slate-ket
^- clean-slate
1+old(starting (~(run by starting.old) |=([* v=vase] none+v)))
--
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?: ?=(%spider-kill mark)
(on-load on-save)
=^ cards state
?+ mark (on-poke:def mark vase)
%spider-input (on-poke-input:sc !<(input vase))
@ -182,7 +215,6 @@
=^ cards state
?+ wire (on-arvo:def wire sign-arvo)
[%thread @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
[%find @ ~] (handle-find:sc i.t.wire sign-arvo)
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
==
[cards this]
@ -243,33 +275,15 @@
~| [%already-starting yarn]
!!
::
=: starting.state (~(put by starting.state) yarn [%find vase])
=: starting.state (~(put by starting.state) yarn [%build vase])
tid.state (~(put by tid.state) new-tid yarn)
==
=/ pax=path
~| no-file-for-thread+file
(need (get-fit:clay [our q.byk da+now]:bowl %ted file))
=/ =card
=/ =schematic:ford [%path [our.bowl %home] %ted file]
[%pass /find/[new-tid] %arvo %f %build live=%.n schematic]
[[card ~] state]
::
++ handle-find
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
(thread-fail-not-running tid %find-thread-incomplete tang.result.sign-arvo)
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
(thread-fail-not-running tid %find-thread-error message.build-result)
?. ?=([%path *] +.build-result)
(thread-fail-not-running tid %find-thread-strange ~)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%build vase]))
=/ =card
=/ =schematic:ford [%core rail.build-result]
[%pass /build/[tid] %arvo %f %build live=%.n schematic]
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
[[card ~] state]
::
++ handle-build
@ -278,16 +292,14 @@
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
(thread-fail-not-running tid %build-thread-incomplete tang.result.sign-arvo)
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
(thread-fail-not-running tid %build-thread-error message.build-result)
=/ =cage (result-to-cage:ford build-result)
?. ?=(%noun p.cage)
(thread-fail-not-running tid %build-thread-strange >p.cage< ~)
=/ maybe-thread (mule |.(!<(thread q.cage)))
~| sign+[- +<]:sign-arvo
?> ?=([?(%b %c) %writ *] sign-arvo)
=/ =riot:clay p.sign-arvo
?~ riot
(thread-fail-not-running tid %build-thread-error *tang)
?. ?=(%vase p.r.u.riot)
(thread-fail-not-running tid %build-thread-strange >[p q]:u.riot< ~)
=/ maybe-thread (mule |.(!<(thread !<(vase q.r.u.riot))))
?: ?=(%| -.maybe-thread)
(thread-fail-not-running tid %thread-not-thread ~)
(start-thread yarn p.maybe-thread)
@ -368,15 +380,13 @@
::
++ thread-fail-not-running
|= [=tid =term =tang]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
:_ state(starting (~(del by starting.state) yarn))
%- welp :_ (thread-say-fail tid term tang)
=/ =trying trying:(~(got by starting.state) yarn)
?- trying
%find [%pass /find/[tid] %arvo %f %kill ~]~
%build [%pass /build/[tid] %arvo %f %kill ~]~
%none ~
==
=/ moz (thread-say-fail tid term tang)
?. ?=([~ %build *] (~(get by starting.state) yarn))
moz
:_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %home ~])
::
++ thread-say-fail
|= [=tid =term =tang]
@ -388,7 +398,7 @@
++ thread-fail
|= [=yarn =term =tang]
^- (quip card ^state)
%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
:: %- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)
@ -464,5 +474,5 @@
::
++ clean-state
!> ^- clean-slate
state(running (turn (tap-yarn running.state) head))
1+state(running (turn (tap-yarn running.state) head))
--

257
pkg/arvo/app/test.hoon
View File

@ -1,40 +1,20 @@
/+ default-agent
::
!:
|%
+$ card card:agent:gall
+$ test
$% [%arvo ~] ::UNIMPLEMENTED
[%marks ~] ::UNIMPLEMENTED
[%cores p=path]
[%hoons p=path]
[%names p=path]
[%renders p=path]
+$ test ?(%agents %marks %generators)
+$ state
$: app=(set path)
app-ok=?
mar=(set path)
mar-ok=?
gen=(set path)
gen-ok=?
==
--
::
|%
++ join
|= {a/cord b/(list cord)}
?~ b ''
(rap 3 |-([i.b ?~(t.b ~ [a $(b t.b)])]))
::
++ fake-fcgi [%many [%blob *cred:eyre] $+[%n ~] ~]
++ build-core
|= [=disc:ford a=spur b=(list spur)]
^- card
~& >> (flop a)
:* %pass a-core+a
%arvo %f %build
live=|
^- schematic:ford
:- [%core disc %hoon a]
[%$ %cont !>(b)]
==
--
::
=, ford
=, format
^- agent:gall
=| =state
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
@ -44,121 +24,136 @@
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
:_ this
^- [(list card) _this]
|^
=+ !<(a=test vase)
?- -.a
%arvo ~|(%stub !!) ::basically double solid?
%hoons ~&((list-hoons p.a ~) ~)
%names ~&((list-names p.a) ~)
%marks ~|(%stub !!) ::TODO restore historical handler
%renders ~&(%all-renderers-are-disabled ~)
%cores
=/ spurs [- +]:(list-hoons p.a skip=(sy /sys /ren /tests ~))
[(build-core [p q]:byk.bowl spurs) ~]
=+ !<(=test vase)
?- test
%marks test-marks
%agents test-agents
%generators test-generators
==
::
++ now-beak %_(byk.bowl r [%da now.bowl])
++ list-hoons
|= [under=path skipping=(set spur)] ^- (list spur)
=/ sup (flop under)
~& [%findining-hoons under=under]
|- ^- (list spur)
%- zing
%+ turn
=- (sort ~(tap by -) aor)
dir:.^(arch %cy (en-beam now-beak sup))
|= [a=knot ~] ^- (list spur)
=. sup [a sup]
?: (~(has in skipping) (flop sup))
~&(> [(flop sup) %out-of-scope] ~)
=/ ded (~(get by skip-completely) (flop sup))
?^ ded
~&(> [(flop sup) %skipped `tape`u.ded] ~)
?~ [fil:.^(arch %cy (en-beam now-beak [%hoon sup]))]
^$
~& (flop sup)
[sup ^$]
::
++ list-names
|= a/path ^- (list term)
=/ hon (list-hoons a ~)
%+ turn hon
|= b=spur
(join '-' (slag 1 (flop b)))
::
++ skip-completely
^~ ^- (map path tape)
%- my :~ ::TODO don't hardcode
:- /ren/run "not meant to be called except on a (different) hoon file"
:- /ren/test-gen "temporarily disabled"
++ test-marks
=| fex=(list card)
^+ [fex this]
?> =(~ mar.state)
=. mar-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /mar))
|- ^+ [fex this]
?~ paz [fex this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
=/ mak=^mark
%- crip
%+ turn (tail (spud (tail (flop (tail xap)))))
|=(c=@tD `@tD`?:(=('/' c) '-' c))
=/ sing=card
:+ %pass /build/mar/[mak]
[%arvo %c %warp our.bowl %home ~ %sing %b da+now.bowl /[mak]]
%_ $
paz t.paz
fex [sing fex]
mar.state (~(put in mar.state) /mar/[mak])
==
::
++ test-agents
=| fex=(list card)
^+ [fex this]
?> =(~ app.state)
=. app-ok.state %.y
=+ .^(app-arch=arch cy+(en-beam now-beak /app))
=/ daz ~(tap in ~(key by dir.app-arch))
|- ^+ [fex this]
?~ daz [fex this]
=/ dap-pax=path /app/[i.daz]/hoon
=/ dap-arch .^(arch cy+(en-beam now-beak (flop dap-pax)))
?~ fil.dap-arch
$(daz t.daz)
=/ sing=card
:+ %pass /build/app/[i.daz]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl dap-pax]
%_ $
daz t.daz
fex [sing fex]
app.state (~(put in app.state) /app/[i.daz])
==
::
++ test-generators
=| fex=(list card)
^+ [fex this]
?> =(~ gen.state)
=. gen-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /gen))
|- ^+ [fex this]
?~ paz [fex this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
=/ sing=card
:+ %pass build+i.paz
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl i.paz]
%_ $
paz t.paz
fex [sing fex]
gen.state (~(put in gen.state) i.paz)
==
::
++ now-beak %_(byk.bowl r [%da now.bowl])
--
::
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
|^
:_ this
^- (list card)
?. ?=([%a-core *] wire)
^- [(list card) _this]
?. ?=([%build *] wire)
(on-arvo:def wire sign-arvo)
?. ?=(%made +<.sign-arvo)
?. ?=(%writ +<.sign-arvo)
(on-arvo:def wire sign-arvo)
=/ =spur t.wire
=/ res result.sign-arvo
?: ?=([%incomplete *] res)
~& incomplete-core+spur
((slog tang.res) ~)
?. ?=([%complete %success *] res)
~& unsuccessful-core+spur
((slog message.build-result.res) ~)
?> ?=(^ +<.build-result.res)
%- (slog (report-error spur head.build-result.res))
=/ nex=(list ^spur)
=< p
;; [%success %$ %cont * p=(list ^spur)]
tail.build-result.res
?~ nex ~&(%cores-tested ~)
[(build-core [p q]:byk.bowl nex) ~]
=/ =path t.wire
?+ path ~|(path+path !!)
[%app *]
=/ ok
?~ p.sign-arvo |
(~(nest ut -:!>(*agent:gall)) | -:!<(vase q.r.u.p.sign-arvo))
~& ?: ok
agent-built+path
agent-failed+path
=? app-ok.state !ok %.n
=. app.state (~(del in app.state) path)
~? =(~ app.state)
?: app-ok.state
%all-agents-built
%some-agents-failed
[~ this]
::
++ report-error
|= [=spur bud=build-result]
^- tang
=/ should-fail (~(get by failing) (flop spur))
?- -.bud
%success
?~ should-fail ~
:~ leaf+"warn: expected failure, {<`tape`u.should-fail>}"
leaf+"warn: built succesfully"
?: ?=(%bake +<.bud)
(sell q.cage.bud)
?> ?=(%core +<.bud)
(sell vase.bud)
==
::
%error
?^ should-fail
~[>[%failed-known `tape`(weld "TODO: " u.should-fail)]<]
(flop message.bud)
==
[%mar *]
=/ ok ?=(^ p.sign-arvo)
~& ?: ok
mark-built+path
mark-failed+path
=? mar-ok.state !ok %.n
=. mar.state (~(del in mar.state) path)
~? =(~ mar.state)
?: mar-ok.state
%all-marks-built
%some-marks-failed
[~ this]
::
++ failing
^~ ^- (map path tape)
%- my :~ ::TODO don't hardcode
::
:- /gen/al "compiler types out-of-date"
:- /gen/musk "compiler types out-of-date"
::
:- /gen/cosmetic "incomplete"
:- /gen/lust "incomplete"
:- /gen/scantastic "incomplete"
==
--
::
[%gen *]
=/ ok ?=(^ p.sign-arvo)
~& ?: ok
generator-built+path
generator-failed+path
=? gen-ok.state !ok %.n
=. gen.state (~(del in gen.state) path)
~? =(~ gen.state)
?: gen-ok.state
%all-generators-built
%some-generators-failed
[~ this]
==
++ on-fail on-fail:def
--

8
pkg/arvo/gen/acme/domain-validation.hoon
View File

@ -20,7 +20,13 @@
[[%404 ~] ~]
=/ challenge=@t i.t.t.q.p.u.url
=/ response
.^((unit @t) %gx /=acme/(scot %da now)/domain-validation/[challenge]/noun)
.^ (unit @t)
%gx
(scot %p p.bek)
%acme
(scot %da now)
/domain-validation/[challenge]/noun
==
?~ response
[[%404 ~] ~]
:- [200 ['content-type' 'text/html']~]

9
pkg/arvo/gen/azimuth-block.hoon
View File

@ -4,6 +4,11 @@
:: processed only those blocks which are this number minus 30.
::
:- %say
|= [[now=@da *] *]
|= [[now=@da @ our=@p ^] *]
:- %tang
[>.^(@ud %gx /=eth-watcher/(scot %da now)/block/azimuth-tracker/noun)< ~]
=; block=@ud
[leaf+(scow %ud block)]~
.^ @ud
%gx
/(scot %p our)/eth-watcher/(scot %da now)/block/azimuth-tracker/noun
==

4
pkg/arvo/gen/azimuth-sources.hoon
View File

@ -1,5 +1,5 @@
:: List azimuth sources
:- %say
|= [[now=@da *] *]
|= [[now=@da @ our=@p ^] *]
:- %noun
.^(state-eth-node:jael j//=sources/(scot %da now))
.^(state-eth-node:jael j//(scot %p our)/sources/(scot %da now))

1
pkg/arvo/gen/hello.hoon
View File

@ -2,6 +2,7 @@
::
:::: /hoon/hello/gen
::
:: TODO: reinstate
/? 310
::
::::

14
pkg/arvo/gen/hood/autoload.hoon
View File

@ -1,14 +0,0 @@
:: Helm: Disable/enable/toggle auto-reload of kernel components
::
:::: /hoon/autoload/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{arg/?(~ {? ~}) ~}
==
:- %kiln-autoload
`(unit ?)`?~(arg ~ `-.arg)

13
pkg/arvo/gen/hood/keep-ford.hoon
View File

@ -1,13 +0,0 @@
:: Kiln: resize Ford cache
::
::::
::
/? 310
::
::::
!:
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[compiler-cache-size=@ud build-cache-size=@ud ~] ~]
==
[%kiln-keep-ford compiler-cache-size build-cache-size]

15
pkg/arvo/gen/hood/load.hoon
View File

@ -1,15 +0,0 @@
:: Hood, generic: load named hood component's state from backup
::
:::: /hoon/load/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ byk/beak}
{{dap/term pas/@uw ~} ~}
==
:- %hood-load
~| %hood-load-stub
!!

14
pkg/arvo/gen/hood/ota.hoon Normal file
View File

@ -0,0 +1,14 @@
:: Kiln: Continuously merge local desk from (optionally-)foreign one
::
:::: /hoon/ota/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [her=@p sud=@tas ~]) ~]
==
:- %kiln-ota
?~(arg ~ `[her sud]:arg)

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

@ -1,13 +0,0 @@
:: Kiln: regularly clear %ford cache XX find relevant leak
::
:::: /hoon/overload/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{recur/@dr start/@da ~} ~}
==
[%kiln-overload recur start]

2
pkg/arvo/gen/hood/reboot.hoon
View File

@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ bec/beak}
{arg/~ ~}
==
[%helm-reload ~[%z %a %b %c %d %e %f %g %i %j]]
[%helm-reload ~[%z %a %b %c %d %e %g %i %j]]

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

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

79
pkg/arvo/gen/hood/static.hoon
View File

@ -1,79 +0,0 @@
:: Serve static files
/? 309
::
/= pre-process
/^ (map path [@tas @t])
/: /===/web/static-site /*
/| /; |=(@t [%html +<]) /&html&/!hymn/
/; |=(@t [%html +<]) /&html&/&elem&/udon/
:: XX /lib/down-jet/parse is broken
:: /; |=(@t [%html +<]) /&html&/&hymn&/&down&/md/
/; |=(@t [%raw +<]) /atom/
==
::
~& %finished-preprocessing
:- %say
|= $: [now=@da eny=@uv bec=beak]
~
~
==
=>
|%
++ convert-link
|= [pre=tape link=tape]
=/ parsed=(unit (list coin))
%+ rust link
;~ pose
;~(pfix net (more net nuck:so))
(more net nuck:so)
==
?~ parsed
link
^- tape
%+ welp
=< +
%^ spin u.parsed pre
|= [c=coin s=path]
^- [* out=tape]
?> ?=([%$ dime] c)
[0 (weld "{s}/" (scow +.c))]
::
".html"
::
++ convert-file
|= [pre=tape fil=tape]
^- tape
=/ idc=(list @ud) (fand "<a href=" fil)
=< +>
%^ spin idc [0 fil]
|= [i=@ud f=@ud h=tape]
^- [p=* f=@ud out=tape]
=/ a (scag :(add 9 i f) h)
=/ b (slag :(add 9 i f) h)
=/ c (need (find "\">" b))
=/ old-link=tape (scag c b)
=/ new-link=tape (convert-link pre old-link)
=/ new-file=tape :(welp a new-link (slag c b))
=/ new-f (sub (lent new-link) (lent old-link))
[0 (add f new-f) new-file]
--
::
:- %dill-blit
=/ trio /(scot %p p.bec)/[q.bec]/(scot r.bec)
=/ dirs .^((list path) %ct (weld trio /web/static-site))
::
:- %mor
%+ roll dirs
|= [pax=path out=(list [%sav path @t])]
=/ path-prefix=path (scag (dec (lent pax)) pax)
=/ pre=[@tas @t] (~(got by pre-process) path-prefix)
:_ out
:- %sav
?: =(%raw -.pre)
[pax +.pre]
:: find and update links
=/ root=tape
?~ path-prefix ""
(slag 1 (spud (scag 1 (flop path-prefix))))
=/ fil=tape (convert-file root (trip +.pre))
[(weld path-prefix /[-.pre]) (crip fil)]

14
pkg/arvo/gen/hood/wipe-ford.hoon
View File

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

9
pkg/arvo/gen/keys.hoon
View File

@ -1,8 +1,11 @@
:: Print keys for a ship
::
:- %say
|= [[now=time *] [=ship ~] ~]
|= [[now=time @ our=ship ^] [her=ship ~] ~]
=/ our (scot %p our)
=/ now (scot %da now)
=/ her (scot %p her)
:* %noun
life=.^((unit @ud) %j /=lyfe/(scot %da now)/(scot %p ship))
rift=.^((unit @ud) %j /=ryft/(scot %da now)/(scot %p ship))
life=.^((unit @ud) %j /[our]/lyfe/[now]/[her])
rift=.^((unit @ud) %j /[our]/ryft/[now]/[her])
==

2
pkg/arvo/gen/link-store/note.hoon
View File

@ -1,6 +1,6 @@
:: link-store|note: write a note on a link in a path
::
/- *link
/- *link-store, *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path =url note=@t ~] ~]

2
pkg/arvo/gen/link-store/save.hoon
View File

@ -1,6 +1,6 @@
:: link-store|save: save a link to a path
::
/- *link
/- *link-store, *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path title=@t =url ~] ~]

4
pkg/arvo/gen/metal.hoon
View File

@ -207,10 +207,6 @@
::
(vent %e /vane/eyre)
::
:: sys/vane/ford: build
::
(vent %f /vane/ford)
::
:: sys/vane/gall: applications
::
(vent %g /vane/gall)

7
pkg/arvo/gen/spider/tree.hoon
View File

@ -1,10 +1,13 @@
:: List running threads
/- spider
:- %say
|= [[now=@da *] ~ *]
|= [[now=@da @ our=@p ^] ~ *]
:- %tang
=/ tree
.^((list (list tid:spider)) %gx /=spider/(scot %da now)/tree/noun)
.^ (list (list tid:spider))
%gx
/(scot %p our)/spider/(scot %da now)/tree/noun
==
%+ turn tree
|= yarn=(list tid:spider)
>`path`yarn<

83
pkg/arvo/gen/test.hoon
View File

@ -1,83 +0,0 @@
:: Run tests
/+ test-runner
/= all-tests
/^ (map path (list test-arm:test-runner))
/: /===/tests
/* /test-gen/
::
|%
++ main
|= [defer=? tests=(list test:test-runner)]
^- tang
::
%- zing
%+ turn tests
|= [=path test-func=test-func:test-runner]
^- tang
::
=/ test-results=tang (run-test path test-func)
:: if :defer is set, produce errors; otherwise print them and produce ~
::
?: defer
test-results
((slog (flop test-results)) ~)
::
++ run-test
:: executes an individual test.
|= [pax=path test=test-func:test-runner]
^- tang
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| :: the stack is already flopped for output?
;: weld
p.run
`tang`[[%leaf (weld "CRASHED " name)] ~]
==
%& ?: =(~ p.run)
[[%leaf (weld "OK " name)] ~]
:: Create a welded list of all failures indented.
%- flop
;: weld
`tang`[[%leaf (weld "FAILED " name)] ~]
::TODO indent
:: %+ turn p:run
:: |= {i/tape}
:: ^- tank
:: [%leaf (weld " " i)]
p.run
==
==
:: +filter-tests-by-prefix
::
++ filter-tests-by-prefix
|= [prefix=path tests=(list test:test-runner)]
^+ tests
::
=/ prefix-length=@ud (lent prefix)
::
%+ skim tests
::
|= [=path *]
=(prefix (scag prefix-length path))
--
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[filter=$?(~ [pax=path ~])]
[defer=_& seed=?(~ @uvJ)]
==
:: start printing early if we're not deferring output
::
~? !defer %tests-compiled
:- %tang
:: use empty path prefix if unspecified
::
=/ prefix=path ?~(filter ~ pax.filter)
::
=/ filtered-tests=(list test:test-runner)
%+ filter-tests-by-prefix
prefix
(resolve-test-paths:test-runner all-tests)
::
(main defer filtered-tests)

4
pkg/arvo/gen/timers.hoon
View File

@ -1,5 +1,5 @@
:: Find list of currently running Behn timers
:- %say
|= *
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
:- %tang
[>.^((list [date=@da =duct]) %b /=timers=)< ~]
[>.^((list [date=@da =duct]) %b (en-beam:format [p.bec %timers r.bec] /))< ~]

8
pkg/arvo/gen/trouble.hoon
View File

@ -7,8 +7,9 @@
:- %noun
=<
:~
[%base-hash .^(@uv %cz (pathify ~.base ~))]
[%base-hash base-hash]
[%home-hash .^(@uv %cz (pathify ~.home ~))]
[%kids-hash .^(@uv %cz (pathify ~.kids ~))]
::
(info %our our)
(info %sponsor sponsor)
@ -40,4 +41,9 @@
life=lyfe
rift=ryft
==
::
++ base-hash
=/ parent (scot %p (sein:title our now our))
=+ .^(=cass:clay %cs /[parent]/kids/1/late/foo)
.^(@uv %cz /[parent]/kids/(scot %ud ud.cass))
--

143
pkg/arvo/lib/hood/drum.hoon
View File

@ -1,33 +1,16 @@
:: :: ::
:::: /hoon/drum/hood/lib :: ::
:: :: ::
/? 310 :: version
/- *sole
/+ sole
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ part {$drum $2 pith-2} ::
++ part-old {$drum $1 pith-1} ::
:: ::
++ pith-1 :: pre-style
%+ cork pith-2 ::
|:($:pith-2 +<(bin ((map bone source-1)))) ::
:: ::
++ source-1 ::
%+ cork source ::
|:($:source +<(mir ((pair @ud (list @c))))) :: style-less mir
:: ::
/- *sole
/+ sole
|%
+$ any-state $%(state)
+$ state [%2 pith-2]
::
++ pith-2 ::
$: eel/(set gill:gall) :: connect to
ray/(set well:gall) ::
fur/(map dude:gall (unit server)) :: servers
bin/(map bone source) :: terminals
== ::
:: :: ::
:::: :: ::
:: :: ::
:: ::
++ server :: running server
$: syd/desk :: app identity
cas/case :: boot case
@ -72,7 +55,7 @@
:: :: ::
|%
++ deft-apes :: default servers
|= [our/ship lit/?]
|= [our=ship lit=?]
%- ~(gas in *(set well:gall))
^- (list well:gall)
:: boot all default apps off the home desk
@ -122,41 +105,34 @@
==
::
++ deft-fish :: default connects
|= our/ship
|= our=ship
%- ~(gas in *(set gill:gall))
^- (list gill:gall)
[[our %dojo] [our %chat-cli]~]
::
++ make :: initial part
|= our/ship
^- part
:* %drum
%2
eel=(deft-fish our)
ray=~
fur=~
bin=~
==
::
::
++ en-gill :: gill to wire
|= gyl/gill:gall
|= gyl=gill:gall
^- wire
[%drum %phat (scot %p p.gyl) q.gyl ~]
::
++ de-gill :: gill from wire
|= way/wire ^- gill:gall
?>(?=({@ @ ~} way) [(slav %p i.way) i.t.way])
|= way=wire ^- gill:gall
?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
--
:: TODO: remove .ost
::
::::
::
|= {hid/bowl:gall part} :: main drum work
|= [hid=bowl:gall state]
=* sat +<+
=/ ost 0
=+ (~(gut by bin) ost *source)
=* dev -
|_ {moz/(list card:agent:gall) biz/(list dill-blit:dill)}
+* this .
=| moz=(list card:agent:gall)
=| biz=(list dill-blit:dill)
|%
++ this .
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ on-init se-abet:this(eel (deft-fish our.hid))
++ diff-sole-effect-phat :: app event
|= {way/wire fec/sole-effect}
=< se-abet =< se-view
@ -172,14 +148,15 @@
(se-text "[{<src.hid>}, driving {<our.hid>}]")
::
++ poke-set-boot-apps ::
|= lit/?
^- (quip card:agent:gall part)
|= lit=?
^- (quip card:agent:gall ^state)
:: We do not run se-abet:se-view here because that starts the apps,
:: and some apps are not ready to start (eg Talk crashes because the
:: terminal has width 0). It appears the first message to drum must
:: be the peer.
::
[~ +<+.^$(ray (deft-apes our.hid lit))]
=. ray (deft-apes our.hid lit)
[~ sat]
::
++ poke-dill-belt :: terminal event
|= bet/dill-belt:dill
@ -193,7 +170,7 @@
++ poke-start :: start app
|= wel/well:gall
=< se-abet =< se-view
(se-born wel)
(se-born & wel)
::
++ poke-link :: connect app
|= gyl/gill:gall
@ -216,38 +193,40 @@
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-drum-bad-mark mark] !!)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
%drum-dill-belt =;(f (f !<(_+<.f vase)) poke-dill-belt)
%drum-dill-blit =;(f (f !<(_+<.f vase)) poke-dill-blit)
%drum-exit =;(f (f !<(_+<.f vase)) poke-exit)
%drum-start =;(f (f !<(_+<.f vase)) poke-start)
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-set-boot-apps =;(f (f !<(_+<.f vase)) poke-set-boot-apps)
%drum-start =;(f (f !<(_+<.f vase)) poke-start)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
==
::
++ on-load
|= ver=?(%1 %2 %3 %4 %5)
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7) old=any-state]
=< se-abet =< se-view
=? . (lte ver %4)
=. ver %5
=. ..on-load
=< (se-emit %pass /kiln %arvo %g %sear ~wisrut-nocsub)
=< (se-born %home %goad)
=< (se-born %home %metadata-store)
=< (se-born %home %metadata-hook)
=< (se-born %home %contact-store)
=< (se-born %home %contact-hook)
=< (se-born %home %contact-view)
=< (se-born %home %link-store)
=< (se-born %home %link-proxy-hook)
=< (se-born %home %link-listen-hook)
=< (se-born %home %link-view)
=< (se-born %home %s3-store)
(se-born %home %file-server)
.
?> ?=(%5 ver)
=> (se-born %home %file-server)
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=. sat old
=. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
=> (se-born | %home %s3-store)
=> (se-born | %home %link-view)
=> (se-born | %home %link-listen-hook)
=> (se-born | %home %link-store)
=> (se-born | %home %link-proxy-hook)
=> (se-born | %home %contact-view)
=> (se-born | %home %contact-hook)
=> (se-born | %home %contact-store)
=> (se-born | %home %metadata-hook)
=> (se-born | %home %metadata-store)
=> (se-born | %home %goad)
~> %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli"
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=? ..on-load (lte hood-version %5)
(se-born | %home %file-server)
..on-load
::
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}
@ -260,7 +239,7 @@
::
(se-drop & gyl)
::
++ take ::
++ take-arvo
|= [=wire =sign-arvo]
%+ take-onto wire
?> ?=(%onto +<.sign-arvo)
@ -314,10 +293,9 @@
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip card:agent:gall part)
=* pith +<+.$
^- (quip card:agent:gall state)
=. . se-subze:se-adze:se-adit
:_ pith(bin (~(put by bin) ost dev))
:_ sat(bin (~(put by bin) ost dev))
^- (list card:agent:gall)
?~ biz (flop moz)
:_ (flop moz)
@ -345,7 +323,7 @@
(se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
=. this
%- se-emit
[%pass wire %arvo %g %conf [our.hid q.wel] our.hid p.wel]
[%pass wire %arvo %g %conf q.wel]
$(servers t.servers)
::
++ priorities
@ -466,9 +444,10 @@
ta-abet:(ta-belt:(se-tame u.gul) bet)
::
++ se-born :: new server
|= wel/well:gall
|= [print-on-repeat=? wel=well:gall]
^+ +>
?: (~(has in ray) wel)
?. print-on-repeat +>
(se-text "[already running {<p.wel>}/{<q.wel>}]")
%= +>
ray (~(put in ray) wel)

161
pkg/arvo/lib/hood/helm.hoon
View File

@ -1,55 +1,45 @@
:: :: ::
:::: /hoon/helm/hood/lib :: ::
:: :: ::
/? 310 :: version
/- sole
/+ pill
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ part {$helm $0 pith} :: helm state
++ pith :: helm content
$: hoc/(map bone session) :: consoles
== ::
++ session ::
$: say/sole-share:sole :: console state
mud/(unit (sole-dialog:sole @ud)) :: console dialog
mass-timer/{way/wire nex/@da tim/@dr}
== ::
:: :: ::
:::: :: ::
:: :: ::
++ hood-reset :: reset command
$~ ::
++ helm-verb :: reset command
$~ ::
++ hood-reload :: reload command
(list term) ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|: $:{bowl:gall part} :: main helm work
=/ ost 0
=+ sez=(~(gut by hoc) ost $:session)
=| moz=(list card:agent:gall)
/+ pill
=* card card:agent:gall
|%
++ abet
[(flop moz) %_(+<+.$ hoc (~(put by hoc) ost sez))]
+$ any-state $%(state state-0)
+$ state
$: %1
mass-timer=[way=wire nex=@da tim=@dr]
==
+$ state-0 [%0 hoc=(map bone session-0)]
+$ session-0
$: say=*
mud=*
mass-timer=[way=wire nex=@da tim=@dr]
==
::
++ emit
|= card:agent:gall
%_(+> moz [+< moz])
++ state-0-to-1
|= s=state-0
^- state
[%1 mass-timer:(~(got by hoc.s) 0)]
--
|= [=bowl:gall sat=state]
=| moz=(list card)
|%
++ this .
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ abet [(flop moz) sat]
++ flog |=(=flog:dill (emit %pass /di %arvo %d %flog flog))
++ emit |=(card this(moz [+< moz]))
:: +emil: emit multiple cards
::
++ flog
|= =flog:dill
(emit %pass /di %arvo %d %flog flog)
++ emil
|= caz=(list card)
^+ this
?~(caz this $(caz t.caz, this (emit i.caz)))
::
++ emil :: return cards
|= (list card:agent:gall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
++ on-load
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7) old=any-state]
=< abet
=? old ?=(%0 -.old) (state-0-to-1 old)
?> ?=(%1 -.old)
this(sat old)
::
++ poke-rekey :: rotate private keys
|= des=@t
@ -60,17 +50,33 @@
=< abet
?~ sed
~& %invalid-private-key
+>.$
?. =(our who.u.sed)
this
?. =(our.bowl who.u.sed)
~& [%wrong-private-key-ship who.u.sed]
+>.$
this
(emit %pass / %arvo %j %rekey lyf.u.sed key.u.sed)
::
++ ames-secret
^- @t
=; pax (crip +:<.^(@p %j pax)>)
/(scot %p our.bowl)/code/(scot %da now.bowl)/(scot %p our.bowl)
::
++ poke-sec-atom
|= [hot=host:eyre dat=@]
?> ?=(%& -.hot)
=. p.hot (scag 2 p.hot) :: ignore subdomain
=. dat (scot %uw (en:crub:crypto ames-secret dat))
=- abet:(emit %pass /write %arvo %c %info -)
=/ byk=path (en-beam:format byk.bowl(r da+now.bowl) ~)
=+ .^(=tube:clay cc+(welp byk /mime/atom))
=/ =cage atom+(tube !>([/ (as-octs:mimes:html dat)]))
(foal:space:userlib :(welp byk sec+p.hot /atom) cage)
::
++ poke-moon :: rotate moon keys
|= sed=(unit [=ship =udiff:point:able:jael])
=< abet
?~ sed
+>.$
this
(emit %pass / %arvo %j %moon u.sed)
::
++ poke-mass
@ -79,13 +85,13 @@
::
++ poke-automass
|= recur=@dr
=. mass-timer.sez
[/helm/automass (add now recur) recur]
abet:(emit %pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez)
=. mass-timer.sat
[/helm/automass (add now.bowl recur) recur]
abet:(emit %pass way.mass-timer.sat %arvo %b %wait nex.mass-timer.sat)
::
++ poke-cancel-automass
|= ~
abet:(emit %pass way.mass-timer.sez %arvo %b %rest nex.mass-timer.sez)
abet:(emit %pass way.mass-timer.sat %arvo %b %rest nex.mass-timer.sat)
::
++ poke-pack
|= ~ =< abet
@ -97,11 +103,11 @@
%- (slog u.error)
~& %helm-wake-automass-fail
abet
=. nex.mass-timer.sez (add now tim.mass-timer.sez)
=. nex.mass-timer.sat (add now.bowl tim.mass-timer.sat)
=< abet
%- emil
:~ [%pass /heft %arvo %d %flog %crud %hax-heft ~]
[%pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez]
[%pass way.mass-timer.sat %arvo %b %wait nex.mass-timer.sat]
==
::
++ poke-send-hi
@ -119,14 +125,14 @@
?: =(%fail mes)
~& %poke-hi-fail
!!
abet:(flog %text "< {<src>}: {(trip mes)}")
abet:(flog %text "< {<src.bowl>}: {(trip mes)}")
::
++ poke-atom
|= ato/@
=+ len=(scow %ud (met 3 ato))
=+ gum=(scow %p (mug ato))
=< abet
(flog %text "< {<src>}: atom: {len} bytes, mug {gum}")
(flog %text "< {<src.bowl>}: atom: {len} bytes, mug {gum}")
::
++ coup-hi
|= {pax/path cop/(unit tang)} =< abet
@ -138,7 +144,7 @@
|: $:{syd/desk all/(list term)} =< abet
%- emil
%+ turn all
=+ top=`path`/(scot %p our)/[syd]/(scot %da now)
=+ top=`path`/(scot %p our.bowl)/[syd]/(scot %da now.bowl)
=/ van/(list {term ~})
:- zus=[%zuse ~]
~(tap by dir:.^(arch %cy (welp top /sys/vane)))
@ -161,14 +167,15 @@
:: Trigger with |reset.
::
++ poke-reset
|= hood-reset
|= hood-reset=~
=< abet
%- emil
^- (list card:agent:gall)
=/ top=path /(scot %p our)/home/(scot %da now)/sys
=/ hun .^(@ %cx (welp top /hoon/hoon))
=/ arv .^(@ %cx (welp top /arvo/hoon))
:- [%pass /reset %arvo %d %flog %lyra `@t`hun `@t`arv]
=/ top=path /(scot %p our.bowl)/home/(scot %da now.bowl)/sys
=/ hun .^(@t %cx (welp top /hoon/hoon))
=/ arv .^(@t %cx (welp top /arvo/hoon))
~! *task:able:dill
:- [%pass /reset %arvo %d %flog %lyra `hun arv]
%+ turn
(module-ova:pill top)
|=([=wire =flog:dill] [%pass wire %arvo %d %flog flog])
@ -200,23 +207,25 @@
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-helm-bad-mark mark] !!)
%helm-ames-sift =;(f (f !<(_+<.f vase)) poke-ames-sift)
%helm-ames-verb =;(f (f !<(_+<.f vase)) poke-ames-verb)
%helm-ames-wake =;(f (f !<(_+<.f vase)) poke-ames-wake)
%helm-atom =;(f (f !<(_+<.f vase)) poke-atom)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-hi =;(f (f !<(_+<.f vase)) poke-hi)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-mass =;(f (f !<(_+<.f vase)) poke-mass)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-pack =;(f (f !<(_+<.f vase)) poke-pack)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
%helm-reload =;(f (f !<(_+<.f vase)) poke-reload)
%helm-reload-desk =;(f (f !<(_+<.f vase)) poke-reload-desk)
%helm-reset =;(f (f !<(_+<.f vase)) poke-reset)
%helm-send-hi =;(f (f !<(_+<.f vase)) poke-send-hi)
%helm-ames-sift =;(f (f !<(_+<.f vase)) poke-ames-sift)
%helm-ames-verb =;(f (f !<(_+<.f vase)) poke-ames-verb)
%helm-ames-wake =;(f (f !<(_+<.f vase)) poke-ames-wake)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-serve =;(f (f !<(_+<.f vase)) poke-serve)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
==
::
++ take-agent
@ -230,7 +239,7 @@
|= [wir=wire success=? binding=binding:eyre] =< abet
(flog %text "bound: {<success>}")
::
++ take
++ take-arvo
|= [=wire =sign-arvo]
?+ wire ~|([%helm-bad-take-wire wire +<.sign-arvo] !!)
[%automass *] %+ take-wake-automass t.wire

663
pkg/arvo/lib/hood/kiln.hoon
View File

@ -1,67 +1,66 @@
:: :: ::
:::: /hoon/kiln/hood/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
=, clay
=, space:userlib
=, format
|% :: ::
++ part {$kiln $0 pith} :: kiln state
++ pith :: ::
$: rem/(map desk per-desk) ::
syn/(map kiln-sync let/@ud) ::
autoload-on/? ::
cur-hoon/@uvI ::
cur-arvo/@uvI ::
cur-zuse/@uvI ::
cur-vanes/(map @tas @uvI) ::
commit-timer/{way/wire nex/@da tim/@dr mon=term}
== ::
++ per-desk :: per-desk state
$: auto/? :: escalate on failure
gem/germ :: strategy
her/@p :: from ship
sud/@tas :: from desk
cas/case :: at case
== ::
:: :: ::
:::: :: ::
:: :: ::
++ kiln-commit term ::
++ kiln-mount ::
$: pax/path ::
pot/term ::
== ::
++ kiln-unmount $@(term {knot path}) ::
++ kiln-sync ::
$: syd/desk ::
her/ship ::
sud/desk ::
== ::
++ kiln-unsync ::
$: syd/desk ::
her/ship ::
sud/desk ::
== ::
++ kiln-merge ::
$: syd/desk ::
ali/ship ::
sud/desk ::
cas/case ::
gim/?($auto germ) ::
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:gall part} :: main kiln work
|%
+$ state [%1 pith-1]
+$ any-state
$% state
[%0 pith-0]
==
+$ pith-1 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
== ::
+$ pith-0 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
autoload-on=? ::
cur-hoon=@uvI ::
cur-arvo=@uvI ::
cur-zuse=@uvI ::
cur-vanes=(map @tas @uvI) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
==
+$ per-desk :: per-desk state
$: auto=? :: escalate on failure
gem=germ :: strategy
her=@p :: from ship
sud=@tas :: from desk
cas=case :: at case
==
+$ kiln-commit term ::
+$ kiln-mount ::
$: pax=path ::
pot=term ::
==
+$ kiln-unmount $@(term [knot path]) ::
+$ kiln-sync ::
$: syd=desk ::
her=ship ::
sud=desk ::
==
+$ kiln-unsync ::
$: syd=desk ::
her=ship ::
sud=desk ::
==
+$ kiln-merge ::
$: syd=desk ::
ali=ship ::
sud=desk ::
cas=case ::
gim=?($auto germ) ::
==
--
|= [bowl:gall state]
?> =(src our)
|_ moz/(list card:agent:gall)
|_ moz=(list card:agent:gall)
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ abet :: resolve
[(flop moz) `part`+<+.$]
[(flop moz) `state`+<+.$]
::
++ emit
|= card:agent:gall
@ -74,9 +73,37 @@
::
++ render
|= {mez/tape sud/desk who/ship syd/desk}
:^ %palm [" " ~ ~ ~] leaf+mez
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
::
++ on-load
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7) old=any-state]
=< abet
=? . ?=(%0 -.old)
=/ recognized-ota=(unit [syd=desk her=ship sud=desk])
=/ syncs=(list [[syd=desk her=ship sud=desk] =aeon])
~(tap by syn.old)
|- ^- (unit [syd=desk her=ship sud=desk])
?~ syncs
~
?: &(=(%base syd.i.syncs) !=(our her.i.syncs) =(%kids sud.i.syncs))
`[syd her sud]:i.syncs
$(syncs t.syncs)
::
=. +<+.$.abet
=- old(- %1, |3 [ota=~ commit-timer.old], syn -)
?~ recognized-ota
syn
(~(del by syn) [syd her sud]:u.recognized-ota)
::
=? ..abet ?=(^ recognized-ota)
(poke-internal:update `[her sud]:u.recognized-ota)
+(old +<+.$.abet)
::
?> ?=(%1 -.old)
=. +<+.$.abet old
..abet
::
++ poke-commit
|= [mon/kiln-commit auto=?]
=< abet
@ -127,6 +154,180 @@
abet:(spam (render "already tracking" [sud her syd]:hos) ~)
abet:abet:start-track:(auto hos)
::
++ update
|%
++ make-wire
|= =path
?> ?=(^ ota)
%- welp
:_ path
/kiln/ota/(scot %p ship.u.ota)/[desk.u.ota]/(scot %ud aeon.u.ota)
::
++ check-ota
|= =wire
?~ ota
|
?& ?=([@ @ @ *] wire)
=(i.wire (scot %p ship.u.ota))
=(i.t.wire desk.u.ota)
=(i.t.t.wire (scot %ud aeon.u.ota))
==
::
++ render
|= [mez=tape error=(unit (pair term tang))]
%+ spam
?~ ota
leaf+mez
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
~[leaf+"from {<desk.u.ota>}" leaf+"on {<ship.u.ota>}"]
?~ error
~
[>p.u.error< q.u.error]
::
++ render-ket
|= [mez=tape error=(unit (pair term tang))]
?> ?=(^ ota)
=< ?>(?=(^ ota) .)
%+ spam
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
~[leaf+"from {<desk.u.ota>}" leaf+"on {<ship.u.ota>}"]
?~ error
~
[>p.u.error< q.u.error]
::
:: If destination desk doesn't exist, need a %init merge. If this is
:: its first revision, it probably doesn't have a mergebase yet, so
:: use %that.
::
++ get-germ
|= =desk
=+ .^(=cass:clay %cw /(scot %p our)/home/(scot %da now))
?- ud.cass
%0 %init
%1 %that
* %mate
==
::
++ poke
|= arg=(unit [=ship =desk])
abet:(poke-internal arg)
::
++ poke-internal
|= arg=(unit [=ship =desk])
^+ ..abet
=? ..abet =(arg (bind ota |=([=ship =desk =aeon] [ship desk])))
(render "restarting OTA sync" ~)
=? ..abet ?=(^ ota)
=. ..abet (render-ket "cancelling OTA sync" ~)
..abet(ota ~)
?~ arg
..abet
=. ota `[ship.u.arg desk.u.arg *aeon]
=. ..abet (render "starting OTA sync" ~)
%: emit
%pass (make-wire /find) %arvo %c
%warp ship.u.arg desk.u.arg `[%sing %y ud+1 /]
==
::
++ take
|= [=wire =sign-arvo]
^+ ..abet
?> ?=(^ ota)
?. (check-ota wire)
..abet
?. ?=([@ @ @ @ *] wire)
..abet
?+ i.t.t.t.wire ~&([%strange-ota-take t.t.t.wire] ..abet)
%find (take-find sign-arvo)
%sync (take-sync sign-arvo)
%download (take-download sign-arvo)
%merge-home (take-merge-home sign-arvo)
%merge-kids (take-merge-kids sign-arvo)
==
::
++ take-find
|= =sign-arvo
?> ?=(%writ +<.sign-arvo)
?> ?=(^ ota)
=. ..abet (render-ket "activated OTA" ~)
%: emit
%pass (make-wire /sync) %arvo %c
%warp ship.u.ota desk.u.ota `[%sing %w da+now /]
==
::
++ take-sync
|= =sign-arvo
?> ?=(%writ +<.sign-arvo)
?> ?=(^ ota)
?~ p.sign-arvo
=. ..abet (render-ket "OTA cancelled (1), retrying" ~)
(poke-internal `[ship desk]:u.ota)
=. ..abet (render-ket "downloading OTA update" ~)
=? aeon.u.ota ?=($w p.p.u.p.sign-arvo)
ud:;;(cass:clay q.q.r.u.p.sign-arvo)
%: emit
%pass (make-wire /download) %arvo %c
%warp ship.u.ota desk.u.ota `[%sing %v ud+aeon.u.ota /]
==
::
++ take-download
|= =sign-arvo
^+ ..abet
?> ?=(%writ +<.sign-arvo)
?> ?=(^ ota)
?~ p.sign-arvo
=. ..abet (render-ket "OTA cancelled (2), retrying" ~)
(poke-internal `[ship desk]:u.ota)
=. ..abet (render-ket "finished downloading OTA" ~)
=. aeon.u.ota +(aeon.u.ota)
=/ =germ (get-germ %home)
=. ..abet (render-ket "applying OTA to %home" ~)
%- emil
:~ :* %pass (make-wire /merge-home) %arvo %c
%merg %home ship.u.ota desk.u.ota ud+(dec aeon.u.ota) germ
==
:* %pass (make-wire /sync) %arvo %c
%warp ship.u.ota desk.u.ota `[%sing %z ud+aeon.u.ota /]
==
==
::
++ take-merge-home
|= =sign-arvo
?> ?=(%mere +<.sign-arvo)
?> ?=(^ ota)
?: ?=([%| %ali-unavailable *] p.sign-arvo)
=. ..abet
=/ =tape "OTA to %home failed, maybe because sunk; restarting"
(render-ket tape `p.p.sign-arvo)
(poke-internal `[ship desk]:u.ota)
::
?: ?=(%| -.p.sign-arvo)
=/ =tape "OTA to %home failed, waiting for next revision"
(render-ket tape `p.p.sign-arvo)
=. ..abet (render-ket "OTA to %home succeeded" ~)
=. ..abet (render-ket "applying OTA to %kids" ~)
=/ =germ (get-germ %kids)
%: emit
%pass (make-wire /merge-kids) %arvo %c
%merg %kids ship.u.ota desk.u.ota ud+(dec aeon.u.ota) germ
==
::
++ take-merge-kids
|= =sign-arvo
?> ?=(%mere +<.sign-arvo)
?> ?=(^ ota)
?: ?=([%| %ali-unavailable *] p.sign-arvo)
=. ..abet
=/ =tape "OTA to %kids failed, maybe because sunk; restarting"
(render-ket tape `p.p.sign-arvo)
(poke-internal `[ship desk]:u.ota)
::
?- -.p.sign-arvo
%& (render-ket "OTA to %kids succeeded" ~)
%| (render-ket "OTA to %kids failed" `p.p.sign-arvo)
==
--
::
++ poke-sync ::
|= hos/kiln-sync
?: (~(has by syn) hos)
@ -136,6 +337,10 @@
++ poke-syncs :: print sync config
|= ~
=< abet %- spam
:- :- %leaf
?~ ota
"OTAs disabled"
"OTAs from {<desk.u.ota>} on {<ship.u.ota>}"
?: =(0 ~(wyt by syn))
[%leaf "no syncs configured"]~
%+ turn ~(tap in ~(key by syn))
@ -190,127 +395,30 @@
=/ =rite [%r ~ ?:(pub %black %white) ~]
[%pass /kiln/permission %arvo %c [%perm syd pax rite]]
::
++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod))
++ poke-start-autoload |=(~ abet:start:autoload)
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-goad-gall)
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-wipe-ford =;(f (f !<(_+<.f vase)) poke-wipe-ford)
%kiln-keep-ford =;(f (f !<(_+<.f vase)) poke-keep-ford)
%kiln-autoload =;(f (f !<(_+<.f vase)) poke-autoload)
%kiln-overload =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-goad-gall)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
%kiln-wash-gall =;(f (f !<(_+<.f vase)) poke-wash-gall)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-start-autoload =;(f (f !<(_+<.f vase)) poke-start-autoload)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
==
::
++ autoload
|%
++ emit
|= a/card:agent:gall
+>(..autoload (^emit a))
::
++ tracked-vanes
^- (list @tas)
~[%ames %behn %clay %dill %eyre %ford %gall %iris %jael]
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))
++ hash-vane
|= syd/@tas ^- (pair term @uvI)
[syd (sys-hash /vane/[syd]/hoon)]
::
++ rehash-vanes
^+ cur-vanes
(malt (turn tracked-vanes hash-vane))
::
::
++ poke
|= lod/(unit ?)
?^ lod
..autoload(autoload-on u.lod)
=. autoload-on !autoload-on
(spam leaf+"turned autoload {?:(autoload-on "on" "off")}" ~)
::
++ start
=. cur-hoon (sys-hash /hoon/hoon)
=. cur-arvo (sys-hash /arvo/hoon)
=. cur-zuse (sys-hash /zuse/hoon)
=. cur-vanes rehash-vanes
subscribe-next
::
++ subscribe-next
%- emit
[%pass /kiln/autoload %arvo %c [%warp our %home `[%next %z da+now /sys]]]
::
++ writ =>(check-new subscribe-next)
++ check-new
?. autoload-on
..check-new
=/ new-hoon (sys-hash /hoon/hoon)
=/ new-arvo (sys-hash /arvo/hoon)
?: |(!=(new-hoon cur-hoon) !=(new-arvo cur-arvo))
=. cur-hoon new-hoon
=. cur-arvo new-arvo
=. cur-vanes rehash-vanes
(emit %pass /kiln/reload/hoon %agent [our %hood] %poke %helm-reset !>(~))
:: XX updates cur-vanes?
=/ new-zuse (sys-hash /zuse/hoon)
?: !=(new-zuse cur-zuse)
=. cur-zuse new-zuse
=. cur-vanes rehash-vanes
=/ =cage [%helm-reload !>([%zuse tracked-vanes])]
(emit [%pass /kiln/reload/zuse %agent [our %hood] %poke cage])
(roll tracked-vanes load-vane)
::
++ load-vane
=< %_(. con ..load-vane)
|: $:{syd/@tas con/_.}
=. +>.$ con
=/ new-vane q:(hash-vane syd)
?: =(`new-vane (~(get by cur-vanes) syd))
+>.$
=. cur-vanes (~(put by cur-vanes) syd new-vane)
=/ =cage [%helm-reload !>(~[syd])]
(emit %pass /kiln/reload/[syd] %agent [our %hood] %poke cage)
::
++ coup-reload
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-reload-lame u.saw]
+>.$
--
::
++ poke-overload
:: +poke-overload: wipes ford cache at {start}, and then every {recur}.
|= [recur=@dr start=@da]
?> (gte start now)
abet:(emit %pass /kiln/overload/(scot %dr recur) %arvo %b [%wait start])
::
++ poke-wipe-ford
|=(percent=@ud abet:(emit %pass /kiln %arvo %f [%wipe percent]))
::
++ poke-keep-ford
|= [compiler-cache-size=@ud build-cache-size=@ud]
=< abet
(emit %pass /kiln %arvo %f [%keep compiler-cache-size build-cache-size])
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %pass /kiln %arvo %g %goad force agent)
@ -319,8 +427,6 @@
|= =ship
abet:(emit %pass /kiln %arvo %g %sear ship)
::
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %g [%wash ~]))
::
++ done
|= {way/wire saw/(unit error:ames)}
~? ?=(^ saw) [%kiln-nack u.saw]
@ -331,33 +437,27 @@
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
[%kiln %fancy *] ?> ?=(%poke-ack -.sign)
(take-coup-fancy t.t.wire p.sign)
[%kiln %reload *] ?> ?=(%poke-ack -.sign)
(take-coup-reload t.t.wire p.sign)
[%kiln %spam *] ?> ?=(%poke-ack -.sign)
(take-coup-spam t.t.wire p.sign)
==
::
++ take-general
++ take-arvo
|= [=wire =sign-arvo]
?- wire
[%sync %merg *] %+ take-mere-sync t.t.wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
[%autoload *] %+ take-writ-autoload t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%find-ship *] %+ take-writ-find-ship t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%sync *] %+ take-writ-sync t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%overload *] %+ take-wake-overload t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%ota *] abet:(take:update t.wire sign-arvo)
*
?+ +<.sign-arvo ~|([%kiln-bad-take-card +<.sign-arvo] !!)
?+ +<.sign-arvo
((slog leaf+"kiln: strange card {<+<.sign-arvo wire>}" ~) abet)
%done %+ done wire
?>(?=(%done +<.sign-arvo) +>.sign-arvo)
%made %+ take-made wire
?>(?=(%made +<.sign-arvo) +>.sign-arvo)
%mere %+ take-mere wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
==
@ -367,26 +467,10 @@
|= {way/wire are/(each (set path) (pair term tang))}
abet:abet:(mere:(take way) are)
::
++ take-made
|= [way=wire date=@da result=made-result:ford]
:: hack for |overload
::
:: We might have gotten an ignorable response back for our cache priming
:: ford call. If it matches our magic wire, ignore it.
::
?: =(/prime/cache way)
~& %cache-primed
abet
abet:abet:(made:(take way) date result)
::
++ take-coup-fancy ::
|= {way/wire saw/(unit tang)}
abet:abet:(coup-fancy:(take way) saw)
::
++ take-coup-reload ::
|= {way/wire saw/(unit tang)}
abet:(coup-reload:autoload way saw)
::
++ take-coup-spam ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-spam-lame u.saw]
@ -400,6 +484,8 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
abet:abet:(mere:(auto hos) mes)
::
++ take-writ-find-ship ::
@ -410,6 +496,8 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
abet:abet:(take-find-ship:(auto hos) rot)
::
++ take-writ-sync ::
@ -420,24 +508,9 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) rot)
::
++ take-writ-autoload
|= {way/wire rot/riot}
?> ?=(~ way)
?> ?=(^ rot)
abet:writ:autoload
::
++ take-wake-overload
|= {way/wire error=(unit tang)}
?^ error
%- (slog u.error)
~& %kiln-take-wake-overload-fail
?. (~(has by syn) hos)
abet
?> ?=({@ ~} way)
=+ tym=(slav %dr i.way)
~& %wake-overload-deprecated
abet
abet:abet:(writ:(auto hos) rot)
::
++ take-wake-autocommit
|= [way=wire error=(unit tang)]
@ -526,7 +599,7 @@
.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now))
?: =(0 ud.cass)
%init
?:((gth 3 ud.cass) %that %mate)
?:((gth 2 ud.cass) %that %mate)
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
@ -534,7 +607,7 @@
::
++ mere
|= mes=(each (set path) (pair term tang))
?: ?=([%| %bad-fetch-ali *] mes)
?: ?=([%| %ali-unavailable *] mes)
=. +>.$
%^ spam
leaf+"merge cancelled, maybe because sunk; restarting"
@ -585,15 +658,6 @@
~| %kiln-work-fail
.
::
++ ford-fail
|=(tan/tang ~|(%ford-fail (mean tan)))
::
++ unwrap-tang
|* res/(each * tang)
?: ?=(%& -.res)
p.res
(ford-fail p.res)
::
++ perform ::
^+ .
(blab [%pass /kiln/[syd] %arvo %c [%merg syd her sud cas gem]] ~)
@ -621,10 +685,7 @@
++ coup-fancy
|= saw/(unit tang)
?~ saw
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
+>
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf+-< leaf+-> u.saw)
@ -638,35 +699,60 @@
=+ "merged with strategy {<gem>}"
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
:: ~? > =(~ p.are) [%mere-no-conflict syd]
=+ "mashing conflicts"
=> .(+>.$ (spam leaf+- ~))
=> .(+>.$ (spam leaf+"mashing conflicts" ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
=, ford
:* %pass /kiln/[syd] %arvo %f
:* %build live=%.n
^- schematic
:- %list
^- (list schematic)
:: ~& > kiln-mashing+[p.are syd=syd +<.abet]
%+ turn ~(tap in p.are)
|= pax/path
^- [schematic schematic]
:- [%$ %path -:!>(*path) pax]
=/ base=schematic [%scry %c %x `rail`[[our tic] (flop pax)]]
?> ?=([%da @] cas)
=/ alis=schematic
[%pin p.cas `schematic`[%scry %c %x [[our syd] (flop pax)]]]
=/ bobs=schematic
[%scry %c %x [[our syd] (flop pax)]]
=/ dali=schematic [%diff [our syd] base alis]
=/ dbob=schematic [%diff [our syd] base bobs]
=/ for=mark
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
^- schematic
[%mash [our tic] for [[her sud] for dali] [[our syd] for dbob]]
== ==
=/ notations=(list [path (unit [mark vase])])
%+ turn ~(tap in p.are)
|= =path
=/ =mark -:(flop path)
=/ =dais .^(dais %cb /(scot %p our)/[syd]/(scot cas)/[mark])
=/ base .^(vase %cr (weld /(scot %p our)/[tic]/(scot cas) path))
=/ ali .^(vase %cr (weld /(scot %p her)/[sud]/(scot cas) path))
=/ bob .^(vase %cr (weld /(scot %p our)/[syd]/(scot cas) path))
=/ ali-dif (~(diff dais base) ali)
=/ bob-dif (~(diff dais base) bob)
=/ mash (~(mash dais base) [her sud ali-dif] [our syd bob-dif])
:- path
?~ mash
~
`[mark (~(pact dais base) u.mash)]
=/ [annotated=(list [path *]) unnotated=(list [path *])]
(skid notations |=([* v=*] ?=(^ v)))
=/ tic=desk (cat 3 syd '-scratch')
=/ tan=(list tank)
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[tic]>}
please resolve the following conflicts and run
|merge {<syd>} our {<[tic]>}
"""
%^ tanks-if-any
"annotated conflicts in:" (turn annotated head)
""
%^ tanks-if-any
"unannotated conflicts in:" (turn unnotated head)
"""
some conflicts could not be annotated.
for these, the scratch space contains
the most recent common ancestor of the
conflicting content.
"""
==
=< win
%- blab:(spam tan)
:_ ~
:* %pass /kiln/[syd] %arvo %c
%info
tic %&
%+ murn notations
|= [=path dif=(unit [=mark =vase])]
^- (unit [^path miso])
?~ dif
~
`[path %mut mark.u.dif vase.u.dif]
==
=+ "failed to merge with strategy meld"
lose:(spam leaf+- >p.p.are< q.p.are)
?: ?=(%& -.are)
@ -706,7 +792,11 @@
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
[tic=tic (spam leaf+-< leaf+-> q.p.are)]
(fancy-merge tic our syd %init)
=. ..mere (fancy-merge tic our syd %init)
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
==
::
++ tape-to-tanks
@ -717,68 +807,5 @@
|= {a/tape b/(list path) c/tape} ^- (list tank)
?: =(~ b) ~
(welp (tape-to-tanks "\0a{c}{a}") >b< ~)
::
++ made
|= [date=@da result=made-result:ford]
:: |= {dep/@uvH reg/gage:ford}
^+ +>
::
?: ?=([%incomplete *] result)
=+ "failed to mash"
lose:(spam leaf+- tang.result)
?: ?=([%complete %error *] result)
=+ "failed to mash"
lose:(spam leaf+- message.build-result.result)
?> ?=([%complete %success %list *] result)
=/ can=(list (pair path (unit miso)))
%+ turn results.build-result.result
|= res=build-result:ford
^- (pair path (unit miso))
?> ?=([%success ^ *] res)
~! res
=+ pax=(result-to-cage:ford head.res)
=+ dif=(result-to-cage:ford tail.res)
::
?. ?=($path p.pax)
~| "strange path mark: {<p.pax>}"
!!
[;;(path q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])]
:: ~& > kiln-made+[(turn can head) syd=syd +<.abet]
=+ notated=(skid can |=({path a/(unit miso)} ?=(^ a)))
=+ annotated=(turn `(list (pair path *))`-.notated head)
=+ unnotated=(turn `(list (pair path *))`+.notated head)
=+ `desk`(cat 3 syd '-scratch')
=/ tan=(list tank)
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[-]>}
please resolve the following conflicts and run
|merge {<syd>} our {<[-]>}
"""
%^ tanks-if-any
"annotated conflicts in:" annotated
""
%^ tanks-if-any
"unannotated conflicts in:" unnotated
"""
some conflicts could not be annotated.
for these, the scratch space contains
the most recent common ancestor of the
conflicting content.
"""
==
=< win
%- blab:(spam tan)
:_ ~
:* %pass /kiln/[syd] %arvo %c
:* %info
(cat 3 syd '-scratch') %&
%+ murn can
|= {p/path q/(unit miso)}
`(unit (pair path miso))`?~(q ~ `[p u.q])
== ==
--
--

143
pkg/arvo/lib/hood/write.hoon
View File

@ -1,143 +0,0 @@
:: File writer module
::
:::: /hoon/write/hood/lib
::
/? 310
=, format
=* as-octs as-octs:mimes:html
=, space:userlib
|%
+$ part {$write $0 pith} :: no state
+$ pith ~
--
::
::::
::
|%
++ data $%({$json json} {$mime mime})
--
::
::::
::
|= {bowl:gall part}
=* par +<+
|_ moz/(list card:agent:gall)
++ abet [(flop moz) `part`par]
++ emit
|= =card:agent:gall
%_(+> moz :_(moz card))
::
++ beak-now byk(r [%da now])
++ poke-wipe
|= sup/path ^+ abet :: XX determine extension, beak
=+ ext=%md
?~ (file (en-beam beak-now [ext sup]))
~|(not-found+[ext `path`(flop sup)] !!)
=- abet:(emit %pass /write %arvo %c %info -)
(fray (en-beam beak-now [ext sup]))
::
++ poke-tree
|= {sup/path mim/mime} ^+ abet :: XX determine extension, beak
(poke--data [`%md (flop sup)] %mime mim)
::
++ poke-paste
|= {typ/?($hoon $md $txt) txt/@t} ^+ abet
(poke--data [`typ /web/paste/(scot %da now)] %mime / (as-octs txt))
::
++ poke-comment
|= {sup/path him/ship txt/@t} ^+ abet
=+ pax=(welp (flop sup) /comments/(scot %da now))
=. txt
%+ rap 3 :~
'## `' (scot %p him) '`'
'\0a' txt
==
(poke--data [`%md pax] %mime / (as-octs txt))
::
++ poke-fora-post
|= {sup/path him/ship hed/@t txt/@t} ^+ abet
=+ pax=(welp (flop sup) /posts/(cat 3 (scot %da now) '~'))
=. txt
%- crip
"""
---
type: post
date: {<now>}
title: {(trip hed)}
author: {<him>}
navsort: bump
navuptwo: true
comments: reverse
---
{(trip txt)}
"""
(poke--data [`%md pax] %mime / (as-octs txt))
::
++ ames-secret
^- @t
=- (crip +:<.^(@p %j pax)>)
pax=/(scot %p our)/code/(scot %da now)/(scot %p our)
::
++ poke-sec-atom
|= {hot/host:eyre dat/@}
?> ?=(%& -.hot)
=. p.hot (scag 2 p.hot) :: ignore subdomain
=. dat (scot %uw (en:crub:crypto ames-secret dat))
(poke--data [`%atom [%sec p.hot]] %mime / (as-octs dat))
::
++ poke--data
|= {{ext/(unit @t) pax/path} dat/data} ^+ abet
?~ ext $(ext [~ -.dat])
=+ cay=?-(-.dat $json [-.dat !>(+.dat)], $mime [-.dat !>(+.dat)])
?: =(u.ext -.dat)
(made pax now [%complete %success %$ cay])
=< abet
%- emit :*
%pass write+pax %arvo %f
%build
live=%.n :: XX defer %nice
^- schematic:ford :: SYNTAX ERROR AT START OF LINE?
=/ =beak beak-now
[%cast [p q]:beak u.ext [%$ cay]]
==
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-write-bad-mark mark] !!)
%write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
%write-paste =;(f (f !<(_+<.f vase)) poke-paste)
%write-tree =;(f (f !<(_+<.f vase)) poke-tree)
%write-wipe =;(f (f !<(_+<.f vase)) poke-wipe)
==
::
++ made
|= [pax=wire date=@da result=made-result:ford]
^+ abet
:: |= {pax/wire @ res/gage:ford} ^+ abet
:: ?. =(our src)
:: ~|(foreign-write/[our=our src=src] !!)
?: ?=(%incomplete -.result)
(mean tang.result)
::
=/ build-result build-result.result
::
?: ?=([%error *] build-result)
(mean message.build-result)
::
=/ =cage (result-to-cage:ford build-result)
::
=- abet:(emit %pass /write %arvo %c %info -)
::
(foal :(welp (en-beam beak-now ~) pax /[-.cage]) cage)
::
++ take ::
|= [=wire =sign-arvo]
%+ made wire
?> ?=(%made +<.sign-arvo)
+>.sign-arvo
::
++ take-agent
|= [=wire =sign:agent:gall]
~|([%write-bad-take-agent wire -.sign] !!)
--

20
pkg/arvo/lib/language-server/complete.hoon
View File

@ -248,15 +248,15 @@
::
++ get-id
|= [pos=@ud txt=tape]
^- [forward=(unit term) backward=(unit term) id=(unit term)]
=/ forward=(unit term)
%+ scan `tape`(slag pos txt)
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
=/ backward=(unit term)
^- [forward=(unit @t) backward=(unit @t) id=(unit @t)]
=/ seek
;~(sfix (punt (cook crip (star prn))) (star ;~(pose prn (just `@`10))))
=/ forward=(unit @t)
(scan (slag pos txt) seek)
=/ backward=(unit @t)
%- (lift |=(t=@tas (swp 3 t)))
%+ scan `tape`(flop (scag pos txt))
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
=/ id=(unit term)
(scan (flop (scag pos txt)) seek)
=/ id=(unit @t)
?~ forward
?~ backward
~
@ -338,13 +338,13 @@
~? > debug %start-magick
=/ magicked txt:(insert-magic pos code)
~? > debug %start-parsing
=/ res (lily magicked (language-server-parser *beam))
=/ res (lily magicked (language-server-parser *path))
?: ?=(%| -.res)
~? > debug [%parsing-error p.res]
[%| p.res]
:- %&
~? > debug %parsed-good
((cury tab-list-hoon sut) tssg+sources.p.res)
((cury tab-list-hoon sut) hoon.p.res)
::
:: Generators
++ tab-generators

267
pkg/arvo/lib/language-server/parser.hoon
View File

@ -1,204 +1,85 @@
:: lifted directly from ford, should probably be in zuse
=< parse-scaffold
=, ford
=, clay
=< pile-rule
|%
++ parse-scaffold
|= src-beam=beam
::
=/ hoon-parser (vang & (en-beam:format src-beam))
|^ ::
%+ cook
|= a=[@ud (list ^cable) (list ^cable) (list ^crane) (list hoon)]
^- scaffold
[[[p q] s]:src-beam a]
::
%+ ifix [gay gay]
;~ plug
:: parses the zuse version, eg "/? 309"
::
;~ pose
(ifix [;~(plug net wut gap) gap] dem)
(easy zuse)
==
:: pareses the structures, eg "/- types"
::
;~ pose
(ifix [;~(plug net hep gap) gap] (most ;~(plug com gaw) cable))
(easy ~)
==
:: parses the libraries, eg "/+ lib1, lib2"
::
;~ pose
(ifix [;~(plug net lus gap) gap] (most ;~(plug com gaw) cable))
(easy ~)
==
::
(star ;~(sfix crane gap))
::
(most gap tall:hoon-parser)
==
:: +beam: parses a hood path and converts it to a beam
::
++ beam
%+ sear de-beam:format
;~ pfix
net
(sear plex (stag %clsg poor)):hoon-parser
==
:: +cable: parses a +^cable, a reference to something on the filesystem
::
:: This parses:
::
:: `library` -> wraps `library` around the library `library`
:: `face=library` -> wraps `face` around the library `library`
:: `*library` -> exposes `library` directly to the subject
::
++ cable
%+ cook |=(a=^cable a)
++ pile-rule
|= pax=path
%- full
%+ ifix [gay gay]
%+ cook |=(pile +<)
;~ pfix
:: parse optional /? and ignore
::
;~ pose
(stag ~ ;~(pfix tar sym))
(cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym))
(cook |=(a=term [`a a]) sym)
(cold ~ ;~(plug net wut gap dem gap))
(easy ~)
==
:: +crane: all runes that start with / which aren't /?, /-, /+ or //.
::
++ crane
=< apex
:: whether we allow tall form
=| allow-tall-form=?
::
|%
++ apex
%+ knee *^crane |. ~+
;~ pfix net
;~ pose
:: `/~` hoon literal
::
(stag %fssg ;~(pfix sig hoon))
:: `/$` process query string
::
(stag %fsbc ;~(pfix bus hoon))
:: `/|` first of many options that succeeds
::
(stag %fsbr ;~(pfix bar parse-alts))
:: `/=` wrap a face around a crane
::
(stag %fsts ;~(pfix tis parse-face))
:: `/.` null terminated list
::
(stag %fsdt ;~(pfix dot parse-list))
:: `/,` switch by path
::
(stag %fscm ;~(pfix com parse-switch))
:: `/&` pass through a series of mark
::
(stag %fspm ;~(pfix pad parse-pipe))
:: `/_` run a crane on each file in the current directory
::
(stag %fscb ;~(pfix cab subcrane))
:: `/;` passes date through a gate
::
(stag %fssm ;~(pfix mic parse-gate))
:: `/:` evaluate at path
::
(stag %fscl ;~(pfix col parse-at-path))
:: `/^` cast
::
(stag %fskt ;~(pfix ket parse-cast))
:: `/*` run a crane on each file with current path as prefix
::
(stag %fstr ;~(pfix tar subcrane))
:: `/!mark/ evaluate as hoon, then pass through mark
::
(stag %fszp ;~(pfix zap ;~(sfix sym net)))
:: `/mark/` passes current path through :mark
::
(stag %fszy ;~(sfix sym net))
;~ plug
;~ pose
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net hep gap)
(most ;~(plug com gaw) taut-rule)
==
gap
==
(easy ~)
==
:: +parse-alts: parse a set of alternatives
::
++ parse-alts
%+ wide-or-tall
(ifix [lit rit] (most ace subcrane))
;~(sfix (star subcrane) gap duz)
:: +parse-face: parse a face around a subcrane
::
++ parse-face
%+ wide-or-tall
;~(plug sym ;~(pfix tis subcrane))
;~(pfix gap ;~(plug sym subcrane))
:: +parse-list: parse a null terminated list of cranes
::
++ parse-list
%+ wide-or-tall
fail
;~(sfix (star subcrane) gap duz)
:: +parse-switch: parses a list of [path crane]
::
++ parse-switch
%+ wide-or-tall
fail
=- ;~(sfix (star -) gap duz)
;~(pfix gap net ;~(plug static-path subcrane))
:: +parse-pipe: parses a pipe of mark conversions
::
++ parse-pipe
%+ wide-or-tall
;~(plug (plus ;~(sfix sym pad)) subcrane)
=+ (cook |=(a=term [a ~]) sym)
;~(pfix gap ;~(plug - subcrane))
:: +parse-gate: parses a gate applied to a crane
::
++ parse-gate
%+ wide-or-tall
;~(plug ;~(sfix wide:hoon-parser mic) subcrane)
;~(pfix gap ;~(plug tall:hoon-parser subcrane))
:: +parse-at-path: parses a late bound bath
::
++ parse-at-path
%+ wide-or-tall
;~(plug ;~(sfix late-bound-path col) subcrane)
;~(pfix gap ;~(plug late-bound-path subcrane))
:: +parse-cast: parses a mold and then the subcrane to apply that mold to
::
++ parse-cast
%+ wide-or-tall
;~(plug ;~(sfix wyde:hoon-parser ket) subcrane)
;~(pfix gap ;~(plug till:hoon-parser subcrane))
:: +subcrane: parses a subcrane
::
++ subcrane
%+ wide-or-tall
apex(allow-tall-form |)
;~(pfix gap apex)
:: +wide-or-tall: parses tall form hoon if :allow-tall-form is %.y
::
++ wide-or-tall
|* [wide=rule tall=rule]
?. allow-tall-form wide
;~(pose wide tall)
:: +hoon: parses hoon as an argument to a crane
::
++ hoon
%+ wide-or-tall
(ifix [lac rac] (stag %cltr (most ace wide:hoon-parser)))
;~(pfix gap tall:hoon-parser)
--
:: +static-path: parses a path
::
++ static-path
(sear plex (stag %clsg (more net hasp))):hoon-parser
:: +late-bound-path: a path whose time varies
::
++ late-bound-path
;~ pfix net
%+ cook |=(a=truss a)
=> hoon-parser
;~ plug
(stag ~ gash)
;~(pose (stag ~ ;~(pfix cen porc)) (easy ~))
;~ pose
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net lus gap)
(most ;~(plug com gaw) taut-rule)
==
gap
==
(easy ~)
==
::
;~ pose
;~ sfix
%+ cook |=((list [face=term =path]) +<)
%+ more gap
;~ pfix ;~(plug net tis gap)
%+ cook |=([term path] +<)
;~(plug sym ;~(pfix ;~(plug gap net) (more net urs:ab)))
==
gap
==
(easy ~)
==
::
;~ pose
;~ sfix
%+ cook |=((list [face=term =mark =path]) +<)
%+ more gap
;~ pfix ;~(plug net tar gap)
%+ cook |=([term mark path] +<)
;~ plug
sym
;~(pfix ;~(plug gap cen) sym)
;~(pfix ;~(plug gap net) (more net urs:ab))
==
==
gap
==
(easy ~)
==
::
%+ cook |=(huz=(list hoon) `hoon`tssg+huz)
(most gap tall:(vang & pax))
==
--
==
::
++ taut-rule
%+ cook |=(taut +<)
;~ pose
(stag ~ ;~(pfix tar sym))
;~(plug (stag ~ sym) ;~(pfix tis sym))
(cook |=(a=term [`a a]) sym)
==
--

11
pkg/arvo/lib/link.hoon → pkg/arvo/lib/link-store.hoon
View File

@ -1,7 +1,10 @@
:: link: social bookmarking
::
/- *link
/- sur=link-store, *link
::
^?
=< [. sur]
=, sur
|%
++ site-from-url
|= =url
@ -92,8 +95,9 @@
[a b]
--
::
++ en-json
++ enjs
=, enjs:format
^?
|%
++ update
|= upd=^update
@ -166,8 +170,9 @@
==
--
::
++ de-json
++ dejs
=, dejs:format
^?
|%
:: +action: json into action
::

29
pkg/arvo/lib/ph/io.hoon
View File

@ -46,7 +46,11 @@
:: probably the best option because the thread can delay until it
:: gets a positive ack on the subscription.
::
;< ~ bind:m (sleep ~s0)
:: Threads might not get built until a %writ is dripped back to
:: spider. Drips are at +(now), so we sleep until two clicks in the
:: future.
::
;< ~ bind:m (sleep `@dr`2)
(pure:m ~)
::
++ end-test
@ -150,7 +154,7 @@
:: hit the first of these cases, and other ships will hit the
:: second.
::
?: ?| (f "clay: committed initial filesystem (all)")
?: ?| (f ":dojo>")
(f "is your neighbor")
==
(pure:m ~)
@ -212,13 +216,18 @@
|= [her=ship =desk extra=@t]
=/ m (strand ,@t)
^- form:m
(touch her desk /sur/aquarium/hoon extra)
::
:: Modify path on the given ship
::
++ touch
|= [her=ship =desk pax=path extra=@t]
=/ m (strand ,@t)
^- form:m
~& > "touching file on {<her>}/{<desk>}"
;< ~ bind:m (mount her desk)
;< our=@p bind:m get-our
;< now=@da bind:m get-time
=/ host-pax
/(scot %p our)/home/(scot %da now)/sur/aquarium/hoon
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[desk]/(scot %da now)
@ -229,7 +238,7 @@
%^ cat 3 '=> . '
%^ cat 3 extra
(need (scry-aqua:util (unit @) our now aqua-pax))
;< ~ bind:m (send-events (insert-file:util her desk host-pax warped))
;< ~ bind:m (send-events (insert-files:util her desk [pax warped] ~))
(pure:m warped)
::
:: Check /sur/aquarium/hoon on the given has the given contents.
@ -237,6 +246,13 @@
++ check-file-touched
|= [=ship =desk warped=@t]
=/ m (strand ,~)
(check-touched ship desk /sur/aquarium/hoon warped)
::
:: Check path on the given desk has the given contents.
::
++ check-touched
|= [=ship =desk pax=path warped=@t]
=/ m (strand ,~)
~& > "checking file touched on {<ship>}/{<desk>}"
;< ~ bind:m (mount ship desk)
^- form:m
@ -250,7 +266,6 @@
::
?. &(=(ship her) ?=(?(%init %ergo %doze) -.q.unix-effect))
loop
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p ship)/cx/(scot %p ship)/[desk]/(scot %da now)

12
pkg/arvo/lib/ph/util.hoon
View File

@ -45,14 +45,16 @@
::
:: Inject a file into a ship
::
++ insert-file
|= [who=ship des=desk pax=path txt=@t]
++ insert-files
|= [who=ship des=desk files=(list [=path txt=@t])]
^- (list aqua-event)
?> ?=([@ @ @ *] pax)
=/ file [/text/plain (as-octs:mimes:html txt)]
=/ input
%+ turn files
|= [=path txt=@t]
[path ~ /text/plain (as-octs:mimes:html txt)]
%+ send-events-to who
:~
[//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~]
[//sync/0v1n.2m9vh %into des | input]
==
::
:: Checks whether the given event is a dojo output blit containing the

77
pkg/arvo/lib/pill.hoon
View File

@ -2,12 +2,12 @@
::
^?
|%
:: +module-ova: vane load operations.
::
:: sys: full path to /sys directory
::
+$ pill
[boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)]
$: boot-ova=*
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
==
::
+$ unix-event
%+ pair wire
@ -16,42 +16,24 @@
[%boot ? $%($>(%fake task:able:jael) $>(%dawn task:able:jael))]
unix-task
==
:: +module-ova: vane load operations
::
:: sys: full path to /sys directory
::
++ module-ova
|= sys=path
^- (list [wire [%veer term path cord]])
%+ turn
^- (list (pair term path))
:~ :: sys/zuse: standard library
::
[%$ /zuse]
:: sys/vane/ames: network
::
[%a /vane/ames]
:: sys/vane/behn: timer
::
[%b /vane/behn]
:: sys/vane/clay: revision control
::
[%c /vane/clay]
:: sys/vane/dill: console
::
[%d /vane/dill]
:: sys/vane/eyre: http server
::
[%e /vane/eyre]
:: sys/vane/ford: build
::
[%f /vane/ford]
:: sys/vane/gall: applications
::
[%g /vane/gall]
:: sys/vane/iris: http client
::
[%i /vane/iris]
:: sys/vane/kale: security
::
[%j /vane/jael]
:~ [%$ /zuse] :: standard library
[%a /vane/ames] :: network
[%b /vane/behn] :: timer
[%c /vane/clay] :: revision control
[%d /vane/dill] :: console
[%e /vane/eyre] :: http server
[%g /vane/gall] :: applications
[%i /vane/iris] :: http client
[%j /vane/jael] :: identity and security
==
|= [=term =path]
=/ pax (weld sys path)
@ -59,25 +41,22 @@
[[%vane path] [%veer term pax txt]]
:: +file-ovum: userspace filesystem load
::
:: bas: full path to / directory
:: bas: full path to / directory
::
++ file-ovum
=/ directories
`(list path)`~[/app /ted /gen /lib /mar /ren /sec /sur /sys /tests /web]
=/ directories=(list path)
:~ /app :: %gall applications
/gen :: :dojo generators
/lib :: libraries
/mar :: mark definitions
/sur :: structures
/sys :: system files
/ted :: :spider strands
/tests :: unit tests
/web :: %eyre web content
==
|= bas=path
^- unix-event
::
:: /app %gall applications
:: /gen :dojo generators
:: /lib %ford libraries
:: /mar %ford marks
:: /ren %ford renderers
:: /sec %eyre security drivers
:: /sur %ford structures
:: /sys system files
:: /tests unit tests
:: /web %eyre web content
::
%. directories
|= :: sal: all spurs to load from
::

45
pkg/arvo/lib/shoe.hoon
View File

@ -35,14 +35,20 @@
|* command-type=mold
$_ ^|
|_ bowl:gall
:: +command-parser: input parser for a specific session
::
:: if the head of the result is true, instantly run the command
::
++ command-parser
|~ sole-id=@ta
|~(nail *(like command-type))
|~(nail *(like [? command-type]))
:: +tab-list: autocomplete options for the session (to match +command-parser)
::
++ tab-list
|~ sole-id=@ta
:: (list [@t tank])
*(list (option:auto tank))
:: +on-command: called when a valid command is run
::
++ on-command
|~ [sole-id=@ta command=command-type]
@ -106,9 +112,11 @@
|* [shoe=* command-type=mold]
|_ =bowl:gall
++ command-parser
(easy *command-type)
|= sole-id=@ta
(easy *[? command-type])
::
++ tab-list
|= sole-id=@ta
~
::
++ on-command
@ -193,9 +201,9 @@
(~(gut by soles) sole-id *sole-share)
|^ =^ [cards=(list card) =_cli-state] shoe
?- -.dat.act
%det [(apply-edit +.dat.act) shoe]
%det (apply-edit +.dat.act)
%clr [[~ cli-state] shoe]
%ret run-command
%ret try-command
%tab [(tab +.dat.act) shoe]
==
:- (deal cards)
@ -208,15 +216,19 @@
::
++ apply-edit
|= =sole-change
^- (quip card _cli-state)
^+ [[*(list card) cli-state] shoe]
=^ inverse cli-state
(~(transceive sole cli-state) sole-change)
:: res: & for fully parsed, | for parsing failure at location
::
=/ res=(each (unit) @ud)
=/ res=(each (unit [run=? cmd=command-type]) @ud)
%+ rose (tufa buf.cli-state)
(command-parser:og sole-id)
?: ?=(%& -.res) [~ cli-state]
?: ?=(%& -.res)
?. &(?=(^ p.res) run.u.p.res)
[[~ cli-state] shoe]
(run-command cmd.u.p.res)
:_ shoe
:: parsing failed
::
?. &(?=(%del -.inverse) =(+(p.inverse) (lent buf.cli-state)))
@ -234,14 +246,18 @@
[%err p.res] :: cursor to error location
==
::
++ run-command
++ try-command
^+ [[*(list card) cli-state] shoe]
=/ cmd=(unit command-type)
=/ res=(unit [? cmd=command-type])
%+ rust (tufa buf.cli-state)
(command-parser:og sole-id)
?~ cmd
[[[(effect %bel ~)]~ cli-state] shoe]
=^ cards shoe (on-command:og sole-id u.cmd)
?^ res (run-command cmd.u.res)
[[[(effect %bel ~)]~ cli-state] shoe]
::
++ run-command
|= cmd=command-type
^+ [[*(list card) cli-state] shoe]
=^ cards shoe (on-command:og sole-id cmd)
:: clear buffer
::
=^ clear cli-state (~(transmit sole cli-state) [%set ~])
@ -251,7 +267,6 @@
[%det clear]
==
::
::NOTE cargo-culted
++ tab
|= pos=@ud
^- (quip card _cli-state)
@ -271,7 +286,9 @@
%+ add pos
(met 3 (fall forward ''))
=| cards=(list card)
=? cards ?=(^ options)
:: only render the option list if we couldn't complete anything
::
=? cards &(?=(~ to-send) ?=(^ options))
[(effect %tab options) cards]
|- ^- (quip card _cli-state)
?~ to-send

99
pkg/arvo/lib/strandio.hoon
View File

@ -26,6 +26,12 @@
|= tin=strand-input:strand
`[%done bowl.tin]
::
++ get-beak
=/ m (strand ,beak)
^- form:m
|= tin=strand-input:strand
`[%done [our q.byk da+now]:bowl.tin]
::
++ get-time
=/ m (strand ,@da)
^- form:m
@ -380,6 +386,93 @@
;< ~ bind:m (send-request (hiss-to-request:html hiss))
take-maybe-sigh
::
:: +build-fail: build the source file at the specified $beam
::
++ build-file
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %a case (flop spur))
?~ riot
(strand-fail %build-file >arg< ~)
?> =(%vase p.r.u.riot)
(pure:m !<(vase q.r.u.riot))
:: +build-mark: build a mark definition to a $dais
::
++ build-mark
|= [[=ship =desk =case] mak=mark]
=* arg +<
=/ m (strand ,dais:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak])
?~ riot
(strand-fail %build-mark >arg< ~)
?> =(%dais p.r.u.riot)
(pure:m !<(dais:clay q.r.u.riot))
:: +build-cast: build a mark conversion gate ($tube)
::
++ build-cast
|= [[=ship =desk =case] =mars:clay]
=* arg +<
=/ m (strand ,tube:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %c case /[a.mars]/[b.mars])
?~ riot
(strand-fail %build-cast >arg< ~)
?> =(%tube p.r.u.riot)
(pure:m !<(tube:clay q.r.u.riot))
::
:: Read from Clay
::
++ warp
|= [=ship =riff:clay]
=/ m (strand ,riot:clay)
;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
(take-writ /warp)
::
++ read-file
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,cage)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case (flop spur))
?~ riot
(strand-fail %read-file >arg< ~)
(pure:m r.u.riot)
::
++ check-for-file
|= [[=ship =desk =case:clay] =spur]
=/ m (strand ,?)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case (flop spur))
(pure:m ?=(^ riot))
::
++ list-tree
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,(list path))
;< =riot:clay bind:m (warp ship desk ~ %sing %t case (flop spur))
?~ riot
(strand-fail %list-tree >arg< ~)
(pure:m !<((list path) q.r.u.riot))
::
:: Take Clay read result
::
++ take-writ
|= =wire
=/ m (strand ,riot:clay)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign * ?(%b %c) %writ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
::
:: Queue on skip, try next on fail %ignore
::
++ main-loop
@ -487,6 +580,12 @@
;< ~ bind:m (flog-text i.wall)
loop(wall t.wall)
::
++ trace
|= =tang
=/ m (strand ,~)
^- form:m
(pure:m ((slog tang) ~))
::
++ app-message
|= [app=term =cord =tang]
=/ m (strand ,~)

267
pkg/arvo/lib/test/ford-external.hoon
View File

@ -1,267 +0,0 @@
/+ *test
=, ford
|%
:: +expect-schematic: assert a +schematic:ford is what we expect
::
:: Since Ford requests contain types, we can't do simple
:: equality checking. This function handles all the different
:: kinds of +schematic:ford, dealing with types as necessary.
::
++ expect-schematic
|= [expected=schematic actual=schematic]
^- tang
::
?^ -.expected
?. ?=(^ -.actual)
[%leaf "expected autocons, but got {<-.actual>}"]~
::
%+ weld
$(expected head.expected, actual head.actual)
$(expected tail.expected, actual tail.actual)
::
?- -.expected
%$
?. ?=(%$ -.actual)
[%leaf "expected %$, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(p.literal.expected) !>(p.literal.actual))
(expect-eq q.literal.expected q.literal.actual)
::
%pin
::
?. ?=(%pin -.actual)
[%leaf "expected %pin, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(date.expected) !>(date.actual))
$(expected schematic.expected, actual schematic.actual)
::
%alts
::
?. ?=(%alts -.actual)
[%leaf "expected %alts, but got {<-.actual>}"]~
::
|- ^- tang
?~ choices.expected
:: make sure there aren't any extra :choices in :actual
::
?~ choices.actual
~
[%leaf "actual had more choices than expected"]~
:: :expected isn't empty yet; make sure :actual isn't either
::
?~ choices.actual
[%leaf "expected had more choices than actual"]~
:: recurse on the first sub-schematic
::
%+ weld
^$(expected i.choices.expected, actual i.choices.actual)
$(choices.expected t.choices.expected, choices.actual t.choices.actual)
::
%bake
(expect-eq [schematic-type expected] [schematic-type actual])
::
%bunt
(expect-eq [schematic-type expected] [schematic-type actual])
::
%call
::
?. ?=(%call -.actual)
[%leaf "expected %call, but got {<-.actual>}"]~
::
%+ weld
$(expected gate.expected, actual gate.actual)
$(expected sample.expected, actual sample.actual)
::
%cast
::
?. ?=(%cast -.actual)
[%leaf "expected %cast, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
(expect-eq !>(mark.expected) !>(mark.actual))
$(expected input.expected, actual input.actual)
==
::
%core
(expect-eq [schematic-type expected] [schematic-type actual])
::
%diff
::
?. ?=(%diff -.actual)
[%leaf "expected %diff, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
$(expected start.expected, actual start.actual)
$(expected end.expected, actual end.actual)
==
::
%dude
::
?. ?=(%dude -.actual)
[%leaf "expected %dude, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(error.expected) !>(error.actual))
$(expected attempt.expected, actual attempt.actual)
::
%hood
(expect-eq [schematic-type expected] [schematic-type actual])
::
%join
::
?. ?=(%join -.actual)
[%leaf "expected %join, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
(expect-eq !>(mark.expected) !>(mark.actual))
$(expected first.expected, actual first.actual)
$(expected second.expected, actual second.actual)
==
::
%list
::
?. ?=(%list -.actual)
[%leaf "expected %list, but got {<-.actual>}"]~
::
|- ^- tang
?~ schematics.expected
:: make sure there aren't any extra :schematics in :actual
::
?~ schematics.actual
~
[%leaf "actual had more schematics than expected"]~
:: :expected isn't empty yet; make sure :actual isn't either
::
?~ schematics.actual
[%leaf "expected had more schematics than actual"]~
::
%+ weld
^$(expected i.schematics.expected, actual i.schematics.actual)
::
%_ $
schematics.expected t.schematics.expected
schematics.actual t.schematics.actual
==
::
%mash
::
?. ?=(%mash -.actual)
[%leaf "expected %mash, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
(expect-eq !>(mark.expected) !>(mark.actual))
(expect-eq !>(disc.first.expected) !>(disc.first.actual))
(expect-eq !>(mark.first.expected) !>(mark.first.actual))
(expect-eq !>(disc.second.expected) !>(disc.second.actual))
(expect-eq !>(mark.second.expected) !>(mark.second.actual))
$(expected schematic.first.expected, actual schematic.first.actual)
$(expected schematic.second.expected, actual schematic.second.actual)
==
::
%mute
::
?. ?=(%mute -.actual)
[%leaf "expected %mute, but got {<-.actual>}"]~
::
%+ weld $(expected subject.expected, actual subject.actual)
::
|- ^- tang
?~ mutations.expected
:: make sure there aren't any extra :mutations in :actual
::
?~ mutations.actual
~
[%leaf "actual had more mutations than expected"]~
:: :expected isn't empty yet; make sure :actual isn't either
::
?~ mutations.actual
[%leaf "expected had more mutations than actual"]~
::
;: weld
(expect-eq !>(p.i.mutations.expected) !>(p.i.mutations.actual))
^$(expected q.i.mutations.expected, actual q.i.mutations.actual)
%_ $
mutations.expected t.mutations.expected
mutations.actual t.mutations.actual
==
==
::
%pact
::
?. ?=(%pact -.actual)
[%leaf "expected %pact, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
$(expected start.expected, actual start.actual)
$(expected diff.expected, actual diff.actual)
==
::
%path
(expect-eq [schematic-type expected] [schematic-type actual])
::
%plan
(expect-eq [schematic-type expected] [schematic-type actual])
::
%reef
(expect-eq [schematic-type expected] [schematic-type actual])
::
%ride
::
?. ?=(%ride -.actual)
[%leaf "expected %ride, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(formula.expected) !>(formula.actual))
$(expected subject.expected, actual subject.actual)
::
%same
::
?. ?=(%same -.actual)
[%leaf "expected %same, but got {<-.actual>}"]~
::
$(expected schematic.expected, actual schematic.actual)
::
%scry
(expect-eq [schematic-type expected] [schematic-type actual])
::
%slim
::
?. ?=(%slim -.actual)
[%leaf "expected %slim, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(formula.expected) !>(formula.actual))
::
%+ expect-eq
!>(`?`%.y)
^- vase
:- -:!>(*?)
^- ?
(~(nest ut subject-type.expected) | subject-type.actual)
::
%slit
::
?. ?=(%slit -.actual)
[%leaf "expected %slit, but got {<-.actual>}"]~
::
%+ weld
(expect-eq gate.expected gate.actual)
(expect-eq sample.expected sample.actual)
::
?(%vale %volt)
(expect-eq [schematic-type expected] [schematic-type actual])
::
%walk
(expect-eq [schematic-type expected] [schematic-type actual])
==
:: +schematic-type: the +type for +schematic:ford
::
++ schematic-type ^~ `type`-:!>(*schematic:ford)
--

341
pkg/arvo/lib/test/ford.hoon
View File

@ -1,341 +0,0 @@
/+ *test
::
/= ford-vane /: /===/sys/vane/ford /!noun/
::
/= hoon-scry /: /===/sys/hoon /hoon/
/= arvo-scry /: /===/sys/arvo /hoon/
/= zuse-scry /: /===/sys/zuse /hoon/
/= txt-scry /: /===/mar/txt /hoon/
/= diff-scry /: /===/mar/txt-diff /hoon/
::
!:
=, ford
=, format
::
=/ test-pit=vase !>(..zuse)
=/ ford-gate (ford-vane test-pit)
::
|%
++ verify-post-made
|= $: move=move:ford-gate
=duct
=type
date=@da
title=@tas
contents=tape
==
^- tang
::
?> ?=([* %give %made @da %complete %success ^ *] move)
=/ result build-result.result.p.card.move
?> ?=([%success %scry %noun type-a=* @tas *] head.result)
?> ?=([%success ^ *] tail.result)
?> ?=([%success %ride type-title-a=* %post-a] head.tail.result)
?> ?=([%success %ride type-title-b=* %post-b] tail.tail.result)
::
;: welp
%+ expect-eq
!> duct
!> duct.move
::
%+ expect-eq
!> date
!> date.p.card.move
::
%+ expect-eq
!> [%success %scry %noun *^type [title=title contents=contents]]
!> head.result(p.q.cage *^type)
::
%+ expect-eq
!> &
!> (~(nest ut p.q.cage.head.result) | type)
::
%+ expect-eq
!> 'post-a'
vase.head.tail.result
::
%+ expect-eq
!> 'post-b'
vase.tail.tail.result
==
++ scry-with-results
|= results=(map [=term =beam] cage)
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-with-results+[term=term beam=beam]
::
[~ ~ (~(got by results) [term beam])]
:: +scry-with-results-and-failures
::
++ scry-with-results-and-failures
|= results=(map [=term =beam] (unit cage))
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-with-results+[term=term beam=beam]
::
[~ (~(got by results) [term beam])]
:: +scry-succeed: produces a scry function with a known request and answer
::
++ scry-succeed
|= [date=@da result=cage] ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-succeed+[beam+beam term+term]
?> =(term %cx)
?> =(beam [[~nul %desk %da date] /bar/foo])
::
[~ ~ result]
:: +scry-fail: produces a scry function with a known request and failed answer
::
++ scry-fail
|= date=@da ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-fail+[beam+beam term+term]
?> =(term %cx)
?> =(beam [[~nul %desk %da date] /bar/foo])
::
[~ ~]
:: +scry-block: produces a scry function with known request and blocked answer
::
++ scry-block
|= date=@da ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-block+[beam+beam term+term]
?> =(term %cx)
?> =(beam [[~nul %desk %da date] /bar/foo])
::
~
:: +scry-blocks: block on a file at multiple dates; does not include %reef
::
++ scry-blocks
|= dates=(set @da) ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
~| scry-block+[beam+beam term+term]
?> =(term %cx)
?> ?=([%da @da] r.beam)
?> (~(has in dates) p.r.beam)
::
~
:: +scry-is-forbidden: makes sure ford does not attempt to scry
::
++ scry-is-forbidden ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-is-forbidden+[beam+beam term+term]
!!
::
++ scry-reef
|= date=@da ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=- ?~ res=(~(get by -) [term beam])
~
`res
::
(with-reef date ~)
::
++ with-reef
|= [date=@da scry-results=(map [term beam] cage)]
^+ scry-results
%- ~(gas by scry-results)
:~ :- [%cx [[~nul %home %da date] /hoon/hoon/sys]]
[%hoon !>(hoon-scry)]
:- [%cx [[~nul %home %da date] /hoon/arvo/sys]]
[%hoon !>(arvo-scry)]
:- [%cx [[~nul %home %da date] /hoon/zuse/sys]]
[%hoon !>(zuse-scry)]
::
:- [%cw [[~nul %home %da date] /hoon/hoon/sys]]
[%cass !>([ud=1 da=date])]
==
::
++ with-reef-unit
|= [date=@da scry-results=(map [term beam] (unit cage))]
^+ scry-results
%- ~(gas by scry-results)
:~ :- [%cx [[~nul %home %da date] /hoon/hoon/sys]]
`[%noun !>(~)]
:- [%cx [[~nul %home %da date] /hoon/arvo/sys]]
`[%noun !>(~)]
:- [%cx [[~nul %home %da date] /hoon/zuse/sys]]
`[%noun !>(~)]
::
:- [%cw [[~nul %home %da date] /hoon/hoon/sys]]
`[%cass !>([ud=1 da=date])]
==
::
++ ford-call
|= $: ford-gate=_ford-gate
now=@da
scry=sley
call-args=[=duct type=* wrapped-task=(hobo task:able:ford-gate)]
expected-moves=(list move:ford-gate)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- call:ford [duct ~ type wrapped-task]:call-args
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
::
[output ford-gate]
::
++ ford-take
|= $: ford-gate=_ford-gate
now=@da
scry=sley
take-args=[=wire =duct wrapped-sign=(hypo sign:ford-gate)]
expected-moves=(list move:ford-gate)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- take:ford [wire duct ~ wrapped-sign]:take-args
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
::
[output ford-gate]
:: +ford-call-with-comparator
::
:: Sometimes we can't just do simple comparisons between the moves statements
:: and must instead specify a gate that performs the comparisons.
::
++ ford-call-with-comparator
|= $: ford-gate=_ford-gate
now=@da
scry=sley
call-args=[=duct type=* wrapped-task=(hobo task:able:ford-gate)]
move-comparator=$-((list move:ford-gate) tang)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- call:ford [duct ~ type wrapped-task]:call-args
::
=/ output=tang (move-comparator moves)
::
[output ford-gate]
:: +ford-take-with-comparator
::
++ ford-take-with-comparator
|= $: ford-gate=_ford-gate
now=@da
scry=sley
take-args=[=wire =duct wrapped-sign=(hypo sign:ford-gate)]
move-comparator=$-((list move:ford-gate) tang)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- take:ford [wire duct ~ wrapped-sign]:take-args
::
=/ output=tang (move-comparator moves)
::
[output ford-gate]
:: +expect-cage: assert that the actual cage has the right mark and vase
::
++ expect-cage
|= [mark=term expected=vase actual=cage]
%+ weld
%+ expect-eq
!> mark
!> p.actual
::
(expect-eq expected q.actual)
:: +expect-ford-empty: assert that ford's state is one empty ship
::
:: At the end of every test, we want to assert that we have cleaned up all
:: state.
::
++ expect-ford-empty
|= [ford-gate=_ford-gate ship=@p]
^- tang
::
=^ results1 ford-gate
%- ford-call :*
ford-gate
now=~1234.5.6
scry=scry-is-forbidden
call-args=[duct=~[/empty] type=~ [%keep 0 0]]
expected-moves=~
==
::
=/ ford *ford-gate
=/ state state.ax.+>+<.ford
::
=/ default-state *ford-state:ford
::
=. max-size.compiler-cache.state max-size.compiler-cache.default-state
=. max-size.queue.build-cache.state max-size.queue.build-cache.default-state
=. next-anchor-id.build-cache.state 0
::
%+ welp results1
::
?: =(default-state state)
~
::
=/ build-state=(list tank)
%- zing
%+ turn ~(tap by builds.state)
|= [build=build:ford build-status=build-status:ford]
:~ [%leaf (build-to-tape:ford build)]
[%leaf "requesters: {<requesters.build-status>}"]
[%leaf "clients: {<~(tap in ~(key by clients.build-status))>}"]
==
::
=/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]]
::
:~ [%leaf "failed to cleanup"]
[%leaf "builds.state:"]
[%rose braces build-state]
==
--

39
pkg/arvo/lib/test/runner.hoon
View File

@ -10,6 +10,45 @@
+$ test-func (trap tang)
--
|%
++ run-test
:: executes an individual test.
|= [pax=path test=test-func]
^- [ok=? =tang]
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| :- %| :: the stack is already flopped for output?
;: weld
p.run
`tang`[[%leaf (weld "CRASHED " name)] ~]
==
%& ?: =(~ p.run)
&+[[%leaf (weld "OK " name)] ~]
:: Create a welded list of all failures indented.
:- %|
%- flop
;: weld
`tang`[[%leaf (weld "FAILED " name)] ~]
::TODO indent
:: %+ turn p:run
:: |= {i/tape}
:: ^- tank
:: [%leaf (weld " " i)]
p.run
==
==
:: +filter-tests-by-prefix
::
++ filter-tests-by-prefix
|= [prefix=path tests=(list test)]
^+ tests
::
=/ prefix-length=@ud (lent prefix)
::
%+ skim tests
::
|= [=path *]
=(prefix (scag prefix-length path))
:: +resolve-test-paths: add test names to file paths to form full identifiers
::
++ resolve-test-paths

5
pkg/arvo/mar/acme/order.hoon
View File

@ -2,6 +2,11 @@
:::: /mar/acme/order/hoon
::
|_ a=(set (list @t))
++ grad %noun
++ grow
|%
++ noun a
--
++ grab
|%
++ noun (set (list @t))

5
pkg/arvo/mar/azimuth/update.hoon
View File

@ -1,6 +1,11 @@
::
|_ upd=update:azimuth
::
++ grad %noun
++ grow
|%
++ noun upd
--
++ grab :: convert from
|%
++ noun update:azimuth :: from %noun

5
pkg/arvo/mar/chat/action.hoon
View File

@ -1,5 +1,10 @@
/+ *chat-store
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action

5
pkg/arvo/mar/chat/hook-action.hoon
View File

@ -1,5 +1,10 @@
/+ *chat-hook
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action

2
pkg/arvo/mar/chat/hook-update.hoon
View File

@ -1,7 +1,9 @@
/+ *chat-hook
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs upd)
--
::

2
pkg/arvo/mar/chat/update.hoon
View File

@ -1,7 +1,9 @@
/+ *chat-store
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs upd)
--
::

5
pkg/arvo/mar/chat/view-action.hoon
View File

@ -1,5 +1,10 @@
/+ *chat-view
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action

5
pkg/arvo/mar/contact/action.hoon
View File

@ -1,5 +1,10 @@
/+ *contact-json
|_ act=contact-action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun contact-action

2
pkg/arvo/mar/contact/hook-update.hoon
View File

@ -1,7 +1,9 @@
/+ *contact-json
|_ upd=contact-hook-update
++ grad %noun
++ grow
|%
++ noun upd
++ json (hook-update-to-json upd)
--
::

2
pkg/arvo/mar/contact/initial.hoon
View File

@ -1,8 +1,10 @@
/+ *contact-json
|_ rolo=rolodex
::
++ grad %noun
++ grow
|%
++ noun +<.grow
++ json (rolodex-to-json rolo)
--
::

2
pkg/arvo/mar/contact/update.hoon
View File

@ -1,7 +1,9 @@
/+ *contact-json
|_ upd=contact-update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update-to-json upd)
--
::

5
pkg/arvo/mar/dill/belt.hoon
View File

@ -9,6 +9,11 @@
=, sole
|_ dill-belt:dill
::
++ grad %noun
++ grow
|%
++ noun +<.grow
--
++ grab :: convert from
|%
++ json

2
pkg/arvo/mar/dill/blit.hoon
View File

@ -6,6 +6,7 @@
=, sole
=, enjs:format
|_ dib/dill-blit:dill
++ grad %noun
::
++ grab :: convert from
|%
@ -13,6 +14,7 @@
--
++ grow
|%
++ noun dib
++ json
^- ^json
?+ -.dib ~|(unsupported-blit+-.dib !!)

5
pkg/arvo/mar/dns/address.hoon
View File

@ -1,5 +1,10 @@
/- *dns
|_ address
++ grad %noun
++ grow
|%
++ noun +<.grow
--
++ grab
|%
++ noun address

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