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

Merge branch 'new-stdlib' into unicode-string-gates

Browse Source
This commit is contained in:
Elliot Glaysher 2018-01-18 21:26:20 -08:00
commit 4edb2aa9c0
199 changed files with 17276 additions and 43216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
.travis.yml Normal file
View File

@ -0,0 +1,39 @@
language: node_js # ish, mainly used as an entry point
node_js:
- 4
before_install:
- cd .travis # keep main directory clear
- wget -i pin-urbit-release.url -O ./urbit.deb
- sudo apt install ./urbit.deb
before_script: bash get-or-build-pill.sh
# https://github.com/travis-ci/travis-ci/issues/2570
before_deploy: "[ -d piers ] || { mkdir piers && tar cvzSf piers/zod-$TRAVIS_COMMIT.tgz zod/; }"
deploy:
- skip_cleanup: true
provider: gcs
access_key_id: GOOGW5WD4W7RF3TQ5EBM
secret_access_key:
secure: cbMrx/jloYtTiMc9b+gujrpdzmB05yHC7C2PN1dqHoe25JqwS1c8ne0jhzYOanSkJptPEjwpKeEYLyF87CStCglMJaHwsx1wAm94D8Vh6WL96pgxFbMdVRD+g2dAcSXYnSX5C0QpFrnxY8ujg9yqhItpvd+whsPYjxZahIUd5rPPS1gCP2O6hGpKFCv5++DB1RgqL5y1Hlm9efsLxsnkS7cuzrSX6o8I6Yns5pFlDDRED7Tgpp5DYYfq6ZmiIpxbuYZK+AYJKK7N2zC4RfFXstgL+M9h7joFE1r8RlzrVHLXL7+3qg8POWEEu47008ORByDCmlt5VKoMBJ3q4J4ykDKI2qmx3jw68tGIu2o5uVf6KpxtAM2IJSNZ4mOEYjs7ieR1GOrLKr7lSSYEOIShJhx7J1MMjBOaS17Ho7Uc4iNLGpH4M7DpiKwVLnjfsYiasv/1xq71ed386wLTpI5YyY/SfsNPoIbgv1IjkKIMRLl5l85tEUK10h8dxQi3mXeaP698LnQLdHdxeBKJB08hwJrl7kIOJnqZxWPBp8i7OQeIvKcu+WzMg5UIR4hR7wj7NEga/+1jjjDQeo7EHQB2Tk9dhXtTmozOGpsW49H7+VBThhhNODEYeX3CIcdOtSyjuwBLZ45HsKIhhWA00b+YyE8boBkV1yQeFh/IYCZBn7s=
bucket: ci-piers.urbit.org
local-dir: piers/
acl: public-read
on:
repo: urbit/arvo
all_branches: true
#
- skip_cleanup: true
provider: gcs
access_key_id: GOOGW5WD4W7RF3TQ5EBM
secret_access_key:
secure: cbMrx/jloYtTiMc9b+gujrpdzmB05yHC7C2PN1dqHoe25JqwS1c8ne0jhzYOanSkJptPEjwpKeEYLyF87CStCglMJaHwsx1wAm94D8Vh6WL96pgxFbMdVRD+g2dAcSXYnSX5C0QpFrnxY8ujg9yqhItpvd+whsPYjxZahIUd5rPPS1gCP2O6hGpKFCv5++DB1RgqL5y1Hlm9efsLxsnkS7cuzrSX6o8I6Yns5pFlDDRED7Tgpp5DYYfq6ZmiIpxbuYZK+AYJKK7N2zC4RfFXstgL+M9h7joFE1r8RlzrVHLXL7+3qg8POWEEu47008ORByDCmlt5VKoMBJ3q4J4ykDKI2qmx3jw68tGIu2o5uVf6KpxtAM2IJSNZ4mOEYjs7ieR1GOrLKr7lSSYEOIShJhx7J1MMjBOaS17Ho7Uc4iNLGpH4M7DpiKwVLnjfsYiasv/1xq71ed386wLTpI5YyY/SfsNPoIbgv1IjkKIMRLl5l85tEUK10h8dxQi3mXeaP698LnQLdHdxeBKJB08hwJrl7kIOJnqZxWPBp8i7OQeIvKcu+WzMg5UIR4hR7wj7NEga/+1jjjDQeo7EHQB2Tk9dhXtTmozOGpsW49H7+VBThhhNODEYeX3CIcdOtSyjuwBLZ45HsKIhhWA00b+YyE8boBkV1yQeFh/IYCZBn7s=
bucket: bootstrap.urbit.org
local-dir: built-pill/
acl: public-read
on:
condition: -d built-pill/
repo: urbit/arvo
all_branches: true

1
.travis/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
node_modules/

79
.travis/get-or-build-pill.sh Normal file
View File

@ -0,0 +1,79 @@
#!/bin/bash
set -euo pipefail
# set -x
# XX use -s instead of hash pill
HASH=$(git -C .. log -1 HEAD --format=%H -- sys/)
export PILL_NAME="git-${HASH:0:10}"
if [ ! ${PILL_FORCE:-} ]; then
wget https://bootstrap.urbit.org/$PILL_NAME.pill -O urbit.pill && exit 0
fi
# if wget failed
if [ ${TRAVIS_COMMIT:-} ] && [ $TRAVIS_COMMIT != $HASH ]; then
echo Directory sys/ not modified in commit $TRAVIS_COMMIT
echo FIXME ignoring, as current sys/ commits are unlikely to contain the pill-build code
echo
# echo For auto-build please tag and push $HASH
# exit 1
fi
mkdir prev
{
echo Pilling: trying pinned fakezod
wget -i pin-parent-pill-pier.url -O - | tar xvz -C prev/ &&
echo Downloaded prev/zod
} || {
echo Pilling: Parent-pill pier not available, trying preceding pill commit
HASH2=$(git -C .. log -2 $HASH --format=%H -- sys/ | tail -1)
PILL_NAME2="git-${HASH2:0:10}"
wget https://bootstrap.urbit.org/$PILL_NAME2.pill -O urbit.pill &&
echo FIXME running test script to create fakezod, this might be overkill &&
lsc test.ls &&
mv urbit.pill prev/urbit.pill &&
mv zod prev/zod &&
export PIER_FRESH="y"
} || {
echo Pilling: Out of ideas
exit 1
}
lsc <<done
do
require! <[ stream-snitch once recursive-copy wait-on ]>
pty = require \pty.js
urbit = pty.spawn 'urbit' <[-FI zod prev/zod]>
.on \data -> process.stdout.write it
on-next = (re,cb)->
urbit.pipe (new stream-snitch re).on \match once cb
on-next /\n(\/~|ford: )/ ->
console.log "\n\n---\nnode: detected error\n---\n\n"
set-timeout (-> process.exit 1), 1000
<- on-next /dojo> /
{PILL_NAME} = process.env
do-pill = ->
urbit.write "|label %home %#PILL_NAME\r"
urbit.write ".urbit/pill +solid /==/#PILL_NAME/sys, =dub &\r"
<- wait-on resources: <[ prev/zod/.urb/put/urbit.pill ]>
urbit.write "\04"
process.exit 0
#
if process.env.PIER_FRESH then do-pill!
urbit.write "|autoload |\r"
urbit.write "|mount %\r"
<- wait-on resources: <[ prev/zod/home ]>
<- recursive-copy '../sys/' 'prev/zod/home/sys/' {+overwrite} .then
on-next /sync/ do-pill
done
cp prev/zod/.urb/put/urbit.pill urbit.pill
mkdir built-pill; cp urbit.pill built-pill/$PILL_NAME.pill
echo
echo Created $PILL_NAME.pill, to be uploaded if tests pass
echo

19
.travis/package.json Normal file
View File

@ -0,0 +1,19 @@
{
"name": "arvo-tests",
"version": "1.0.0",
"description": "Test harness for Urbit arvo distribution",
"main": "test.ls",
"scripts": {
"test": "lsc test.ls"
},
"author": "~fyr",
"license": "MIT",
"dependencies": {
"livescript": "^1.5.0",
"once": "^1.4.0",
"pty.js": "^0.3.1",
"recursive-copy": "^2.0.7",
"stream-snitch": "0.0.3",
"wait-on": "^2.0.2"
}
}

1
.travis/pin-parent-pill-pier.url Normal file
View File

@ -0,0 +1 @@
https://ci-piers.urbit.org/zod-ccaffc55e6cd2f244e6fd1710479c05e1019c167.tgz

1
.travis/pin-urbit-release.url Normal file
View File

@ -0,0 +1 @@
https://github.com/urbit/urbit/releases/download/v0.5.1/urbit_0.5-1_amd64.deb

32
.travis/test.ls Normal file
View File

@ -0,0 +1,32 @@
require! \stream-snitch
pty = require \pty.js
urbit =
# TODO abort on failure
pty.spawn 'urbit' <[-B urbit.pill -A .. -cFI zod zod]>
.on \data -> process.stdout.write it
urbit.on \exit (code)->
console.log "\nnode: urbit exited with code #code\n"
process.exit code
console.log "FIXME Running Ubuntu 14.04, which causes a libtinfo version info warning. Should update to 16.04.\n"
fin = no
urbit.pipe (new stream-snitch /dojo> /g).on \match ->
return if fin
fin := yes
console.log "\n\n---\nnode: got dojo!\n---\n\n"
set-timeout (-> process.exit 0), 1000 # should probably test further
urbit.pipe (new stream-snitch /\n(\/~|ford: )/g).on \match ->
return if fin
fin := yes
console.log "\n\n---\nnode: detected error\n---\n\n"
set-timeout (-> process.exit 1), 1000
set-timeout ...
-> console.log "\n\n---\nnode: timed out after 5 min\n---"
5*60000
process.on \exit -> urbit.write '\04' # send EOF to gracefully checkpoint

4
LICENSE.txt
View File

@ -1,6 +1,6 @@
The MIT License (MIT)
Copyright (c) 2015 Urbit
Copyright (c) 2017 Urbit
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
@ -18,4 +18,4 @@ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
SOFTWARE.

11
app/ask.hoon
View File

@ -2,12 +2,12 @@
:::: /hoon/ask/app
::
/? 310
/+ sole, womb, prey
/+ sole, hood-womb, prey
[. sole]
|%
++ card
$% {$diff $sole-effect sole-effect}
{$poke wire {ship $hood} $womb-invite {cord invite}:womb}
{$poke wire {ship $hood} $womb-invite ,=,(hood-womb {cord reference invite})}
==
++ invited ?($new $sent $ignored)
++ email @t
@ -81,7 +81,7 @@
::
++ poke-sole-action
|= act/sole-action
^- (quip {bone card} +>)
^- (quip {bone card} _+>)
=/ som (~(got by sos) ost.bow)
?- -.act
$clr `+>.$
@ -154,7 +154,8 @@
^- card
:^ %poke /invite/(scot %t ask) [(need wom) %hood]
:- %womb-invite
^- {cord invite}:womb
=, hood-womb
^- [cord reference invite]
=+ inv=(scot %uv (end 7 1 eny.bow))
[inv [ask 1 0 "You have been invited to Urbit: {(trip inv)}" ""]]
[inv ~ [ask 1 0 "You have been invited to Urbit: {(trip inv)}" ""]]
--

2
app/curl.hoon
View File

@ -2,6 +2,8 @@
:::: /hoon/curl/app
::
/? 310
/+ old-zuse
=, old-zuse
::
|_ {{^ ^ ost/@ ^} $~}
++ poke |*(a/{mark *} :_(+> [ost %hiss / `~ %wain a]~))

171
app/dojo.hoon
View File

@ -1,4 +1,4 @@
:: :: ::
:: :: ::
:::: /hoon/dojo/app :: ::::
:: :: ::
/? 309 :: arvo kelvin
@ -7,6 +7,7 @@
[. sole]
=, space:userlib
=, format
!:
:: :: ::
:::: :: ::::
:: :: ::
@ -20,7 +21,7 @@
$: say/sole-share :: command-line state
dir/beam :: active path
poy/(unit dojo-project) :: working
{lib/(list hoof:ford) sur/(list hoof:ford)} :: lib+sur
{lib/(list hoof:ford) sur/(list hoof:ford)} :: lib+sur
var/(map term cage) :: variable state
old/(set term) :: used TLVs
buf/tape :: multiline buffer
@ -40,7 +41,7 @@
r/purl:eyre
==
{$poke p/goal} :: poke app
{$show p/?($0 $1 $2 $3)} :: print val+span+twig
{$show p/?($0 $1 $2 $3)} :: print val+type+hoon
{$verb p/term} :: store variable
{$help p/(list term)} :: look up help
== ::
@ -52,9 +53,10 @@
$% {$ur p/(unit knot) q/purl:eyre} :: http GET request
{$ge p/dojo-model} :: generator
{$dv p/path} :: core from source
{$ex p/twig} :: hoon expression
{$ex p/hoon} :: hoon expression
{$sa p/mark} :: example mark value
{$as p/mark q/dojo-source} :: simple transmute
{$do p/twig q/dojo-source} :: gate apply
{$do p/hoon q/dojo-source} :: gate apply
{$tu p/(list dojo-source)} :: tuple
== ::
++ dojo-model :: data construction
@ -126,7 +128,7 @@
|= {gol/goal mod/dojo-model} ^- dojo-command
[[%poke gol] [0 [%ge mod(q.p [q.gol q.p.mod])]]]
::
++ dp-command-line ;~(sfix dp-command (just '\0a'))
++ dp-command-line ;~(sfix dp-command (star ace) (just '\0a'))
++ dp-variable :: %verb or %brev
|* {sym/rule src/rule}
%+ cook
@ -199,22 +201,22 @@
++ dp-hooves :: hoof list
:(stag 0 %ex %clsg (most ;~(plug com gaw) dp-hoof))
::
++ dp-hoof :: ++ford-hoof twig
++ dp-hoof :: ++ford-hoof hoon
;~ plug
:(stag %sand %f ;~(pose (cold %| tar) (easy %&)))
:(stag %sand %tas sym)
%- dp-twig-punt
%- dp-hoon-punt
;~ (glue fas)
;~(pfix fas (sear dp-case-twig nuck:so))
;~(pfix fas (sear dp-case-hoon nuck:so))
(stag %sand ;~(plug (cold %p sig) fed:ag))
==
==
::
++ dp-twig-punt :: twig of unit
++ dp-hoon-punt :: hoon of unit
|*(a/rule ;~(pose (stag [%bust %null] a) (easy [%bust %null])))
::
++ dp-case-twig
|= a/coin ^- (unit twig)
++ dp-case-hoon
|= a/coin ^- (unit hoon)
?. ?=({$~ case} a) ~
%+ some
[%rock %tas p.p.a]
@ -227,7 +229,7 @@
;~(plug (cold %ur lus) dp-iden-url)
;~(plug (cold %ge lus) dp-model)
;~(plug (cold %as pam) sym ;~(pfix ace dp-source))
;~(plug (cold %do cab) dp-twig ;~(pfix ace dp-source))
;~(plug (cold %do cab) dp-hoon ;~(pfix ace dp-source))
dp-value
==
::
@ -254,8 +256,8 @@
++ dp-model ;~(plug dp-server dp-config) :: ++dojo-model
++ dp-path (en-beam he-beam) :: ++path
++ dp-server (stag 0 (most fas sym)) :: ++dojo-server
++ dp-twig tall:(vang | dp-path) :: ++twig
++ dp-rood :: 'dir' twig
++ dp-hoon tall:(vang | dp-path) :: ++hoon
++ dp-rood :: 'dir' hoon
=> (vang | (en-beam dir))
;~ pose
rood
@ -269,7 +271,8 @@
==
++ dp-value :: ++dojo-source
;~ pose
(stag %ex dp-twig)
(stag %sa ;~(pfix tar pam sym))
(stag %ex dp-hoon)
(stag %tu (ifix [sel ser] (most ace dp-source)))
==
::
@ -360,6 +363,7 @@
?- -.bul
$ex [bul +>.$]
$dv [bul +>.$]
$sa [bul +>.$]
$as =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
$do =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
$ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$])
@ -532,7 +536,7 @@
?- p.p.mad
$0 ~
$1 [[%rose [~ " " ~] (skol p.q.cay) ~] (mar)]
$2 [[%rose [~ " " ~] (dy-show-span-noun p.q.cay) ~] (mar)]
$2 [[%rose [~ " " ~] (dy-show-type-noun p.q.cay) ~] (mar)]
==
==
::
@ -554,17 +558,17 @@
==
::
++ dy-inspect
|= {topic/(list term) sut/span}
|= {topic/(list term) sut/type}
%+ dy-rash %tan
|^ ^- tang
=+ to-display=(find-item-in-span (flop topic) sut)
=+ to-display=(find-item-in-type (flop topic) sut)
?~ to-display
[%leaf "Could not find help"]~
(flop (print-item u.to-display))
:> # %models
+|
::
:> an overview of all named things in the span.
:> an overview of all named things in the type.
:>
:> each item in the overview list is either a documentation for a sublist
:> or an association between a term and documentation for it.
@ -578,15 +582,15 @@
{$item name/tape doc/what}
==
::
:> the part of a {span} being inspected.
:> the part of a {type} being inspected.
++ item
$% :> overview of span
$% :> overview of type
{$view items/overview}
:> inspecting a full core.
$: $core
name/tape
docs/what
sut/span
sut/type
con/coil
children/(unit item)
==
@ -595,13 +599,13 @@
name/tape
docs/what
f/foot
sut/span
sut/type
==
:> inspecting a single chapter on a core.
$: $chapter
name/tape
docs/what
sut/span
sut/type
con/coil
chapter-id/@
==
@ -619,11 +623,11 @@
+|
:> returns the item to print while searching through {topic}.
:>
:> this gate is called recursively to find the path {topic} in the span
:> {sut}. once it finds the correct part of the span, it switches to
:> ++build-inspectable-recursively to describe that part of the span.
++ find-item-in-span
|= {topics/(list term) sut/span}
:> this gate is called recursively to find the path {topic} in the type
:> {sut}. once it finds the correct part of the type, it switches to
:> ++build-inspectable-recursively to describe that part of the type.
++ find-item-in-type
|= {topics/(list term) sut/type}
^- (unit item)
?~ topics
:: we have no more search path. return the rest as an overview
@ -667,7 +671,7 @@
?: !=(i.t.topics u.p.p.q.i.tombs)
:: this isn't the topic.
$(tombs t.tombs)
`[%chapter (trip i.t.topics) q.p.q.i.tombs p.sut q.sut p.i.tombs]
`[%chapter (trip i.t.topics) q.p.q.i.tombs sut q.sut p.i.tombs]
::
{$face *}
?. ?=(term q.p.sut)
@ -678,31 +682,31 @@
~
?~ t.topics
`[%face (trip q.p.sut) p.p.sut (build-inspectable-recursively q.sut)]
(find-item-in-span t.topics q.sut)
(find-item-in-type t.topics q.sut)
::
{$fork *}
=/ spans/(list span) ~(tap in p.sut)
=/ types/(list type) ~(tap in p.sut)
|-
?~ spans
?~ types
~
=+ res=(find-item-in-span topics i.spans)
=+ res=(find-item-in-type topics i.types)
?~ res
$(spans t.spans)
$(types t.types)
res
::
{$help *}
:: while we found a raw help, it's associated on the wrong side of a
:: set of topics. Walk through it instead of showing it.
(find-item-in-span t.topics q.sut)
(find-item-in-type t.topics q.sut)
::
{$hold *} $(sut (~(play ut p.sut) q.sut))
$noun ~
$void ~
==
::
:> changes a {span} into an {item}.
:> changes a {type} into an {item}.
++ build-inspectable-recursively
|= sut/span
|= sut/type
^- (unit item)
?- sut
::
@ -726,13 +730,14 @@
`[%face (trip q.p.sut) p.p.sut compiled-against]
::
{$fork *}
=* spans ~(tap in p.sut)
=* items (turn spans build-inspectable-recursively)
=* types ~(tap in p.sut)
=* items (turn types build-inspectable-recursively)
(roll items join-items)
::
{$help *}
=* rest-span (build-inspectable-recursively q.sut)
`[%view [%header p.sut (item-as-overview rest-span)]~]
=* rest-type (build-inspectable-recursively q.sut)
?> ?=($docs -.p.sut)
`[%view [%header `+.p.sut (item-as-overview rest-type)]~]
::
{$hold *} $(sut (~(play ut p.sut) q.sut))
$noun ~
@ -778,7 +783,7 @@
::
:> translate the internals of a core's {tomb} into an {overview}.
++ arms-as-overview
|= {a/(map term (pair what foot)) sut/span}
|= {a/(map term (pair what foot)) sut/type}
^- overview
%+ turn ~(tap by a)
|= (pair term (pair what foot))
@ -803,7 +808,7 @@
:> returns an overview for arms which are part of unnamed chapters,
:> and an overview of the named chapters.
++ arm-and-chapter-overviews
|= {sut/span con/coil core-name/tape}
|= {sut/type con/coil core-name/tape}
^- {overview overview}
=| arm-docs/overview :< documented arms
=| chapter-docs/overview :< documented chapters
@ -826,7 +831,7 @@
::
:> returns an overview of the arms in a specific chapter.
++ arms-in-chapter
|= {sut/span con/coil chapter-id/@}
|= {sut/type con/coil chapter-id/@}
^- overview
=* chapter-tomb (~(got by q.s.con) chapter-id)
(sort-overview (arms-as-overview q.chapter-tomb sut))
@ -846,11 +851,11 @@
{$item *} name.ovr
==
::
++ what-from-span
|= sut/span
++ what-from-type
|= sut/type
?+ sut ~
{$core *} q.r.q.sut
{$help *} p.sut
{$help *} ?>(?=($docs -.p.sut) `+.p.sut)
{$hold *} $(sut (~(play ut p.sut) q.sut))
==
::
@ -872,7 +877,7 @@
::
:> renders the documentation for a full core.
++ print-core
|= {core-name/tape docs/what sut/span con/coil uit/(unit item)}
|= {core-name/tape docs/what sut/type con/coil uit/(unit item)}
^- tang
=+ [arms chapters]=(arm-and-chapter-overviews sut con core-name)
;: weld
@ -898,21 +903,23 @@
:> figures out which {what}s to use.
:>
:> there are three places with a relevant {what}: the {arm-doc} on the
:> arm, the {what} in the computed span of the foot, and the {what} on
:> the product of the default arm when the computed span is a core.
:> arm, the {what} in the computed type of the foot, and the {what} on
:> the product of the default arm when the computed type is a core.
++ select-arm-docs
|= {arm-doc/what f/foot sut/span}
|= {arm-doc/what f/foot sut/type}
:> the computed arm documentation and the product documentation.
^- {what what}
=+ foot-span=(~(play ut sut) p.f)
=+ raw-product=(what-from-span foot-span)
=+ foot-type=(~(play ut sut) p.f)
=/ raw-product/what (what-from-type foot-type)
=/ product-product/what
?. ?=({$core *} foot-span)
?. ?=({$core *} foot-type)
~
=* inner-span (~(play ut foot-span) [%limb %$])
(what-from-span inner-span)
=* inner-type (~(play ut foot-type) [%limb %$])
(what-from-type inner-type)
:-
?~ arm-doc
?~ raw-product
product-product
raw-product
arm-doc
?~ arm-doc
@ -921,7 +928,7 @@
::
:> renders the documentation for a single arm in a core.
++ print-arm
|= {arm-name/tape arm-doc/what f/foot sut/span}
|= {arm-name/tape arm-doc/what f/foot sut/type}
:: todo: need to get the sample here. also hoist this to the general
:: core printing machinery, too.
=+ [main-doc product-doc]=(select-arm-docs arm-doc f sut)
@ -935,7 +942,7 @@
::
:> renders the documentation for a chapter in a core.
++ print-chapter
|= {name/tape doc/what sut/span con/coil chapter-id/@}
|= {name/tape doc/what sut/type con/coil chapter-id/@}
;: weld
(print-header name doc)
::
@ -1110,15 +1117,15 @@
$(ret l, c t.c)
$(c t.c)
::
++ dy-show-span-noun
|= a/span ^- tank
++ dy-show-type-noun
|= a/type ^- tank
=- >[-]<
|- ^- $? $% {$atom @tas (unit @)}
{$cell _$ _$}
{$cube * _$}
{$face {what $@(term tune)} _$}
{$fork (set _$)}
{$hold _$ twig}
{$hold _$ hoon}
==
wain :: "<|core|>"
$?($noun $void)
@ -1126,19 +1133,20 @@
?+ a a
{?($cube $face) ^} a(q $(a q.a))
{$cell ^} a(p $(a p.a), q $(a q.a))
{$fork *} a(p (silt (turn ~(tap in p.a) |=(b/span ^$(a b)))))
{$fork *} a(p (silt (turn ~(tap in p.a) |=(b/type ^$(a b)))))
{$help *} !!
{$core ^} `wain`/core
{$hold *} a(p $(a p.a))
==
::
++ dy-shown
$? twig
$? hoon
$^ {dy-shown dy-shown}
$% {$ur (unit knot) purl:eyre}
{$dv path}
{$sa mark}
{$as mark dy-shown}
{$do twig dy-shown}
{$do hoon dy-shown}
{$ge path (list dy-shown) (map term (unit dy-shown))}
==
==
@ -1149,9 +1157,9 @@
=+ `{@ bil/dojo-build}`a
|- ^- dy-shown
?- -.bil
$?($ur $dv) bil
$?($ur $dv $sa) bil
$ex ?. ?=({$cltr *} p.bil) p.bil
|- ^- twig
|- ^- hoon
?~ p.p.bil !!
?~ t.p.p.bil i.p.p.bil
[i.p.p.bil $(p.p.bil t.p.p.bil)]
@ -1175,7 +1183,7 @@
(dy-diff %mor [%det lic] [%bel ~] ~)
(dy-slam(per `dat) /edit u.pro !>((tufa buf.say)))
::
++ dy-span :: sole action
++ dy-type :: sole action
|= act/sole-action
?- -.act
$det (dy-edit +.act)
@ -1225,7 +1233,7 @@
%- dy-silk-vase
?~(b !>([~ ~]) (dy-vase p.u.b))
::
++ dy-twig-head :: dynamic state
++ dy-hoon-head :: dynamic state
:: todo: how do i separate the toplevel 'dojo state' comment?
:> dojo state
:>
@ -1281,7 +1289,7 @@
(dy-meal (slot 7 vax))
::
$|
=> .(vax (slap vax !,(*twig ?>(?=($| -) .)))) :: XX working spec #72
=> .(vax (slap vax !,(*hoon ?>(?=($| -) .)))) :: XX working spec #72
=+ typ={$| (unit knot) hiss:eyre *}
=+ [~ usr hiz ~]=((dy-cast typ !>(*typ)) vax)
=. ..dy (he-diff %tan leaf+"< {(en-purl:html p.hiz)}" ~)
@ -1315,6 +1323,7 @@
$ge (dy-silk-config (dy-cage p.p.p.bil) q.p.bil)
$dv [/hand [%core he-beak (flop p.bil)]]
$ex [/hand (dy-mare p.bil)]
$sa [/hand [%bunt p.bil]]
$as [/hand [%cast p.bil [%$ (dy-cage p.q.bil)]]]
$do [/hand [%call (dy-mare p.bil) [%$ (dy-cage p.q.bil)]]]
$tu :- /hand
@ -1327,14 +1336,14 @@
(slop hed $(p.bil t.p.bil))
==
::
++ dy-twig-mark :: XX architect
++ dy-hoon-mark :: XX architect
=+ ^= ope
|= gen/twig ^- twig
|= gen/hoon ^- hoon
?: ?=(?($sggl $sggr) -.gen)
$(gen q.gen)
=+ ~(open ap gen)
?.(=(gen -) $(gen -) gen)
|= gen/twig ^- (unit mark)
|= gen/hoon ^- (unit mark)
=. gen (ope gen)
?: ?=({$cnts {@ $~} $~} gen)
(bind (~(get by var) i.p.gen) head)
@ -1355,12 +1364,12 @@
==
::
++ dy-mare :: build expression
|= gen/twig
|= gen/hoon
^- silk:ford
=+ too=(dy-twig-mark gen)
=+ too=(dy-hoon-mark gen)
=- ?~(too - [%cast u.too -])
:+ %ride gen
:- [%$ dy-twig-head]
:- [%$ dy-hoon-head]
[%plan he-beam blob+** [zuse sur lib ~ ~]]
::
++ dy-step :: advance project
@ -1568,11 +1577,11 @@
==
==
::
++ he-span :: apply input
++ he-type :: apply input
|= act/sole-action
^+ +>
?^ poy
he-pine:(~(dy-span dy u.poy) act)
he-pine:(~(dy-type dy u.poy) act)
?- -.act
$det (he-stir +.act)
$ret (he-done (tufa buf.say))
@ -1698,7 +1707,7 @@
|= {moz/(list move) ses/session}
=> ~(. he moz ses)
=- [wrap=- +]
|* he-arm/_he-span
|* he-arm/_he-type
|= _+<.he-arm
^- (quip move _..he)
he-abet:(he-arm +<)
@ -1715,7 +1724,7 @@
::
++ poke-sole-action
|= act/sole-action ~| poke+act %. act
(wrap he-span):arm
(wrap he-type):arm
::
++ poke-lens-command
|= com/command:lens ~| poke-lens+com %. com

91
app/fora.hoon Normal file
View File

@ -0,0 +1,91 @@
::
:: /app/fora/hoon
::
::TODO maybe stop relying on %hood one day.
::
/- hall
/+ hall, time-to-id
=, format
=, title
::
|%
++ move (pair bone card)
++ card
$% {$poke wire dock poke}
{$exec wire @p $~ {beak silk:ford}}
{$info wire @p toro:clay}
==
++ poke
$% {$hall-action action:hall}
{$write-fora-post spur ship cord cord}
{$write-comment spur ship cord}
==
--
::
|_ {bol/bowl:gall $~}
::
++ prep
|= old/(unit $~)
^- (quip move _..prep)
?^ old [~ ..prep(+<+ u.old)]
:_ ..prep
:~ (act %create %fora-posts 'fora posts' %journal)
(act %create %fora-comments 'fora comments' %journal)
==
::
++ act
|= a/action:hall
^- move
[ost.bol %poke / [our.bol %hall] %hall-action a]
::
++ ra-base-hart .^(hart:eyre %e /(scot %p our.bol)/host/(scot %da now.bol))
::
++ poke-fora-post
|= {pax/path sup/spur hed/@t txt/@t}
^- (quip move _+>)
:_ +>
:~ %- act
:+ %phrase [[our.bol %fora-posts] ~ ~]
:_ ~
:+ %app dap.bol
:+ %fat
:+ %name
(crip "post by {(cite src.bol)}: {(trip hed)}")
text+(to-wain txt)
=. pax (welp pax /posts/(crip "{<now.bol>}~"))
[%url [ra-base-hart `pax ~] ~]
::
:* ost.bol
%poke
/fora-post
[our.bol %hood]
[%write-fora-post sup src.bol hed txt]
==
==
::
++ poke-fora-comment
|= {pax/path sup/spur txt/@t}
^- (quip move _+>)
:_ +>
:~ ^- move
%- act
:+ %phrase [[our.bol %fora-comments] ~ ~]
:_ ~
:+ %app dap.bol
^- speech:hall
:+ %fat
:+ %name
=+ nam=?~(sup "" (trip i.sup))
(crip "comment by {(cite src.bol)} on /{nam}")
text+(to-wain txt)
=+ fra=(crip (time-to-id now.bol))
[%url [ra-base-hart `pax ~] `fra]
::
:* ost.bol
%poke
/fora-comment
[our.bol %hood]
[%write-comment sup src.bol txt]
==
==
--

11
app/gh.hoon
View File

@ -19,6 +19,7 @@
::
::
=, html
=, eyre
=> |%
++ move (pair bone card)
++ card
@ -175,7 +176,7 @@
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care *} pax)
?> ?=({care:clay *} pax)
:_ +>.$ :_ ~
(read:connector ost.hid (places %read pax) i.pax t.pax)
::
@ -185,7 +186,7 @@
++ sigh-httr
|= {way/wire res/httr}
^- {(list move) _+>.$}
?. ?=({$read care @ *} way)
?. ?=({$read care:clay @ *} way)
~& res=res
[~ +>.$]
=* style i.way
@ -278,14 +279,14 @@
:* %+ scan
=+ [(trip i.pax) (trip i.t.pax)]
"https://api.github.com/repos/{-<}/{->}/hooks"
auri:urlp
auri:de-purl
%post ~ ~
%- as-octt %- en-json %- pairs:enjs :~
%- as-octt:mimes %- en-json %- pairs:enjs:format :~
name+s+%web
active+b+&
events+a+~[s+event] ::(turn `(list ,@t)`t.t.pax |=(a=@t s/a))
:- %config
%- jobe :~
%- pairs:enjs:format :~
=+ =+ clean-event
"http://107.170.195.5:8443/~/to/gh/gh-{-}.json?anon&wire=/"
[%url s+(crip -)]

74
app/gmail.hoon
View File

@ -41,17 +41,20 @@
==
++ card
$% {$diff subscription-result}
{$hiss wire {$~ $~} $httr {$hiss hiss}}
{$hiss wire {$~ $~} $httr {$hiss hiss:eyre}}
==
++ easy-ot |*({key/@t parser/fist:jo} =+(jo (ot [key parser] ~)))
++ easy-ot
=, dejs-soft:format
|* {key/@t parser/fist}
(ot [key parser] ~)
++ sifo-google
|= a/cord ^- cord
=; fel (crip (scan (sifo a) fel))
(star ;~(pose (cold '-' (just '+')) (cold '_' (just '/')) next))
|= a/cord ^- cord
=; fel (crip (scan (en-base64 a) fel))
(star ;~(pose (cold '-' (just '+')) (cold '_' (just '/')) next))
++ ofis-google
|= a/cord ^- cord
=; fel (ofis (crip (rash a fel)))
(star ;~(pose (cold '+' (just '-')) (cold '/' (just '_')) next))
|= a/cord ^- cord
=; fel (de-base64 (crip (rash a fel)))
(star ;~(pose (cold '+' (just '-')) (cold '/' (just '_')) next))
--
::
=, gall
@ -73,7 +76,7 @@
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care ^} pax) :: assert %u
?> ?=({care:clay ^} pax) :: assert %u
=> (help i.pax i.t.pax t.t.pax)
=> scry
%= make-move
@ -93,11 +96,11 @@
[;~((glue pat) . .)]:(cook crip (plus ;~(less pat next))) :: /[^@]+@[^@]+/
::
(crip tyl)
(of-wain (turn mez crip))
(of-wain:format (turn mez crip))
==
::
++ poke-gmail-req
|= $: method/meth endpoint/path quy/quay
|= $: method/meth:eyre endpoint/path quy/quay:eyre
mes/message:rfc
:: label-req:gmail-label
==
@ -107,13 +110,14 @@
:_ +>.$ :_ ~
^- move
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
^- purl
^- purl:eyre
:+ [& ~ [%& /com/googleapis/www]]
[~ gmail+v1+users+me+`valid-get-endpoint`endpoint]
`quay`[[%alt %json] ~]
`quay:eyre`[[%alt %json] ~]
::
:+ method `math`(malt ~[content-type+['application/json']~])
=+ hoon-json-object=(joba %raw s+(sifo-google (message-to-rfc822:rfc mes)))
:+ method `math:eyre`(malt ~[content-type+['application/json']~])
=/ hoon-json-object
(frond:enjs:format %raw s+(sifo-google (message-to-rfc822:rfc mes)))
=+ request-body=(as-octt (en-json hoon-json-object))
(some request-body)
::(some (en-json label-req-to-json:gmail-label label-req:gmail-label ~)) XX
@ -124,10 +128,10 @@
::
++ sigh-httr
|= {wir/wire res/httr}
|= {wir/wire res/httr:eyre}
^- {(list move) _+>.$}
:: ~& wir+wir
?. ?=({care @ @ @ *} wir)
?. ?=({care:clay @ @ @ *} wir)
:: pokes don't return anything
~& sigh-poke+p.res
[~ +>.$]
@ -137,13 +141,14 @@
:+ ost.hid %diff
?+ i.wir null+~
$x
=, enjs:format
?~ r.res
json+(jobe err+s+%empty-response code+(jone p.res) ~)
json+(pairs err+s+%empty-response code+(numb p.res) ~)
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
json+(jobe err+s+%bad-json code+(jone p.res) body+s+q.u.r.res ~)
json+(pairs err+s+%bad-json code+(numb p.res) body+s+q.u.r.res ~)
?. =(2 (div p.res 100))
json+(jobe err+s+%request-rejected code+(jone p.res) msg+u.jon ~)
json+(pairs err+s+%request-rejected code+(numb p.res) msg+u.jon ~)
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
@ -153,7 +158,8 @@
=+ switch=t.t.t.t.wir
?+ switch [%json `json`u.jon]
{$messages $~}
=+ new-mezes=((ot messages+(ar (ot id+so 'threadId'^so ~)) ~):jo u.jon)
=/ new-mezes
((ot messages+(ar (ot id+so 'threadId'^so ~)) ~):dejs-soft:format u.jon)
::%+ turn new-mezes
::|= id
::?< ?=($~ new-mezes)
@ -173,7 +179,7 @@
~| u.jon
=- (need (reparse u.jon))
^= reparse
=+ jo
=, dejs-soft:format
=+ ^= from-and-subject
|= a/(map @t @t) ^- {@t @t}
[(~(got by a) 'From') (~(got by a) 'Subject')]
@ -193,30 +199,30 @@
::=+ body==+(jo ((ot body+(easy-ot 'body' (easy-ot 'data' so))) parsed-message))
[%message headers]
==
=+ dir=((om:jo some) u.jon)
?~ dir json+(jobe err+s+%no-children ~)
::
=+ dir=((om:dejs-soft:format some) u.jon)
?~ dir json+(pairs:enjs:format err+s+%no-children ~)
=+ new-jon=(~(get by u.dir) i.arg)
`subscription-result`$(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
:: redo with next argument
::
$y
?~ r.res
~& [err+s+%empty-response code+(jone p.res)]
~& [err+s+%empty-response code+(numb:enjs:format p.res)]
arch+*arch
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
~& [err+s+%bad-json code+(jone p.res) body+s+q.u.r.res]
~& [err+s+%bad-json code+(numb:enjs:format p.res) body+s+q.u.r.res]
arch+*arch
?. =(2 (div p.res 100))
~& [err+s+%request-rejected code+(jone p.res) msg+u.jon]
~& [err+s+%request-rejected code+(numb:enjs:format p.res) msg+u.jon]
arch+*arch
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
::
|- ^- subscription-result
=+ dir=((om:jo some) u.jon)
=+ dir=((om:dejs-soft:format some) u.jon)
?~ dir
[%arch `(shax (jam u.jon)) ~]
?~ arg
@ -232,11 +238,11 @@
:_ +>.$ ~
::
++ help
|= {ren/care style/@tas pax/path}
|= {ren/care:clay style/@tas pax/path}
=^ query pax
=+ xap=(flop pax)
?~ xap [~ ~]
=+ query=(rush i.xap ;~(pfix wut yquy:urlp))
=+ query=(rush i.xap ;~(pfix wut yquy:de-purl))
?~ query [~ pax]
[u.query (flop t.xap)]
=^ arg pax ~|(pax [+ -]:(split pax))
@ -251,13 +257,13 @@
::
++ endpoint-to-purl
|= endpoint/path
^- purl
^- purl:eyre
%+ scan
"https://www.googleapis.com/gmail/v1/users/me{<`path`endpoint>}"
auri:urlp
auri:de-purl
:: Send an HTTP req
++ send-http
|= hiz/hiss
|= hiz/hiss:eyre
^+ +>
=+ wir=`wire`[ren (scot %ud count) (scot %uv (jam arg)) style pax]
=+ new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]

2864
app/hall.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

158
app/hood.hoon
View File

@ -2,55 +2,84 @@
:::: /hoon/hood/app :: ::
:: :: ::
/? 310 :: zuse version
/+ sole, talk, helm, kiln, drum, write, womb :: libraries
[. helm kiln drum]
/+ 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,
hood-womb
:: :: ::
:::: :: ::
:: :: ::
=> |% :: module boilerplate
++ hood-old ::
{?($0 $1) lac/(map @tas hood-part-old)} ::
++ hood-1 ::
|%
++ hood-module
:: each hood module follows this general shape
=> |%
+= part [%module %0 pith]
+= pith ~
::
+= move [bone card]
+= card $% [%fake _!!]
==
--
|= [bowl:gall own=part]
|_ moz=(list move)
++ abet [(flop moz) own]
--
--
:: :: ::
:::: :: :: state handling
:: :: ::
!:
=> |% ::
++ hood-old :: unified old-state
{?($0 $1) lac/(map @tas hood-part-old)} ::
++ hood-1 :: unified state
{$1 lac/(map @tas hood-part)} ::
++ hood-good ::
++ hood-good :: extract specific
|* hed/hood-head ::
|= paw/hood-part ::
?- hed ::
$drum ?>(?=($drum -.paw) `drum-part`paw) ::
$helm ?>(?=($helm -.paw) `helm-part`paw) ::
$kiln ?>(?=($kiln -.paw) `kiln-part`paw) ::
$womb ?>(?=($womb -.paw) `part:womb`paw) ::
$write ?>(?=($write -.paw) `part:write`paw) ::
== ::
++ hood-head _-:*hood-part ::
$drum ?>(?=($drum -.paw) `part:hood-drum`paw) ::
$helm ?>(?=($helm -.paw) `part:hood-helm`paw) ::
$kiln ?>(?=($kiln -.paw) `part:hood-kiln`paw) ::
$womb ?>(?=($womb -.paw) `part:hood-womb`paw) ::
$write ?>(?=($write -.paw) `part:hood-write`paw) ::
== :: module name
++ hood-head _-:*hood-part :: initialize state
++ hood-make ::
|* {our/@p hed/hood-head} ::
?- hed ::
$drum (drum-make our) ::
$helm *helm-part ::
$kiln *kiln-part ::
$womb *part:womb ::
$write *part:write ::
$drum (make:hood-drum our) ::
$helm *part:hood-helm ::
$kiln *part:hood-kiln ::
$womb *part:hood-womb ::
$write *part:hood-write ::
== ::
++ hood-part-old hood-part ::
++ hood-port ::
++ hood-part-old hood-part :: old state for ++prep
++ hood-port :: state transition
|= paw/hood-part-old ^- hood-part ::
paw ::
:: ::
++ hood-part ::
$% {$drum $2 drum-pith-2} ::
{$helm $0 helm-pith} ::
{$kiln $0 kiln-pith} ::
{$womb $1 pith:womb} ::
{$write $0 pith:write} ::
++ hood-part :: current module state
$% {$drum $2 pith-2:hood-drum} ::
{$helm $0 pith:hood-helm} ::
{$kiln $0 pith:hood-kiln} ::
{$womb $1 pith:hood-womb} ::
{$write $0 pith:hood-write} ::
== ::
-- ::
:: :: ::
:::: :: ::
:::: :: :: app proper
:: :: ::
=, gall
|_ $: hid/bowl :: system state
hood-1 :: server state
|_ $: hid/bowl :: gall environment
hood-1 :: module states
== ::
++ able :: find+make part
|* hed/hood-head
@ -60,44 +89,25 @@
::
++ ably :: save part
|* {(list) hood-part}
[(flop +<-) %_(+> lac (~(put by lac) +<+< `hood-part`+<+))]
[(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))]
:: :: ::
:::: :: ::
:::: :: :: generic handling
:: :: ::
++ prep
|= old/(unit hood-old) ^- (quip _!! _+>) ::
|= old/(unit hood-old) ^- (quip _!! _+>)
:- ~
?~ old +>
+>(lac (~(run by lac.u.old) hood-port))
::
++ coup-kiln-fancy (wrap take-coup-fancy):from-kiln
++ coup-kiln-spam ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-spam-lame u.saw]
[~ +>]
::
++ coup-kiln-reload ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-reload-lame u.saw]
[~ +>]
::
++ coup-kiln-overload ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-overload-lame u.saw]
[~ +>]
::
++ poke-hood-load
++ poke-hood-load :: recover lost brain
|= dat/hood-part
?> =(our src)
?> =(our.hid src.hid)
~& loaded+-.dat
[~ %_(+> lac (~(put by lac) -.dat dat))]
::
++ coup-drum-phat (wrap take-coup-phat):from-drum
++ coup-helm-hi (wrap coup-hi):from-helm
++ coup-helm-ask (wrap coup-ask):from-helm
++ diff-sole-effect-drum-phat (wrap diff-sole-effect-phat):from-drum
++ from-lib
|* _[%helm ..$ _abet]:(helm)
::
++ from-module :: create wrapper
|* _[%module ..$ _abet]:(hood-module)
=> .(+< [identity start finish]=+<)
=- [wrap=- *start] :: usage (wrap handle-arm):from-foo
|* handle/_finish
@ -105,12 +115,23 @@
=. +>.handle (start hid (able identity))
(ably (handle +<))
::
++ from-drum (from-lib %drum [..$ _se-abet]:(drum))
++ from-helm (from-lib %helm [..$ _abet]:(helm))
++ from-kiln (from-lib %kiln [..$ _abet]:(kiln))
++ from-womb (from-lib %womb [..$ _abet]:(womb))
++ from-write (from-lib %write [..$ _abet]:(write))
:: 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-womb (from-module %womb [..$ _abet]:(hood-womb))
++ from-write (from-module %write [..$ _abet]:(hood-write))
::
:: :: ::
:::: :: :: switchboard
:: :: ::
++ coup-drum-phat (wrap take-coup-phat):from-drum
++ coup-helm-hi (wrap coup-hi):from-helm
++ coup-helm-ask (wrap coup-ask):from-helm
++ coup-kiln-fancy (wrap take-coup-fancy):from-kiln
++ coup-kiln-reload (wrap take-coup-reload):from-kiln
++ coup-kiln-spam (wrap take-coup-spam):from-kiln
++ diff-sole-effect-drum-phat (wrap diff-sole-effect-phat):from-drum
++ init-helm |=({way/wire *} [~ +>])
++ made-write (wrap made):from-write
++ made-kiln (wrap take-made):from-kiln
@ -120,7 +141,7 @@
++ note-helm (wrap take-note):from-helm
++ onto-drum (wrap take-onto):from-drum
++ peer-drum (wrap peer):from-drum
++ peek-x-womb peek-x:(womb hid (able %womb))
++ peek-x-womb peek-x:(hood-womb hid (able %womb))
++ peer-scry-x-womb (wrap peer-scry-x):from-womb
++ poke-atom (wrap poke-atom):from-helm
++ poke-dill-belt (wrap poke-dill-belt):from-drum
@ -140,8 +161,11 @@
++ poke-helm-send-hi (wrap poke-send-hi):from-helm
++ poke-helm-send-ask (wrap poke-send-ask):from-helm
++ poke-helm-verb (wrap poke-verb):from-helm
++ poke-helm-nuke (wrap poke-nuke):from-helm
++ poke-helm-begin (wrap poke-begin):from-helm
++ poke-helm-spawn (wrap poke-spawn):from-helm
++ poke-helm-tlon-add-stream (wrap poke-tlon-add-stream):from-helm
++ poke-helm-tlon-init-web (wrap poke-tlon-init-web):from-helm
++ poke-hood-sync (wrap poke-sync):from-kiln
++ poke-hood-init-sync (wrap poke-init-sync):from-kiln
++ poke-kiln-commit (wrap poke-commit):from-kiln
@ -156,6 +180,7 @@
++ poke-kiln-sync (wrap poke-sync):from-kiln
++ poke-kiln-syncs (wrap poke-syncs):from-kiln
++ poke-kiln-start-autoload (wrap poke-start-autoload):from-kiln
++ poke-kiln-wipe-ford (wrap poke-wipe-ford):from-kiln
++ poke-kiln-autoload (wrap poke-autoload):from-kiln
++ poke-kiln-overload (wrap poke-overload):from-kiln
++ poke-kiln-unmount (wrap poke-unmount):from-kiln
@ -165,10 +190,15 @@
++ poke-womb-obey (wrap poke-obey):from-womb
++ poke-womb-bonus (wrap poke-bonus):from-womb
++ poke-womb-claim (wrap poke-claim):from-womb
++ poke-womb-do-ticket (wrap poke-do-ticket):from-womb
++ poke-womb-do-claim (wrap poke-do-claim):from-womb
++ poke-womb-rekey (wrap poke-rekey):from-womb
++ poke-womb-report (wrap poke-report):from-womb
++ poke-womb-manage (wrap poke-manage):from-womb
++ poke-womb-recycle (wrap poke-recycle):from-womb
++ poke-womb-manage-old-key (wrap poke-manage-old-key):from-womb
++ poke-womb-release (wrap poke-release):from-womb
++ poke-womb-release-ships (wrap poke-release-ships):from-womb
++ poke-womb-reinvite (wrap poke-reinvite):from-womb
++ poke-womb-replay-log (wrap poke-replay-log):from-womb
++ poke-write-sec-atom (wrap poke-sec-atom):from-write
@ -179,7 +209,7 @@
++ poke-write-plan-account (wrap poke-plan-account):from-write
++ poke-write-tree (wrap poke-tree):from-write
++ poke-write-wipe (wrap poke-wipe):from-write
++ poke-wyll (wrap poke-wyll):from-helm
++ poke-will (wrap poke-will):from-helm
++ quit-drum-phat (wrap quit-phat):from-drum
++ reap-drum-phat (wrap reap-phat):from-drum
++ woot-helm (wrap take-woot):from-helm

18
app/pipe.hoon
View File

@ -1,10 +1,10 @@
/+ talk
/+ hall
::
=> |%
++ move (pair bone card)
++ card
$% {$peel wire dock mark path}
{$poke wire dock $talk-command command:talk}
{$poke wire dock $hall-command command:hall}
==
--
::
@ -52,11 +52,11 @@
:_ ~
~& [%peeling app source station]
:* ost.hid %peel [%subscribe app station source]
[our.hid app] %talk-speeches source
[our.hid app] %hall-speeches source
==
::
++ diff-talk-speeches
|= {way/wire speeches/(list speech:talk)}
++ diff-hall-speeches
|= {way/wire speeches/(list speech:hall)}
^- {(list move) _+>.$}
?> ?=({$subscribe @ @ *} way)
=+ app=(slav %tas i.t.way)
@ -70,15 +70,15 @@
[~ +>.$]
:_ +>.$ :_ ~
:* ost.hid %poke [%relay app station source]
[our.hid %talk] %talk-command
[our.hid %hall] %hall-command
%publish
|- ^- (list thought:talk)
|- ^- (list thought:hall)
?~ speeches
~
:_ $(speeches t.speeches, eny.hid (shax (cat 3 %pipe eny.hid)))
:* `@uvH`(end (sub 'H' 'A') 1 eny.hid)
[[[%& our.hid station] *envelope:talk %pending] ~ ~]
now.hid *(set flavor:talk) i.speeches
[[[%& our.hid station] *envelope:hall %pending] ~ ~]
now.hid *(set flavor:hall) i.speeches
==
==
::

4301
app/talk.hoon
View File

File diff suppressed because it is too large Load Diff

2
app/time.hoon
View File

@ -2,6 +2,8 @@
:::: /hoon/time/app
::
/? 310
/+ old-zuse
=, old-zuse
|%
++ card {$wait wire @da}
--

42
app/twit.hoon
View File

@ -3,7 +3,7 @@
:::: /hoon/twit/app
::
/- plan-acct
/+ twitter, talk
/+ twitter, hall
::
:::: ~fyr
::
@ -29,7 +29,7 @@
$% {$quit $~} :: terminate
{$diff gilt} :: send data
==
++ gilt
++ gilt
$% {$twit-feed p/(list stat)} :: posts in feed
{$twit-post p/stat} :: tweet accepted
{$ares term (list tank)} :: error
@ -39,7 +39,7 @@
++ move {bone card}
++ card :: arvo request
$? gift
$% {$hiss wire (unit iden) api-call} :: api request
$% {$hiss wire (unit user:eyre) api-call} :: api request
{$poke wire app-message} ::
{$wait wire p/@da} :: timeout
== ==
@ -47,8 +47,8 @@
++ api-call {response-mark $twit-req {endpoint quay}} :: full hiss payload
++ response-mark ?($twit-post $twit-feed $twit-cred) :: sigh options
++ app-message
$? {{ship $talk} $talk-command command:talk} :: chat message
{{ship $hood} $write-plan-account iden plan-acct} :: registration
$? {{ship $hall} $hall-action action:hall} :: chat message
{{ship $hood} $write-plan-account user:eyre plan-acct} :: registration
== ::
++ sign :: arvo response
$% {$e $thou p/httr} :: HTTP result
@ -66,10 +66,10 @@
::
::::
::
|_ {bowl axle}
|_ {bowl:gall axle}
::
++ prep
|= a/(unit axle) ^- (quip move +>)
|= a/(unit axle) ^- (quip move _+>)
?^ a [~ +>(+<+ u.a)]
(peer-scry-x /cred)
::
@ -97,7 +97,7 @@
|= {pax/path mof/(list move)} ^+ done
=^ tym ran (dely pax)
:_ +>.$
?~ tym
?~ tym
:: ~& no-wait/ran
mof
:: ~& will-wait/u.tym
@ -105,13 +105,13 @@
mof
::
++ poke-twit-do :: recieve request
|= {usr/iden act/command} ^+ done
|= {usr/user:eyre act/command} ^+ done
?- -.act
$post
=. out (~(put by out) p.act %& usr q.act)
%+ wait-new /peer/home/[usr]
=+ req=[%twit-req `endpoint`update+[%status q.act]~ ~]
[ost %hiss post+(dray ~[%uv] p.act) `usr %twit-post req]~
[ost %hiss post+(dray:wired ~[%uv] p.act) `usr %twit-post req]~
==
::
++ wake-peer
@ -124,7 +124,7 @@
pus=(~(gas ju *(jug path bone)) (turn ~(tap by sup) .))
?~ (~(get ju pus) pax)
~
~& peer-again+[pax ran]
~& peer-again+[pax ran]
(pear | `~. pax) ::(user-from-path pax))
::
++ sigh-recoverable-error :: Rate-limit
@ -145,7 +145,7 @@
::
++ sigh-twit-post-post :: status acknowledged
|= {wir/wire rep/stat} ^+ done
=+ (raid wir mez=%uv ~)
=+ (raid:wired wir mez=%uv ~)
=. out (~(put by out) mez %| rep)
:_ +>.$
=+ pax=/[who.rep]/status/(rsh 3 2 (scot %ui id.rep))
@ -191,12 +191,14 @@
:: [`(slav %ta i.pax) t.pax]
::
::
++ compat |=({usr/(unit iden) req/(unit iden)} ?~(req & =(usr req)))
++ compat
|= {usr/(unit user:eyre) req/(unit user:eyre)}
?~(req & =(usr req))
::
:: .^(twit-feed %gx /=twit=/~/home/urbit_test)
:: .^(twit-stat %gx /=twit=/~./post/0vv0old.0post.hash0.0000)
++ peek
|= {ren/care pax/path} ^- (unit (unit gilt))
|= {ren/care:clay pax/path} ^- (unit (unit gilt))
?> ?=($x ren) :: others unsupported
=+ usr=`~. :: =^ usr pax (user-from-path pax)
?. ?=(twit-path pax)
@ -221,11 +223,11 @@
=+ hiz=(pear-hiss pax)
?~ hiz ~ :: already in flight
::?> (compat usr -.u.hiz) :: XX better auth
[ost %hiss scry+pax usr +.u.hiz]~
[ost %hiss scry+pax usr +.u.hiz]~
::
++ peer |=(pax/path :_(+> (pear & `~. pax))) :: accept subscription
++ pear :: poll, possibly returning current data
|= {ver/? usr/(unit iden) pax/path}
|= {ver/? usr/(unit user:eyre) pax/path}
^- (list move)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
@ -249,7 +251,7 @@
|= pax/twit-path ^- $%({$none $~} {$part p/gilt} {$full p/gilt})
?- -.pax
$post
=+ (raid +.pax mez=%uv ~)
=+ (raid:wired +.pax mez=%uv ~)
=+ sta=(~(get by out) mez)
?. ?=({$~ $| *} sta)
[%none ~]
@ -266,7 +268,7 @@
==
::
++ pear-hiss
|= pax/twit-path ^- (unit {(unit iden) api-call})
|= pax/twit-path ^- (unit {(unit user:eyre) api-call})
?- -.pax
$post ~ :: future/unacked
$cred
@ -287,7 +289,7 @@
|= a/knot ^- sd:param
~| [%not-user a]
%+ rash a
;~(pose (stag %user-id dem) (stag %screen-name user:parse))
;~(pose (stag %user-id dem) (stag %screen-name user:parse:twitter))
::
:: ++ pull :: release subscription
:: |= ost/bone
@ -313,5 +315,5 @@
?. =(pax a) ~
(turn b |=(c/gift [ost c]))
::
++ show-url ~(said-url talk `bowl`+<-)
++ show-url ~(said-url hall `bowl:gall`+<-)
--

458
gen/al.hoon Normal file
View File

@ -0,0 +1,458 @@
!:
:- %say
|= *
:- %noun
=- %hello
=> |%
++ tope :: topographic type
$@ $? %& :: cell or atom
%| :: atom
== ::
(pair tope tope) :: cell
--
|%
++ ax
=+ :* dom=`axis`1
doc=*(list what)
==
|_ mod/tile
++ home
:: express a hoon against the original subject
::
|=(gen/hoon ^-(hoon ?:(=(1 dom) gen [%tsgr [%$ dom] gen])))
::
++ default
:: produce a hoon that makes the model's default value, untyped
::
|- ^- hoon
?- mod
{^ *}
[$(mod -.mod) $(mod +.mod)]
::
{$axil *}
?+ p.mod [%rock %$ 0]
$cell [[%rock %$ 0] [%rock %$ 0]]
$void [%zpzp ~]
==
::
{$bark *}
$(mod q.mod)
::
{$herb *}
=+ cys=~(boil ap p.mod)
?: ?=($herb -.cys)
(home [%tsgl [%limb %$] p.mod])
$(mod cys)
::
{$deet *}
$(mod q.mod)
::
{$fern *}
:: last entry is the default value
::
|- ^- hoon
?~(t.p.mod ^$(mod i.p.mod) $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod))
::
{$kelp *}
:: last entry is the default value
::
|- ^- hoon
?~(t.p.mod ^$(mod i.p.mod) $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod))
::
{$leaf *}
[%rock p.mod q.mod]
::
{$plow *}
$(mod q.mod)
::
{$reed *}
$(mod p.mod)
::
{$vine *}
$(mod q.mod)
::
{$weed *}
(home p.mod)
==
::
++ trivial
:: ersatz by trivial construction
::
^- hoon
:+ %tsls
[%bust %noun]
~(construct sample [2 %|])
::
++ basic
|= bas/base
?- bas
::
{$atom *}
:: trivial zero
::
[%sand p.bas 0]
::
$noun
:: raw nock produces noun type
::
=+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -])
::
$cell
:: reduce to pair of nouns
::
=+($(mod [%axil %noun]) [- -])
::
$bean
:: comparison produces boolean type
::
=+([%rock %$ 0] [%ktls [%dtts - -] -])
::
$null
[%rock %n 0]
::
$void
:: should not actually be a thing
::
[%zpzp ~]
==
::
++ decorate
:: document
::
|= gen/hoon
^- hoon
?~ doc gen
=/ fin $(doc t.doc)
?~(i.doc gen [%docs u.i.doc gen])
::
++ ersatz
:: produce a correctly typed instance without subject
::
^- hoon
?- mod
{^ *}
%- decorate
=. doc ~
[ersatz(mod -.mod) ersatz(mod +.mod)]
::
{$axil *}
(decorate (basic p.mod))
::
{$bark *}
[%ktts p.mod ersatz(mod q.mod)]
::
{$herb *}
%- decorate
=. doc ~
=+ cys=~(boil ap p.mod)
?: ?=($herb -.cys)
(home [%tsgl [%limb %$] p.mod])
ersatz(mod cys)
::
{$deet *}
[%dbug p.mod ersatz(mod q.mod)]
::
{$fern *}
trivial
::
{$kelp *}
trivial
::
{$leaf *}
(decorate [%rock p.mod q.mod])
::
{$plow *}
ersatz(mod q.mod, doc [p.mod doc])
:: atom/cell, $@
::
{$reed *}
trivial
:: pair/switch, $^
::
{$vine *}
trivial
::
{$weed *}
(home p.mod)
==
::
++ factory
:: produce a normalizing gate (mold)
::
^- hoon
:^ %brts ~^~
[%base %noun]
~(construct sample [6 %&])
::
++ sample
:: normalize a sample of the subject
::
|_ $: :: axe: axis to sample
:: top: topographic type of sample
::
axe/axis
top/tope
==
++ basic
|= bas/base
:: apply documentation
::
?^ doc document
?- bas
{%atom *}
:: rez: fake instance
::
=/ rez ersatz
?^ top rez
?: =(%| top)
:: xx sanitize
::
fetch
[%wtpt fetch-wing fetch rez]
::
$noun
fetch
::
$cell
?^ top fetch
:: rez: fake instance
::
=/ rez ersatz
?: =(%| top)
rez
[%wtpt fetch-wing rez fetch]
::
$bean
?^ top ersatz
:^ %wtcl
[%dtts [%rock %$ |] [%$ axe]]
[%rock %f |]
[%rock %f &]
::
$null
ersatz
::
$void
ersatz
==
++ fetch
:: load the sample
::
^- hoon
[%$ axe]
::
++ fetch-wing
:: load, as a wing
::
^- wing
[[%& axe] ~]
::
++ choice
:: match full models, by trying them
::
|= $: :: one: first option
:: rep: other options
::
one/tile
rep/(list tile)
==
^- hoon
:: if no other choices, construct head
::
?~ rep construct(mod one)
:: fin: loop completion
::
=/ fin/hoon $(one i.rep, rep t.rep)
:: new: trial product
:: old: original subject
::
=/ new [%$ 2]
=* old [%$ 3]
:: build trial noun
::
:+ %tsls
:: build the sample with the first option
::
construct(mod one)
:: build test
::
:^ %wtcl
:: if the trial noun equals the sample
::
[%dtts new fetch]
:: produce the trial noun
::
new
:: continue with the original subject
::
[%tsgr old fin]
::
++ switch
|= $: :: one: first format
:: two: more formats
::
one/line
rep/(list line)
==
^- hoon
:: if no other choices, construct head
::
?~ rep construct(mod `tile`one)
:: fin: loop completion
::
=/ fin/hoon $(one i.rep, rep t.rep)
:: interrogate this instance
::
:^ %wtcl
:: test if we match this wing
::
[%wtts p.i.rep fetch-wing]
:: use this format
::
:- `hoon`p.i.rep
construct(mod q.i.rep, top &, axe (peg axe 3))
:: continue in the loop
::
fin
::
++ probe
:: probe for cell or default
::
^- hoon
:: against constructor
::
:+ %tsgr
:: constructor trap
::
:+ %brdt ~^~
:: construct within trap
::
%= construct
:: old context within trap context
::
dom (peg 3 dom)
:: old sample within trap sample
::
axe (peg 3 axe)
:: only kick trap if sample is known cell
::
top [& &]
==
:: boc: call constructor
:: but: default, but coerce type to call
::
=/ boc/hoon [%limb %$]
=/ but/hoon [%ktls boc default]
?: =(& top)
:: may be atom or cell; default or construct
::
[%wtpt fetch-wing but boc]
:: must be atom; construct
::
but
::
++ document
:: document and construct
::
|- ^- hoon
?~ doc construct
=/ fin $(doc t.doc)
?~(i.doc fin [%docs u.i.doc fin])
::
++ construct
:: constructor at arbitrary sample
::
^- hoon
?- mod
::
:: cell
::
{^ *}
:: apply help
::
?^ doc document
:: probe unless we know the sample is a cell
::
?@ top probe
:: if known cell, descend directly
::
:- construct(mod -.mod, top p.top, axe (peg axe 2))
construct(mod +.mod, top q.top, axe (peg axe 3))
::
:: base
::
{$axil *}
(basic p.mod)
::
:: name, $=
::
{$bark *}
[%ktts p.mod construct(mod q.mod)]
::
:: debug
::
{$deet *}
[%dbug p.mod construct(mod q.mod)]
::
:: choice, $?
::
{$fern *}
(choice i.p.mod t.p.mod)
::
:: synthesis, $;
::
{$herb *}
?^ doc document
=+ cys=~(boil ap p.mod)
?: ?=($herb -.cys)
[%cnhp (home p.mod) fetch ~]
construct(mod cys)
::
:: switch, $%
::
{$kelp *}
:: if atom or unknown, probe
::
?@ top probe
:: if cell, enter switch directly
::
(switch i.p.mod t.p.mod)
::
:: constant
::
{$leaf *}
(decorate [%rock p.mod q.mod])
::
:: documentation
::
{$plow *}
construct(doc [p.mod doc], mod q.mod)
::
:: branch, $@
::
{$reed *}
?^ doc document
?@ top
?: =(%| top)
construct(mod p.mod)
[%wtpt fetch-wing construct(mod p.mod) construct(mod q.mod)]
construct(mod q.mod)
::
:: bridge, $^
::
{$vine *}
?^ doc document
?@ top probe
:^ %wtpt
fetch-wing(axe (peg axe 2))
construct(mod q.mod)
construct(mod p.mod)
::
:: weed, $_
::
{$weed *}
(decorate (home p.mod))
==
--
--
--

2
gen/brass.hoon
View File

@ -286,7 +286,7 @@
=/ dat .^(@t %cx pax)
[(met 3 dat) dat]
==
=/ all (~(tap by dir.lon) ~)
=/ all ~(tap by dir.lon)
|- ^- mode:clay
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))

7
gen/cat.hoon
View File

@ -3,13 +3,12 @@
:::: /hoon/cat/gen
::
/? 310
// /%%/ls/subdir
// /%/pretty
/+ pretty-file, show-dir
::
::::
::
:- %say
|= {^ {arg/(list path)} vane/?($c $g)}
|= {^ {arg/(list path)} vane/?($g $c)}
=- tang+(flop `tang`(zing -))
%+ turn arg
|= pax/path
@ -29,6 +28,6 @@
*
=- [palm+[": " ``~]^-]~
:~ rose+[" " `~]^~[leaf+"*" (smyt pax)]
`tank`(subdir vane pax dir.ark)
`tank`(show-dir vane pax dir.ark)
==
==

2
gen/curl-hiss.hoon
View File

@ -4,6 +4,8 @@
::
/? 310
/- sole
/+ old-zuse
=, old-zuse
=, sole
:- %get |= {^ {a/hiss $~} usr/iden}
^- (sole-request (cask httr))

2
gen/curl.hoon
View File

@ -4,6 +4,8 @@
::
/? 310
/- sole
/+ old-zuse
=, old-zuse
=, sole
:- %get |= {^ {a/tape $~} $~}
^- (sole-request (cask httr))

4
gen/curl/url.hoon
View File

@ -2,7 +2,9 @@
::
:::: /hoon/url/curl/gen
::
/? 310
/? 310
/+ old-zuse
=, old-zuse
::
:::::
::

55
gen/deco.hoon
View File

@ -78,9 +78,8 @@
:- %say
|= *
=< [%noun (say-hello %world)]
=> :> #
:> # %arch
:> #
=> :> # %arch
:>
:> structures for our imaginary hello, world generator.
:>
:> nothing forces us to put structures in a separate core.
@ -95,24 +94,24 @@
:> in a separate chapter (separated by {+|}).
|%
:> # %model
:>
:> models (molds) are functions that normalize nouns.
:>
:> arms producing molds are introduced with {+=}. for molds,
:> we decorate the mold rather than the arm. the compiler
:> will copy the mold decoration onto the arm.
:> arms producing molds are introduced with {+=}. the
:> compiler will copy the arm decoration onto its product
+|
+= spot {p/@ q/@} :< a coordinate
+= tops :> also a coordinate
{p/@ q/@}
+= goof :> a simple tuple
$: foo/@ :< something mysterious
bar/@ :< go here for drink
moo/(binary-tree juice) :< cows do this
+= spot [p=@ q=@] :< a coordinate
+= tops :< also a coordinate
[p=@ q=@]
+= goof :< a simple tuple
$: foo=@ :< something mysterious
bar=@ :< go here for drink
moo=(binary-tree juice) :< cows do this
==
+= juice :> fruity beverage
$% {$plum p/@} :< fresh prune
{$pear p/@ q/@} :< good for cider
{$acai p/@} :< aztec superfood
+= juice :< fruity beverage
$% [%plum p=@] :< fresh prune
[%pear p=@ q=@] :< good for cider
[%acai p=@] :< aztec superfood
==
:> #
:> # %pattern
@ -124,8 +123,8 @@
:> or "higher-kinded types".
+|
++ binary-tree :< tree pattern
|* a/$-(* *)
$@($~ {n/a l/(binary-tree a) r/(binary-tree a)})
|* a=$-(* *)
$@($~ [n=a l=(binary-tree a) r=(binary-tree a)])
:> #
:> # %constant
:> #
@ -134,20 +133,20 @@
++ answer :< answer to everything
42
--
:> #
:> # %work
:>
:> #
:> engines for our imaginary hello, world app.
:>
:> note that ++say-goodbye is the correct notation, even though
:> it's a {+-} arm.
|%
:> :> ++say-hello
++ say-hello :< say hi to someone
:> friendly welcome message
:>
|= :> txt: friend to say hi to
:>
txt/term
txt=term
^- tape
"hello, {(rip 3 txt)}"
:> ++say-goodbye: say a really proper goodbye
@ -158,14 +157,14 @@
:> ?: =(%hello %world)
:> %hello
:> %world
:> :: ++say-goodbye
::
+- say-goodbye ::
:> describe product of function
:>
|= :> txt: departing friend
:> num: number of friends
$: txt/term
num/@
$: txt=term
num=@
==
^- tape
:> foo: four
@ -174,8 +173,8 @@
=/ bar (add (mul num foo) 2)
=/ moo (mul num bar) :< for all the cows
"goodbye and {(scot %ud moo)}, {(rip 3 txt)}"
:> :> ++say-minimum
++ say-minimum :> minimal decoration
|= txt/term
::
++ say-minimum :< minimal decoration
|= txt=term
"nothing to say to {(rip 3 txt)}"
--

2
gen/glass.hoon
View File

@ -124,7 +124,7 @@
?. ?=({$hoon *} tyl) hav
:_(hav [(flop `path`t.tyl) [%hoon .^(@t %cx pax)]])
::
=/ all (~(tap by dir.lon) ~)
=/ all ~(tap by dir.lon)
|- ^+ hav
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))

13
gen/hall/load-legacy.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Load legacy messages from backup
::
:::: /gen/hall/load-old/hoon
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ byk/beak}
{{man/knot $~} $~}
==
[%load-legacy man]

4
gen/talk/load.hoon → gen/hall/load.hoon
View File

@ -1,6 +1,6 @@
:: Load channel messages from backup
::
:::: /hoon/load/talk/gen
:::: /hoon/load/hall/gen
::
/? 310
::
@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ byk/beak}
{{man/knot $~} $~}
==
[%talk-load man]
[%hall-load man]

4
gen/talk/log.hoon → gen/hall/log.hoon
View File

@ -1,6 +1,6 @@
:: Enable channel logging to clay
::
:::: /hoon/log/talk/gen
:::: /hoon/log/hall/gen
::
/? 310
::
@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ byk/beak}
{{man/knot $~} $~}
==
[%talk-log man]
[%hall-log man]

4
gen/talk/save.hoon → gen/hall/save.hoon
View File

@ -1,6 +1,6 @@
:: Save channel messages to backup
::
:::: /hoon/save/talk/gen
:::: /hoon/save/hall/gen
::
/? 310
::
@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ byk/beak}
{{man/knot $~} $~}
==
[%talk-save man]
[%hall-save man]

4
gen/talk/unlog.hoon → gen/hall/unlog.hoon
View File

@ -1,6 +1,6 @@
:: Disable channel logging to clay
::
:::: /hoon/unlog/talk/gen
:::: /hoon/unlog/hall/gen
::
/? 310
::
@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ byk/beak}
{{man/knot $~} $~}
==
[%talk-unlog man]
[%hall-unlog man]

149
gen/heed.hoon
View File

@ -1,149 +0,0 @@
=> |%
--
|* $: :> vinyl: historical state (including version)
:> brain: working state of the application (not including version)
:> delta: grain of change across all state
:> prize: (pair mark noun) for namespace value
:> rumor: (pair mark noun) for namespace diff
:> opera: (pair bone card) for operation (old ++move)
:>
vinyl/mold
brain/mold
delta/mold
prize/mold
rumor/mold
opera/mold
==
|_ $: :> ops: pending operations, in reverse order
:> ego: current state
:>
ops/(list opera)
ego/brain
==
:: :: ++bake
++ bake :< apply delta
|= $: :> del: change
:>
del/delta
==
:> core after change (including operations)
^- _+>
!!
:: :: ++cope
++ cope :< transaction result
|= $: :> weg: forward identity
:> het: success or error report
:>
weg/(list coin)
het/(unit tang)
==
:> actions in reverse order
:>
^- (list delta)
!!
:: :: ++fail
++ fail :< process error
|= $: :> why: error dump
:>
why/tang
==
:> actions in reverse order
:>
^- (list delta)
!!
:: :: ++feel
++ feel :< update
|= $: :> del: change
:> pex: preparsed path, inside-first
:>
del/delta
pex/(list coin)
==
:> query updates in reverse order
:>
^- (list rumor)
!!
:: :: ++hear
++ hear :< subscription update
|= $: :> weg: forward identity
:>
weg/(list coin)
==
:> actions in reverse order
:>
^- (list delta)
!!
:: :: ++pull
++ pull :< subscription cancel
|= $: :> weg: forward identity
:> het: error report, if any
:>
weg/(list coin)
het/(unit tang)
==
:> actions in reverse order
:>
^- (list delta)
!!
:: :: ++leak
++ leak :< check access
|= $: :> lec: leakset (~ means public)
:> pex: preparsed path, inside-first
:>
lec/(unit (set ship))
pex/(list coin)
==
:> if path `pex` is visible to ships in `lec`
^- ?
!!
:: :: ++load
++ look :< asynchronous read
|= $: :> pex: preparsed path, inside-first
:>
pex/(list coin)
==
:> actions in reverse order
^- _+>
!!
:: :: ++prep
++ prep :< load system
|= $: old/vinyl
==
:> core after boot
^- _+>
!!
:: :: ++peek
++ peek :< synchronous read
|= $: :> pex: preparsed path, inside-first
:>
pex/(list coin)
==
:> value at `pec`; ~ for unavailable, [~ ~] for invalid
:>
^- (unit (unit prize))
!!
:: :: ++poke
++ poke :< generic poke
|= $: :> ost: opaque cause
:> msg: message with mark and vase
:>
ost/bone
msg/cage
==
:> actions in reverse order
:>
^- (list delta)
!!
:: :: ++pour
++ pour :< arvo response
|= $: :> weg: forward identity
:> sin: response card
:>
weg/(list coin)
sin/sign
==
:> actions in reverse order
:>
^- (list delta)
!!
--

2
gen/help.hoon
View File

@ -23,7 +23,7 @@
:- ?- b
$~ "/" :: XX !! maybe?
{$hood ^} "|{(path-heps t.b)}"
^ "+{(path-heps b)}" :: XX deal with :talk|foo
^ "+{(path-heps b)}" :: XX deal with :hall|foo
==
=/ c (to-wain:format a)
?~ c "~"

2
gen/hood/ask.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/ask/hood/gen
::
/? 310
/+ old-zuse
=, old-zuse
:- %say
|= {^ {mel/cord $~} $~}
=+ adr=(star ;~(less (mask "\"\\()[],:;<>@") prn))

4
gen/hood/begin.hoon
View File

@ -4,6 +4,8 @@
::
/? 310
/- sole
/+ old-zuse
=, old-zuse
::
::::
::
@ -15,7 +17,7 @@
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
{arg/_(scug *@ *{his/@p tic/@p $~})}
safety/?($on $off)
safety/?($off $on)
==
^- (sole-result (cask begs))
?. =(safety %off)

4
gen/hood/bonus.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/bonus/hood/gen
::
/? 310
/+ old-zuse
=, old-zuse
::
::::
::
@ -13,4 +15,4 @@
?~ opt $(opt [planets=1]~)
?~ +.opt $(+.opt [stars=0]~)
:- %womb-bonus
[(scot %uv pas) planets stars]
[(scot %uv pas) planets.opt stars.opt]

8
gen/hood/init-auth-basic.hoon
View File

@ -13,13 +13,13 @@
{arg/$@($~ {dom/path $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
^- (sole-result {$write-sec-atom p/host:eyre q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ sole-lo
[%& %oauth-hostname "api hostname: https://"]
%+ sole-go thos:urlp
|= hot/host
%+ sole-go thos:de-purl:html
|= hot/host:eyre
?: ?=($| -.hot)
~|(%ips-unsupported !!)
%+ sole-lo
@ -31,4 +31,4 @@
%+ sole-go (boss 256 (star prn))
|= pas/@t
%+ sole-so %write-sec-atom :: XX typed pair
[hot (crip (sifo (rap 3 usr ':' pas ~)))]
[hot (crip (en-base64:mimes:html (rap 3 usr ':' pas ~)))]

4
gen/hood/init-oauth1.hoon
View File

@ -4,6 +4,8 @@
::
/? 314
/- sole
/+ old-zuse
=, old-zuse
::
::::
::
@ -31,4 +33,4 @@
%+ sole-go (boss 256 (star prn))
|= sec/@t
%+ sole-so %write-sec-atom :: XX typed pair
[hot (of-wain key sec ~)]
[hot (of-wain:format key sec ~)]

10
gen/hood/init-oauth2.hoon
View File

@ -4,6 +4,8 @@
::
/? 314
/- sole
/+ old-zuse
=, old-zuse
::
::::
::
@ -13,13 +15,13 @@
{arg/$@($~ {dom/path $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
^- (sole-result {$write-sec-atom p/host:eyre q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ sole-lo
[%& %oauth-hostname "api hostname: https://"]
%+ sole-go thos:urlp
|= hot/host
%+ sole-go thos:de-purl:html
|= hot/host:eyre
?: ?=($| -.hot)
~|(%ips-unsupported !!)
%+ sole-lo
@ -31,4 +33,4 @@
%+ sole-go (boss 256 (star prn))
|= cis/@t
%+ sole-so %write-sec-atom :: XX typed pair
[hot (of-wain cid cis ~)]
[hot (of-wain:format cid cis ~)]

9
gen/hood/init-oauth2/google.hoon
View File

@ -4,17 +4,20 @@
::
/? 314
/- sole
/+ old-zuse
=, old-zuse
::
::::
::
=, sole
=, html
=, format
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
{arg/$@($~ {jon/json $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
^- (sole-result {$write-sec-atom p/host:eyre q/@})
%+ sole-yo leaf+"Accepting credentials for https://*.googleapis.com"
=+ hot=[%& /com/googleapis]
=- ?~ arg -
@ -25,6 +28,6 @@
|= jon/json
=+ ~| bad-json+jon
=- `{cid/@t cis/@t}`(need (rep jon))
rep=(ot web+(ot 'client_id'^so 'client_secret'^so ~) ~):jo
rep=(ot web+(ot 'client_id'^so 'client_secret'^so ~) ~):dejs-soft:format
%+ sole-so %write-sec-atom :: XX typed pair
[hot (of-wain cid cis ~)]
[hot (of-wain:format cid cis ~)]

32
gen/hood/invite.hoon
View File

@ -6,12 +6,36 @@
::
::::
::
/+ womb
/+ hood-womb
=* invite invite:hood-womb
=* reference reference:hood-womb
|%
++ plural
|= {a/@u b/tape} ^+ b
?: =(1 a) "one {b}"
=; n/tape "{n} {b}s"
~| plural-stub+a ::TODO expand
%- trip
%+ snag a ^~
%+ weld
/no/''/two/three/four/five/six/seven/eight/nine/ten/elven/twelve
/thirteen/fourteen/fifteen/sixteen/seventeen/eighteen/nineteen/twenty
::
++ type $%({$planets planets/@u} {$stars stars/@u})
--
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{who/@t $~} sta/@}
{{who/@t etc/$@($~ {typ/type $~})} ref/(unit (each ship mail:hood-womb))}
==
?~ etc $(etc ~[planets+2])
:- %womb-invite
^- {cord invite}:womb
^- {cord reference invite}
=+ inv=(scot %uv (end 7 1 eny))
[inv [who 10 sta "You have been invited to Urbit: {(trip inv)}" "This is an invite of 10 planets"]]
=; d/[planets=@u stars=@u inf=tape]
[inv ref [who planets.d stars.d "Your invite for {inf.d}: {(trip inv)}" ~]]
::
?: =(0 +.typ.etc) ~|(%empty-invite !!)
?- -.typ.etc
$stars [planets=0 stars.typ.etc (plural stars.typ.etc "star")]
$planets [planets.typ.etc stars=0 (plural planets.typ.etc "planet")]
==

7
gen/hood/load.hoon
View File

@ -3,7 +3,8 @@
:::: /hoon/load/hood/gen
::
/? 310
/+ womb
/+ hood-womb, old-zuse
=, old-zuse
::
::::
::
@ -11,9 +12,9 @@
|= $: {now/@da eny/@uvJ byk/beak}
{{dap/term pas/@uw $~} $~}
==
^- {$hood-load ?(part:womb)}
^- {$hood-load ?(part:hood-womb)}
?+ dap ~|(unknown-backup+dap !!)
$womb
=+ dat=.^(@ %cx (tope byk /jam-crub/womb-part/bak/hood/app))
[%hood-load ;;(part:womb (cue (dy:crub pas dat)))]
[%hood-load ;;(part:hood-womb (cue (dy:crub pas dat)))]
==

6
gen/hood/merge.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/merge/hood/gen
::
/? 310
/+ *old-zuse
=, old-zuse
::
|%
++ beaky {knot knot knot $~}
@ -13,11 +15,11 @@
::
:- %say
|= $: {now/@da eny/@uvJ bek/beak}
{arg/{?(sorc {syd/$@(desk beaky) sorc})} cas/case gem/?($auto germ)}
{arg/{?(sorc {syd/$@(desk beaky) sorc})} cas/case gem/?(germ $auto)}
==
=* our p.bek
|^ :- %kiln-merge
^- {syd/desk her/ship sud/desk cas/case gem/?($auto germ)}
^- {syd/desk her/ship sud/desk cas/case gem/?(germ $auto)}
?- arg
{@ @ $~}
=+(arg [sud ?.(=(our her) her (sein her)) sud (opt-case da+now) gem])

2
gen/hood/mv.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/mv/hood/gen
::
/? 310
/+ old-zuse
=, old-zuse
:- %say
|= {^ {input/path output/path $~} $~}
:- %kiln-info

13
gen/hood/nuke.hoon Normal file
View File

@ -0,0 +1,13 @@
:: nuke: reject packets from.
::
:::: /hoon/mount/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{him/@p $~} $~}
==
[%helm-nuke him]

5
gen/hood/reinvite.hoon
View File

@ -8,7 +8,8 @@
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{pas/@uvG who/@t $~} $~}
{{pas/@uvG who/@t pla/@u sta/@u $~} $~}
==
:- %womb-reinvite
[pas who 3 0 "You have been inivted to Urbit" "This is a re-invite of 3 planets"]
=/ new `@uv`(end 7 1 eny)
[pas new who pla sta "Your urbit balance has been transferred: {<new>}" ""]

4
gen/hood/replay-womb-log.hoon
View File

@ -3,12 +3,12 @@
:::: /hoon/replay-womb-log/hood/gen
::
/? 310
/+ womb
/+ hood-womb
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{log/(list {@uvJ transaction:womb}) $~}
{log/(list {@uvJ transaction:hood-womb}) $~}
==
[%womb-replay-log log]

2
gen/hood/report.hoon
View File

@ -2,6 +2,8 @@
:::: /hoon/report/hood/gen
::
/? 310
/+ old-zuse
=, old-zuse
::
::::
::

2
gen/hood/save.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/save/hood/gen
::
/? 310
/+ old-zuse
=, old-zuse
::
::::
::

2
gen/hood/serve.hoon
View File

@ -3,6 +3,8 @@
:::: /hoon/serve/hood/gen
::
/? 310
/+ old-zuse
=, old-zuse
::
::::
::

9
gen/hood/tlon/add-stream.hoon Normal file
View File

@ -0,0 +1,9 @@
:: tlon: add stream to local urbit-meta
::
:::: /gen/hood/tlon/add-stream/hoon
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{web/ship $~} $~}
==
[%helm-tlon-add-stream web]

9
gen/hood/tlon/init-web.hoon Normal file
View File

@ -0,0 +1,9 @@
:: tlon: configure web ship
::
:::: /gen/hood/tlon/init-web/hoon
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{met/ship $~} $~}
==
[%helm-tlon-init-web met]

6
gen/hood/transfer.hoon
View File

@ -3,7 +3,7 @@
:::: /hoon/transfer/hood/gen
::
/? 310
/+ womb
/+ hood-womb
::
::::
::
@ -12,6 +12,6 @@
{{pas/@uvH who/@t $~} $~}
==
:- %womb-reinvite
=+ [him=(scot %p p.bec) cas=(scot %da now) key=(scot %p pas)]
=+ [pla=planets sta=stars]:.^(balance:womb %gx /[him]/hood/[cas]/womb/balance/[key])
=+ [him=(scot %p p.bec) cas=(scot %da now) key=(scot %uv pas)]
=+ [pla=planets sta=stars]:.^(balance:hood-womb %gx /[him]/hood/[cas]/womb/balance/[key]/womb-balance)
[pas who pla sta "Email updated, new passcode" "Email correction"]

13
gen/hood/wipe-ford.hoon Normal file
View File

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

10
gen/ivory.hoon
View File

@ -19,24 +19,24 @@
::
=+ compiler-source=.^(@t %cx (welp sys /hoon/hoon))
::
:: compiler-twig: compiler as hoon expression
:: compiler-hoon: compiler as hoon expression
::
~& %ivory-parsing
=+ compiler-twig=(ream compiler-source)
=+ compiler-hoon=(ream compiler-source)
~& %ivory-parsed
::
:: arvo-source: hoon source file producing arvo kernel, `sys/arvo`
::
=+ arvo-source=.^(@t %cx (welp sys /arvo/hoon))
::
:: whole-twig: arvo within compiler
:: whole-hoon: arvo within compiler
::
=+ whole-twig=`twig`[%tsgr compiler-twig [%tsgr [%$ 7] (ream arvo-source)]]
=+ whole-hoon=`hoon`[%tsgr compiler-hoon [%tsgr [%$ 7] (ream arvo-source)]]
::
:: compile the whole schmeer
::
~& %ivory-compiling
=+ whole-formula=q:(~(mint ut %noun) %noun whole-twig)
=+ whole-formula=q:(~(mint ut %noun) %noun whole-hoon)
~& %ivory-compiled
::
whole-formula

6
gen/ls.hoon
View File

@ -3,12 +3,12 @@
:::: /hoon/ls/gen
::
/? 310
// /%/subdir
/+ show-dir
::
::::
::
~& %
:- %say
|= {^ {arg/path $~} vane/?($c $g)}
|= {^ {arg/path $~} vane/?($g $c)}
=+ lon=.^(arch (cat 3 vane %y) arg)
tang+[?~(dir.lon leaf+"~" (subdir vane arg dir.lon))]~
tang+[?~(dir.lon leaf+"~" (show-dir vane arg dir.lon))]~

25
gen/ls/subdir.hoon
View File

@ -1,25 +0,0 @@
:: Filesystem iterator XX move to lib/
::
:::: /hoon/subdir/ls/gen
::
/? 310
|%
++ subdir
|= {vane/?($c $g) pax/path des/(map @t $~)}
^- tank
:+ %rose [" " `~]
%+ turn (sort ~(tap by des) aor)
|= {kid/@ta $~}
=+ paf=`path`/[kid]
=- :+ %rose ["/" ~ ?:(dir "/" ~)]
(turn paf |=(a/knot leaf+(trip a)))
|- ^- {dir/? paf/path}
=+ arf=.^(arch (cat 3 vane %y) (weld pax paf))
?^ fil.arf
[| paf]
?~ dir.arf
[& paf] :: !!
?. ?=({^ $~ $~} dir.arf)
[& paf]
$(paf (welp paf /[p.n.dir.arf]))
--

4
gen/metal.hoon
View File

@ -2,6 +2,8 @@
:::: /hoon/metal/gen
::
/? 310
/+ old-zuse
=, old-zuse
::
::::
!:
@ -277,7 +279,7 @@
=/ dat .^(@t %cx pax)
[(met 3 dat) dat]
==
=/ all (~(tap by dir.lon) ~)
=/ all ~(tap by dir.lon)
|- ^- mode:clay
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))

33
gen/moon.hoon
View File

@ -3,18 +3,37 @@
:::: /hoon/moon/gen
::
/? 310
/- sole
/+ old-zuse
=, old-zuse
[. sole]
::
::::
::
:- %say
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
$~
$~
==
:- %tang :_ ~ :- %leaf
=+ ran=(clan p.bec)
=/ ran (clan p.bec)
?: ?=({?($earl $pawn)} ran)
"can't create a moon from a {?:(?=($earl ran) "moon" "comet")}"
=+ mon=(mix (lsh 5 1 (end 5 1 eny)) p.bec)
=+ tic=.^(@ /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p mon))
"moon: {<`@p`mon>}; ticket: {<`@p`tic>}"
%- sole-so
:- %tang :_ ~
leaf+"can't create a moon from a {?:(?=($earl ran) "moon" "comet")}"
=/ mon (mix (lsh 5 1 (end 5 1 eny)) p.bec)
=/ tic .^(@ /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p mon))
%+ sole-yo
leaf+"(see https://github.com/urbit/arvo/issues/327 for details)"
%+ sole-yo
:- %leaf
;: weld
"WARNING: linking a moon to your "
?-(ran $czar "galaxy", $king "star", $duke "planet")
" can cause networking bugs"
==
%+ sole-lo
[& %$ "enter y/yes to continue: "]
|= inp/tape
?. |(=("y" inp) =("yes" inp))
(sole-so [%tang leaf+"canceled" ~])
(sole-so [%tang leaf+"moon: {<`@p`mon>}; ticket: {<`@p`tic>}" leaf+"" ~])

366
gen/musk.hoon Normal file
View File

@ -0,0 +1,366 @@
::
::::
::
:- %say
|= {^ {{typ/type gen/hoon $~} $~}}
=< :- %noun
=+ pro=(~(mint ut typ) %noun gen)
~_ (~(dunk ut typ) 'blow-subject')
=+ bus=(bran:musk typ)
~& [%subject-mask mask.bus]
=+ jon=(apex:musk bus q.pro)
?~ jon
~& %constant-stopped
!!
?. ?=($& -.u.jon)
~& %constant-blocked
!!
:: [p.pro [%1 p.u.jon]]
p.u.jon
|%
++ musk :: nock with block set
=> |%
++ block
:: identity of resource awaited
:: XX parameterize
noun
::
++ result
:: internal interpreter result
::
$@(~ seminoun)
::
++ seminoun
:: partial noun; blocked subtrees are ~
::
{mask/stencil data/noun}
::
++ stencil
:: noun knowledge map
::
$% :: no; noun has partial block substructure
::
{$| left/stencil rite/stencil}
:: yes; noun is either fully complete, or fully blocked
::
{$& blocks/(set block)}
==
::
++ output
:: nil; interpreter stopped
::
%- unit
:: yes, complete noun; no, list of blocks
::
(each noun (list block))
--
|%
++ bran
|= sut/type
=+ gil=*(set type)
|- ^- seminoun
?- sut
$noun [&+[~ ~ ~] ~]
$void [&+[~ ~ ~] ~]
{$atom *} ?~(q.sut [&+[~ ~ ~] ~] [&+~ u.q.sut])
{$cell *} (combine $(sut p.sut) $(sut q.sut))
{$core *} %+ combine:musk
?~ p.s.q.sut [&+[~ ~ ~] ~]
[&+~ p.s.q.sut]
$(sut p.sut)
{$face *} $(sut ~(repo ut sut))
{$fork *} [&+[~ ~ ~] ~]
{$help *} $(sut ~(repo ut sut))
{$hold *} ?: (~(has in gil) sut)
[&+[~ ~ ~] ~]
$(sut ~(repo ut sut), gil (~(put in gil) sut))
==
++ abet
:: simplify raw result
::
|= $: :: noy: raw result
::
noy/result
==
^- output
:: propagate stop
::
?~ noy ~
:- ~
:: merge all blocking sets
::
=/ blocks (squash mask.noy)
?: =(~ blocks)
:: no blocks, data is complete
::
&+data.noy
:: reduce block set to block list
::
|+~(tap in blocks)
::
++ apex
:: execute nock on partial subject
::
|= $: :: bus: subject, a partial noun
:: fol: formula, a complete noun
::
bus/seminoun
fol/noun
==
^- output
:: simplify result
::
%- abet
:: interpreter loop
::
|- ^- result
:: ~& [%apex-fol fol]
:: ~& [%apex-mac mask.bus]
:: =- ~& [%apex-pro-mac ?@(foo ~ ~!(foo mask.foo))]
:: foo
:: ^= foo
:: ^- result
?@ fol
:: bad formula, stop
::
~
?: ?=(^ -.fol)
:: hed: interpret head
::
=+ hed=$(fol -.fol)
:: propagate stop
::
?~ hed ~
:: tal: interpret tail
::
=+ tal=$(fol +.fol)
:: propagate stop
::
?~ tal ~
:: combine
::
(combine hed tal)
?+ fol
:: bad formula; stop
::
~
:: 0; fragment
::
{$0 b/@}
:: if bad axis, stop
::
?: =(0 b.fol) ~
:: reduce to fragment
::
(fragment b.fol bus)
::
:: 1; constant
::
{$1 b/*}
:: constant is complete
::
[&+~ b.fol]
::
:: 2; recursion
::
{$2 b/* c/*}
:: require complete formula
::
%+ require
:: compute formula with current subject
::
$(fol c.fol)
|= :: ryf: next formula
::
ryf/noun
:: lub: next subject
::
=+ lub=^$(fol b.fol)
:: propagate stop
::
?~ lub ~
:: recurse
::
^$(fol ryf, bus lub)
::
:: 3; probe
::
{$3 b/*}
%+ require
$(fol b.fol)
|= :: fig: probe input
::
fig/noun
:: yes if cell, no if atom
::
[&+~ .?(fig)]
::
:: 4; increment
::
{$4 b/*}
%+ require
$(fol b.fol)
|= :: fig: increment input
::
fig/noun
:: stop for cells, increment for atoms
::
?^(fig ~ [&+~ +(fig)])
::
:: 5; compare
::
{$5 b/*}
%+ require
$(fol b.fol)
|= :: fig: operator input
::
fig/noun
:: stop for atoms, compare cells
::
?@(fig ~ [&+~ =(-.fig +.fig)])
::
:: 6; if-then-else
::
{$6 b/* c/* d/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]))
::
:: 7; composition
::
{$7 b/* c/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [2 b 1 c]))
::
:: 8; declaration
::
{$8 b/* c/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [7 [[7 [0 1] b] 0 1] c]))
::
:: 9; invocation
::
{$9 b/* c/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [7 c 2 [0 1] 0 b]))
::
:: 10; static hint
::
{$10 @ c/*}
:: ignore hint
::
$(fol c.fol)
::
:: 10; dynamic hint
::
{$10 {b/* c/*} d/*}
:: noy: dynamic hint
::
=+ noy=$(fol c.fol)
:: propagate stop
::
?~ noy ~
:: otherwise, ignore hint
::
$(fol d.fol)
==
::
++ combine
:: combine a pair of seminouns
::
|= $: :: hed: head of pair
:: tal: tail of pair
::
hed/seminoun
tal/seminoun
==
^- seminoun
?. ?& &(?=($& -.mask.hed) ?=($& -.mask.tal))
=(=(~ blocks.mask.hed) =(~ blocks.mask.tal))
==
:: default merge
::
[|+[mask.hed mask.tal] [data.hed data.tal]]
:: both sides total
::
?: =(~ blocks.mask.hed)
:: both sides are complete
::
[&+~ data.hed data.tal]
:: both sides are blocked
::
[&+(~(uni in blocks.mask.hed) blocks.mask.tal) ~]
::
++ fragment
:: seek to an axis in a seminoun
::
|= $: :: axe: tree address of subtree
:: bus: partial noun
::
axe/axis
bus/seminoun
==
|- ^- result
:: 1 is the root
::
?: =(1 axe) bus
:: now: 2 or 3, top of axis
:: lat: rest of axis
::
=+ [now=(cap axe) lat=(mas axe)]
?- -.mask.bus
:: subject is fully blocked or complete
::
$& :: if fully blocked, produce self
::
?^ blocks.mask.bus bus
:: descending into atom, stop
::
?@ data.bus ~
:: descend into complete cell
::
$(axe lat, bus [&+~ ?:(=(2 now) -.data.bus +.data.bus)])
:: subject is partly blocked
::
$| :: descend into partial cell
::
%= $
axe lat
bus ?: =(2 now)
[left.mask.bus -.data.bus]
[rite.mask.bus +.data.bus]
== ==
:: require complete intermediate step
::
++ require
|= $: noy/result
yen/$-(noun result)
==
^- result
:: propagate stop
::
?~ noy ~
:: if partial block, squash blocks and stop
::
?: ?=($| -.mask.noy) [&+(squash mask.noy) ~]
:: if full block, propagate block
::
?: ?=(^ blocks.mask.noy) [mask.noy ~]
:: otherwise use complete noun
::
(yen data.noy)
::
++ squash
:: convert stencil to block set
::
|= tyn/stencil
^- (set block)
?- -.tyn
$& blocks.tyn
$| (~(uni in $(tyn left.tyn)) $(tyn rite.tyn))
==
--
--

2
gen/pope.hoon
View File

@ -5,6 +5,8 @@
/? 310
:: Input twitter keys
/- sole
/+ old-zuse
=, old-zuse
::
=+ cryp=crub
=+ [sole]

12
gen/serving.hoon Normal file
View File

@ -0,0 +1,12 @@
:: Eyre: show web base path
::
:::: /hoon/serving/gen
::
/? 310
::
::::
::
:- %say
|= [[now=time @ our=ship ^] ~ ~]
:- %noun
.^(path %e (en-beam:format [our %serv da+now] /))

73
gen/solid.hoon
View File

@ -1,41 +1,76 @@
:: Compile arvo as a pill noun, usage .urbit/pill +solid
:: Compile arvo as a pill noun, without compiler changes.
:: usage
::
:: .urbit/pill +solid
::
:::: /hoon/solid/gen
::
/? 310
::
::::
::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{$~ $~}
{arg/$@($~ {top/path $~}) dub/_|}
==
?~ arg $(arg ~[top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/sys])
::
:- %noun
=+ top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/arvo
=+ pax=`path`(weld top `path`[%hoon ~])
=+ pax=`path`(weld top.arg `path`[%hoon ~])
=+ arp=`path`(weld top.arg `path`[%arvo ~])
~& %solid-start
=+ gen=(reck pax)
~& %solid-parsed
=+ ken=q:(~(mint ut %noun) %noun gen)
~& %solid-compiled
=+ txt=.^(@t %cx (weld pax `path`[%hoon ~]))
=+ rax=.^(@t %cx (weld arp `path`[%hoon ~]))
=+ ^= ken
=- ?:(?=($& -.res) p.res (mean (flop p.res)))
^= res %- mule |.
~& %solid-loaded
=+ gen=(rain pax txt)
~& %solid-parsed
=+ one=(~(mint ut %noun) %noun gen)
~& %solid-compiled
?. dub
=+ two=(~(mint ut p.one) %noun (rain arp rax))
~& %solid-arvo
[7 q.one q.two]
=/ tri
'''
:: XX moveme to, uh arvo probably, this depends on too many names
|= [pax=path txt=@t arp=path rax=@t]
=+ gen=(rain pax txt)
~& %solid-double-parsed
=+ one=(~(mint ut %noun) %noun gen)
~& %solid-double-compiled
=+ two=(~(mint ut p.one) %noun (rain arp rax))
~& %solid-arvo
[7 q.one q.two]
'''
=+ all=.*(0 q.one)
.* all
:+ 7 =<(+ .*(all [9 2 0+2 1+[p.one tri] 0+7]))
[9 2 0+2 1+[pax txt arp rax] 0+7]
::
~& [%solid-kernel `@ux`(mug ken)]
:- ken
=+ all=.*(0 ken)
=+ ^= vay ^- (list {p/@tas q/@tas})
:~ [%$ %zuse]
[%c %clay]
[%g %gall]
[%f %ford]
[%a %ames]
[%b %behn]
[%d %dill]
[%e %eyre]
=+ ^= vay ^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%b /vane/behn]
[%d /vane/dill]
[%a /vane/ames]
[%c /vane/clay]
[%g /vane/gall]
[%e /vane/eyre]
[%f /vane/ford]
==
|- ^+ all
?~ vay all
=+ pax=(weld top `path`[q.i.vay ~])
=+ pax=(weld top.arg q.i.vay)
=+ txt=.^(@ %cx (weld pax `path`[%hoon ~]))
=+ sam=[now `ovum`[[%gold ~] [%veer p.i.vay pax txt]]]
~& [%solid-veer i.vay]
=+ gat=.*(all .*(all [0 42]))
=+ nex=+:.*([-.gat [sam +>.gat]] -.gat)
$(vay t.vay, all nex)

10
gen/talk/federate.hoon
View File

@ -1,10 +0,0 @@
:: Set upstream sources for channel
::
:::: /hoon/federate/talk/gen
::
/? 310
/- talk
:- %say
|= {^ {dest/knot sources/(list station:talk)} $~}
:- %talk-command
[%design dest ~ (silt (turn sources |=(station:talk [%& +<]))) '' %black ~]

992
gen/test.hoon
View File

File diff suppressed because it is too large Load Diff

4
gen/ticket.hoon
View File

@ -5,10 +5,12 @@
/? 310
::
::::
::
!.
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{her/@p $~} $~}
==
:- %noun
~_ leaf+"can't ticket {<her>} (not a child of {<p.bec>})"
?> =(p.bec (sein:title her))
.^(@p /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p her))

5
gen/twit/feed.hoon
View File

@ -2,13 +2,16 @@
::
:::: /hoon/feed/twit/gen
::
/? 310
/- twitter
/+ old-zuse
=, old-zuse
::
:::: ~fyr
::
:- %say
|= $: {now/@da eny/@uvJ bek/beak}
{{who/iden $~} typ/?($home $user)}
{{who/iden $~} typ/?($user $home)}
==
=+ pax=/(scot %p p.bek)/twit/(scot %da now)/[typ]/[who]
:- %tang

160
gen/walk.hoon
View File

@ -1,160 +0,0 @@
!:
::::
::
:- %say
|= $: {now/@da * bec/beak}
*
==
=< :- %noun
%hello
|%
::
++ ap
|_ gen/twig
++ gi
=| whit
=* wit -
|%
++ gray
^- ?
|
:: on reflection, perhaps just obsessive linting
::
:: ?| ?=(^ lab)
:: ?=(^ boy)
:: |- ^- ?
:: ?~ def |
:: |($(def l.def) $(def r.def) !(~(has in use) p.n.def))
:: ==
::
++ grad
|= $: gen/twig
wit/whit
aid/$-({? twig whit} {twig whit})
==
^- (unit (pair twig whit))
=: ^gen gen
^wit wit
==
?: =([~ ~ ~ ~] wit) `[gen wit]
=< apex
|%
++ apex
^- (unit (pair twig whit))
=^ one wit prim
=^ two wit senc(gen one)
?: =(gen two)
~
`(aid & two wit)
::
:: resolve body and label issues
::
++ prim
^- (pair twig whit)
?: ?=(^ -.gen) flam
?+ -.gen flam
$halo flam
$base runk
$leaf runk
$bcpt runk
$bccb runk
$bccl runk
$bccn runk
$bchp runk
$bckt runk
$bcwt runk
$bcts flam
$bcsm runk
$brcb ((doof -.gen +>.gen) p.gen)
$brcl ((doof -.gen +>.gen) p.gen)
$brcn ((doof -.gen +>.gen) p.gen)
$brdt ((doof -.gen +>.gen) p.gen)
$brkt ((doof -.gen +>.gen) p.gen)
$brhp ((doof -.gen +>.gen) p.gen)
$brsg ((doof -.gen +>.gen) p.gen)
$brtr ((doof -.gen +>.gen) p.gen)
$brts ((doof -.gen +>.gen) p.gen)
$brwt ((doof -.gen +>.gen) p.gen)
==
::
:: resolve variable issues
::
++ senc
^- (pair twig whit)
?: ?=(^ -.gen) flam
?+ -.gen flam
$ktts ((helk -.gen +>.gen) p.gen)
$bcts ((helk -.gen +>.gen) p.gen)
$var ((hulp -.gen +>.gen) p.gen)
$rev ((hulp -.gen +>.gen) p.gen)
$sip ((hulp -.gen +>.gen) p.gen)
$aka ((humm -.gen +>.gen) p.gen)
==
::
++ flam [gen wit]
++ grif
|= {cog/term wat/what}
^- {what whit}
?: =(~ def)
?~ boy [wat wit]
[boy wit(boy ~)]
=+ yeb=(~(get by def) cog)
?~ yeb [wat wit]
[`u.yeb wit(use (~(put in use) cog))]
::
++ doof
|* {pif/@tas suf/*}
|= pac/chap
^- (pair twig whit)
:_ wit(lab ~, boy ~)
=- [pif - suf]
^- chap
:- ?~(lab p.pac [u.lab ~])
?~(boy q.pac boy)
::
++ helk
|* {pif/@tas suf/*}
|= got/toga
^- (pair twig whit)
=^ gef wit (tong got)
[[pif gef suf] wit]
::
++ hulp
|* {pif/@tas suf/*}
|= hot/toro
^- (pair twig whit)
=^ tog wit (tong p.hot)
[[pif [tog q.hot] suf] wit]
::
++ humm
|* {pif/@tas suf/*}
|= {cog/term wat/what)
^- (pair twig whit)
=^ taw wit (grif cog wat)
[[pif [cog taw] suf] wit]
::
++ runk
^- (pair twig whit)
?~ boy flam
[[%halo boy gen] wit(boy ~)]
::
++ tong
|= got/toga
^- {toga whit}
?@ got
=^ wat wit (grif got ~)
?~ wat [got wit]
[[%1 [wat got] [%0 ~]] wit]
?- -.got
$0 [got wit]
$1 =^ wat wit (grif q.p.got p.p.got)
=^ sub wit $(got q.got)
[[%1 [wat q.p.got] sub] wit]
$2 =^ one wit $(got p.got)
=^ two wit $(got q.got)
[[%2 one two] wit]
==
--
--
--
--

4
gen/womb/balance.hoon
View File

@ -3,11 +3,11 @@
:::: /hoon/balance/womb/gen
::
/? 310
/+ womb
/+ hood-womb
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{pas/@uvG $~}
who/(unit @p)
==
=- [%womb-balance .^(balance:womb %gx /[him]/hood/[cas]/womb/balance/[key]/womb-balance)]
=- [%womb-balance .^(balance:hood-womb %gx /[him]/hood/[cas]/womb/balance/[key]/womb-balance)]
[him=(scot %p ?^(who u.who p.bec)) cas=(scot %da now) key=(scot %uv pas)]

5
gen/womb/balances.hoon
View File

@ -3,7 +3,7 @@
:::: /hoon/balance/womb/gen
::
/? 310
/+ womb
/+ hood-womb
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
$~
@ -11,4 +11,5 @@
==
:- %womb-balance-all
=+ [him=(scot %p ?^(who u.who p.bec)) cas=(scot %da now)]
.^((set {passhash mail}:womb) %gx /[him]/hood/[cas]/womb/balance/womb-balance-all)
=/ balances =>(hood-womb ,(set [passhash mail]))
.^(balances %gx /[him]/hood/[cas]/womb/balance/womb-balance-all)

2
gen/womb/shop.hoon
View File

@ -5,7 +5,7 @@
/? 310
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
arg/$@($~ {typ/?($stars $planets $galaxies) $~})
arg/$@($~ {typ/?($planets $galaxies $stars) $~})
who/(unit @p)
==
?~ arg $(arg ~[typ=%planets])

4
gen/womb/stats.hoon
View File

@ -2,7 +2,7 @@
:::: /hoon/stats/womb/gen
::
/? 310
/+ womb
/+ hood-womb
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
$~
@ -10,4 +10,4 @@
==
:- %womb-stat-all
=+ [him=(scot %p ?^(who u.who p.bec)) cas=(scot %da now)]
.^((map ship stat:womb) %gx /[him]/hood/[cas]/womb/stats/womb-stat-all)
.^((map ship stat:hood-womb) %gx /[him]/hood/[cas]/womb/stats/womb-stat-all)

2
lib/basic-auth.hoon
View File

@ -22,7 +22,7 @@
::
++ add-auth-header
|= a/hiss ^- hiss
~& auth+(earn p.a)
~& auth+(en-purl:html p.a)
%_(a q.q (~(add ja q.q.a) %authorization header:auth))
::
++ standard

7
lib/connector.hoon
View File

@ -10,6 +10,9 @@
:: -- in `++sigh-httr` in the connector app, call `++sigh` in
:: this library to handle the response according to the
:: place.
/+ old-zuse
=, old-zuse
::
|* {move/mold sub-result/mold}
=> |%
:: A place consists of:
@ -108,11 +111,12 @@
$(places t.places)
(?+(ren !! $x read-x.i.places, $y read-y.i.places) pax)
::
:: Handles http responses sent in `++read` by mappig them to
:: Handles http responses sent in `++read` by mapping them to
:: their handling, either `sigh-x` or `sigh-y`, in `places`.
::
++ sigh
=, html
=, eyre
|= {places/(list place) ren/care pax/path res/httr}
^- sub-result
=< ?+(ren ~|([%invalid-care ren] !!) $x sigh-x, $y sigh-y)
@ -164,5 +168,4 @@
arch+*arch
arch+u.-
--
--

61
lib/cram.hoon Normal file
View File

@ -0,0 +1,61 @@
|%
++ static :: freeze .mdh hoon subset
|= gen/hoon ^- {inf/(map term dime) elm/manx}
?+ -.gen
=/ gen ~(open ap gen)
?: =(gen ^gen) ~|([%cram-dynamic -.gen] !!)
$(gen gen)
::
$xray [~ (single (shut gen))]
^ [(malt (frontmatter p.gen)) (single (shut q.gen))]
==
::
++ single :: unwrap one-elem marl
|= xml/marl ^- manx
?: ?=({* $~} xml) i.xml
~|(%many-elems !!)
::
++ shut-mart :: xml attrs
|=({n/mane v/(list beer:hoon)} [n (turn v |=(a/beer:hoon ?^(a !! a)))])
::
++ shut :: as xml constant
|= gen/hoon ^- marl
?+ -.gen ~|([%bad-xml -.gen] !!)
$dbug $(gen q.gen)
::
$xray
[[n.g.p.gen (turn a.g.p.gen shut-mart)] $(gen [%smts c.p.gen])]~
::
$smts
?~ p.gen ~
=- (weld - $(p.gen t.p.gen))
?^ -.i.p.gen $(gen [%xray i.p.gen])
~| [%shut-tuna -.i.p.gen]
?+ -.i.p.gen !!
$manx ?>(?=($xray -.p.i.p.gen) $(gen p.i.p.gen))
$marl ?>(?=($smts -.p.i.p.gen) $(gen p.i.p.gen))
==
==
::
::
++ frontmatter :: parse ~[[%foo 1] [%bar ~s2]]
|= gen/hoon ^- (list {term dime})
?: ?=({$bust $null} gen) ~
?: ?=($dbug -.gen) $(gen q.gen)
?. ?=($clsg -.gen) ~|([%bad-frontmatter -.gen] !!)
%+ turn p.gen
|= gen/hoon
?. ?=(^ -.gen)
=/ gen ~(open ap gen)
?: =(gen ^gen) ~|([%bad-frontmatter-elem -.gen] !!)
$(gen gen)
=/ hed (as-dime p.gen)
?. =(%tas p.hed) ~|([%bad-frontmatter-key-type p.hed] !!)
[q.hed (as-dime q.gen)]
::
++ as-dime :: %foo ~.foo 0vbar etc
|= gen/hoon ^- dime
?: ?=($dbug -.gen) $(gen q.gen)
?. ?=({?($rock $sand) @ @} gen) ~|([%bad-literal gen] !!)
+.gen
--

2
lib/down-jet/parse.hoon
View File

@ -616,7 +616,7 @@
::
++ proc-inline :: parse inline kids
|= pac/_pars:inli :: cache
|= a/elem
|= a/elem ^+ a
?^ -.a a(q (flop (turn q.a ..$)))
?+ -.a a
$code

37
lib/gh-parse.hoon
View File

@ -79,6 +79,19 @@
'watchers'^ni
'default_branch'^so
==
++ commit
^- $-(json (unit commit:gh))
=+ jo
%- ot :~
'sha'^so
'url'^so
'author'^author
'committer'^author
'message'^so
'tree'^point
'parents'^(ar point)
'verification'^verification
==
++ user
^- $-(json (unit user:gh))
=+ jo
@ -128,6 +141,30 @@
'closed_at'^(mu so)
'body'^so
==
++ author
^- $-(json (unit author:gh))
=+ jo
%- ot :~
'date'^so
'name'^so
'email'^so
==
++ point
^- $-(json (unit point:gh))
=+ jo
%- ot :~
'url'^so
'sha'^so
==
++ verification
^- $-(json (unit verification:gh))
=+ jo
%- ot :~
'verified'^bo
'reason'^so
'signature'^(mu so)
'payload'^(mu so)
==
++ label
^- $-(json (unit label:gh))
=+ jo

1
lib/gmail.hoon
View File

@ -1 +0,0 @@
fd

605
lib/hall-json.hoon Normal file
View File

@ -0,0 +1,605 @@
::
:::: /lib/hall-json/hoon
::
/- hall
/+ old-zuse
=, hall
::
|_ bol/bowl:gall
++ en-tape ::> sur to tape
|%
++ circ ::> circle
|= a/circle
:(weld (scow %p hos.a) "/" (trip nom.a))
::
++ rang ::> range
|= a/range
?~ a ~
;: weld
"/" (scow hed.u.a)
?~ tal.u.a ~
(scow u.tal.u.a)
==
::
++ sorc ::> source
|= a/source
(weld (circ cir.a) (rang ran.a))
--
::
++ de-tape ::> tape to sur (parse)
|%
++ circ ::> circle
;~((glue fas) ;~(pfix sig fed:ag) urt:ab)
::
++ rang ::> range
=/ pont
;~ pose
(stag %ud dim:ag)
%+ stag %da
%+ sear
|= a/coin
^- (unit @da)
?. ?=({$$ $da @da} a) ~
`q.p.a
nuck:so
==
=+ ;~ pose
(cook some ;~(pfix fas pont))
(easy ~)
==
;~ pose
(cook some ;~(plug ;~(pfix fas pont) -))
(easy ~)
==
::
++ sorc ::> source
;~(plug circ rang)
--
::
++ enjs ::> sur to json
=, enjs:format
|%
::TODO these first few should probably make their way
:: into the stdlib...
++ sa ::> set as array
|* {a/(set) b/$-(* json)}
^- json
[%a (turn ~(tap in a) b)]
::
++ mo ::> map as object
|* {a/(map) b/$-(* @t) c/$-(* json)}
^- json
=- (pairs (turn ~(tap by a) -))
|* {k/* v/*} [(b k) (c v)]
::
++ lank ::> tank as string arr
|= a/tank
^- json
a+(turn (wash [0 1.024] a) tape)
::
++ dank ::> tank
|= a/tank
?: ?=($leaf -.a) (frond %leaf (tape p.a))
%+ frond -.a
%- pairs
?- -.a
$palm
:+ :- %style
%- pairs :~
mid+(tape p.p.a)
cap+(tape q.p.a)
open+(tape r.p.a)
close+(tape s.p.a)
==
lines+a+(turn q.a dank)
~
$rose
:+ :- %style
%- pairs :~
mid+(tape p.p.a)
open+(tape q.p.a)
close+(tape r.p.a)
==
lines+a+(turn q.a dank)
~
==
::
++ cord ::> string from cord
|= a/@t
s+a
::
++ mabe ::> null or value
|* {a/(unit) b/$-(* json)}
^- json
?~(a ~ (b u.a))
::
::> ||
::> || %query-models
::> ||
::> models relating to queries, their results and updates.
::+|
::
++ pici ::> prize-client
|= a/prize-client
^- json
%- pairs :~
:- %gys
=- (pairs ~(tap by (~(run by gys.a) -)))
|=((set (set circle)) (sa +< audi))
::
nis+(mo nis.a (cury scot %p) cord)
==
::
++ ruci ::> rumor-client
|= a/rumor-client
^- json
%+ frond -.a
?- -.a
$glyph (digy +.a)
$nick (dini +.a)
==
::
++ pack ::> package
|= a/package
^- json
%- pairs :~
nes+a+(turn nes.a enve) ::TODO maybe map
cos+(loby cos.a)
pes+(crow pes.a)
==
::
++ digy ::> diff-glyph
|= a/diff-glyph
^- json
%- pairs :~
bin+b+bin.a
gyf+s+gyf.a
aud+(audi aud.a)
==
::
++ dini ::> diff-nick
|= a/diff-nick
^- json
(pairs who+(ship who.a) nic+s+nic.a ~)
::
++ ruso ::> rumor-story
|= a/rumor-story
^- json
%+ frond -.a
?+ -.a !!
$new (conf cof.a)
:: $bear not needed
$config (pairs cir+(circ cir.a) dif+(dico dif.a) ~)
$status %- pairs :~
cir+(circ cir.a)
who+(ship who.a)
dif+(disa dif.a)
==
$remove b+&
$gram (enve nev.a)
==
::
++ dico ::> diff-config
|= a/diff-config
^- json
%+ frond -.a
?- -.a
$full (conf cof.a)
$source (pairs add+b+add.a src+(sorc src.a) ~)
$caption s+cap.a
$filter (filt fit.a)
$secure s+sec.a
$permit (pairs add+b+add.a sis+(sa sis.a ship) ~)
$remove b+&
==
::
++ disa ::> diff-status
|= a/diff-status
^- json
%+ frond -.a
?- -.a
$full (stat sat.a)
$presence s+pec.a
$human (dihu dif.a)
$remove b+&
==
::
++ dihu ::> diff-human
|= a/diff-human
^- json
%+ frond -.a
?- -.a
$full (huma man.a)
$handle (frond %han (mabe han.a cord))
$true (frond %tru (mabe tru.a trun))
==
::
::> ||
::> || %circles
::> ||
::> messaging targets and their metadata
::+|
::
++ circ ::> circle
|= a/circle
^- json
s+(crip (circ:en-tape a))
::
++ loby ::> lobby
|= a/lobby
%- pairs :~
loc+(conf loc.a)
rem+(mo rem.a (cork circ:en-tape crip) conf)
==
::
++ conf ::> config
|= a/config
^- json
%- pairs :~
src+(sa src.a sorc)
cap+s+cap.a
fit+(filt fit.a)
con+(cont con.a)
==
::
++ sorc ::> source
|= a/source
^- json
s+(crip (sorc:en-tape a))
::
++ filt ::> filter
|= a/filter
^- json
(pairs cas+b+cas.a utf+b+utf.a ~)
::
++ cont ::> control
|= a/control
^- json
(pairs sec+s+sec.a sis+(sa sis.a ship) ~)
::
++ crow ::> crowd
|= a/crowd
^- json
%- pairs :~
loc+(grop loc.a)
rem+(mo rem.a (cork circ:en-tape crip) grop)
==
::
++ grop ::> group
|= a/group
^- json
(mo a (cury scot %p) stat)
::
++ stat ::> status
|= a/status
^- json
(pairs pec+s+pec.a man+(huma man.a) ~)
::
++ huma ::> human
|= a/human
^- json
(pairs han+(mabe han.a cord) tru+(mabe tru.a trun) ~)
::
++ trun ::> truename
|= a/truename
^- json
(pairs fir+s+fir.a mid+(mabe mid.a cord) las+s+las.a ~)
::
::> ||
::> || %message-data
::> ||
::> structures for containing main message data
::+|
::
++ enve ::> envelope
|= a/envelope
^- json
(pairs num+(numb num.a) gam+(gram gam.a) ~)
::
++ gram ::> telegram
|= a/telegram
^- json
%- pairs :~
aut+(ship aut.a)
::TODO can we avoid this code duplication somehow?
uid+s+(scot %uv uid.a)
aud+(audi aud.a)
wen+(time wen.a)
sep+(spec sep.a)
==
::
++ thot ::> thought
|= a/thought
^- json
%- pairs :~
uid+s+(scot %uv uid.a)
aud+(audi aud.a)
wen+(time wen.a)
sep+(spec sep.a)
==
::
++ spec ::> speech
|= a/speech
^- json
:: only %url has just a single piece of data.
?: ?=($url -.a)
(frond %url s+(crip (apix:en-purl:html url.a)))
%+ frond -.a
%- pairs
?- -.a
$lin ~[pat+b+pat.a msg+s+msg.a]
$exp ~[exp+s+exp.a res+a+(turn res.a lank)]
$ire ~[top+s+(scot %uv top.a) sep+(spec sep.a)] ::TODO @uv as number?
$fat ~[tac+(atta tac.a) sep+(spec sep.a)]
$inv ~[inv+b+inv.a cir+(circ cir.a)]
$app ~[app+s+app.a sep+(spec sep.a)]
==
::
++ atta ::> attache
|= a/attache
^- json
%+ frond -.a
?- -.a
$name (pairs nom+s+nom.a tac+(atta tac.a) ~)
$text s+(of-wain:format +.a)
$tank a+(turn +.a lank)
==
::
::> ||
::> || %message-metadata
::> ||
::> structures for containing message metadata
::+|
::
++ audi ::> audience
|= a/audience
^- json
(sa a circ)
--
::
++ dejs ::> json to sur
=, dejs-soft:format
|%
::TODO these first few should maybe make their way
:: into the stdlib...
++ re ::> recursive reparsers
|* {gar/* sef/_|.(fist)}
|= jon/json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ as ::> array as set
|* a/fist
(cu ~(gas in *(set _(need *a))) (ar a))
::
++ dank ::> tank
^- $-(json (unit tank))
%+ re *tank |. ~+
%- of :~
leaf+sa
palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~)
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
::
::> ||
::> || %query-models
::> ||
::> models relating to queries, their results and updates.
::+|
::
++ pici ::> prize-client
^- $-(json (unit prize-client))
%- ot :~
gys+(om (as (as circ)))
nis+(op fed:ag so)
==
::
++ ruci ::> rumor-client
^- $-(json (unit rumor-client))
%- of :~
glyph+digy
nick+dini
==
::
++ pack ::> package
^- $-(json (unit package))
%- ot :~
nes+(ar enve)
cos+loby
pes+crow
==
::
++ digy ::> diff-glyph
^- $-(json (unit diff-glyph))
(ot bin+bo gyf+so aud+audi ~)
::
++ dini ::> diff-nick
^- $-(json (unit diff-nick))
(ot who+(su fed:ag) nic+so ~)
::
++ ruso ::> rumor-story
^- $-(json (unit rumor-story))
%- of :~
new+conf
:: bear not needed
config+(ot cir+circ dif+dico ~)
status+(ot cir+circ who+(su fed:ag) dif+disa ~)
remove+ul
gram+(ot src+circ nev+enve ~)
==
::
++ dico ::> diff-config
^- $-(json (unit diff-config))
%- of :~
full+conf
source+(ot add+bo src+sorc ~)
caption+so
filter+filt
secure+secu
permit+(ot add+bo sis+(as (su fed:ag)) ~)
remove+ul
==
::
++ disa ::> diff-status
^- $-(json (unit diff-status))
%- of :~
full+(ot pec+pres man+huma ~)
presence+pres
human+dihu
remove+ul
==
::
++ dihu ::> diff-human
^- $-(json (unit diff-human))
%- of :~
full+huma
handle+(mu so)
true+(mu trun)
==
::
::> ||
::> || %circles
::> ||
::> messaging targets and their metadata.
::+|
::
::TODO maybe just an object?
++ circ ::> circle
^- $-(json (unit circle))
(su circ:de-tape)
::
++ loby ::> lobby
^- $-(json (unit lobby))
(ot loc+conf rem+(op circ:de-tape conf) ~)
::
++ conf ::> config
^- $-(json (unit config))
%- ot :~
src+(as sorc)
cap+so
fit+filt
con+cont
==
::
::TODO maybe just an object?
++ sorc ::> source
^- $-(json (unit source))
(su sorc:de-tape)
::
++ filt ::> filter
^- $-(json (unit filter))
(ot cas+bo utf+bo ~)
::
++ cont ::> control
^- $-(json (unit control))
(ot sec+secu sis+(as (su fed:ag)) ~)
::
++ secu ::> security
^- $-(json (unit security))
(su (perk %channel %village %journal %mailbox ~))
::
++ crow ::> crowd
^- $-(json (unit crowd))
(ot loc+grop rem+(op circ:de-tape grop) ~)
::
++ grop ::> group
^- $-(json (unit group))
(op fed:ag stat)
::
++ stat ::> status
^- $-(json (unit status))
(ot pec+pres man+huma ~)
::
++ pres ::> presence
^- $-(json (unit presence))
(su (perk %gone %idle %hear %talk ~))
::
++ huma ::> human
^- $-(json (unit human))
(ot han+(mu so) tru+(mu trun) ~)
::
++ trun ::> truename
^- $-(json (unit truename))
(ot fir+so mid+(mu so) las+so ~)
::
::> ||
::> || %message-data
::> ||
::> structures for containing main message data.
::+|
::
++ enve ::> envelope
^- $-(json (unit envelope))
(ot num+ni gam+gram ~)
::
++ gram ::> telegram
^- $-(json (unit telegram))
%- ot :~
aut+(su fed:ag)
::TODO can we do anything about this duplication?
uid+seri
aud+audi
wen+di
sep+spec
==
::
++ thot ::> thought
^- $-(json (unit thought))
%- ot :~
uid+seri
aud+audi
wen+di
sep+spec
==
::
++ spec ::> speech
^- $-(json (unit speech))
%+ re *speech |. ~+
%- of :~
lin+(ot pat+bo msg+so ~)
url+(su aurf:de-purl:html)
exp+eval
ire+(ot top+seri sep+spec ~)
fat+(ot tac+atta sep+spec ~)
inv+(ot inv+bo cir+circ ~)
app+(ot app+so sep+spec ~)
==
::
++ eval ::> %exp speech
::> extract contents of an %exp speech, evaluating
::> the {exp} if there is no {res} yet.
::
|= a/json
^- (unit {cord (list tank)})
=+ exp=((ot exp+so ~) a)
?~ exp ~
:+ ~ u.exp
=+ res=((ot res+(ar dank) ~) a)
?^ res u.res
p:(mule |.([(sell (slap !>(..zuse:old-zuse) (ream u.exp)))]~)) ::TODO oldz
::
++ atta ::> attache
^- $-(json (unit attache))
%+ re *attache |. ~+
%- of :~
name+(ot nom+so tac+atta ~)
text+(cu to-wain:format so)
tank+(ar dank)
==
::
::> ||
::> || %message-metadata
::> ||
:: structures for containing message metadata.
::+|
::
++ seri ::> serial
^- $-(json (unit serial))
(ci (slat %uv) so)
::
++ audi ::> audience
^- $-(json (unit audience))
(as circ)
--
--

200
lib/hall-legacy.hoon Normal file
View File

@ -0,0 +1,200 @@
::
/? 310
/- hall
/+ old-zuse
[old-zuse .]
=>
|%
++ audience (map partner (pair envelope delivery)) :: destination+state
++ bouquet (set flavor) :: complete aroma
++ delivery :: delivery state
$? $pending :: undelivered
$received :: delivered
$rejected :: undeliverable
$released :: sent one-way
$accepted :: fully processed
== ::
++ envelope (pair ? (unit partner)) :: visible sender
++ flavor path :: content flavor
++ passport :: foreign flow
$% {$twitter p/@t} :: twitter
== ::
++ presence ?($gone $hear $talk) :: status type
++ speech :: narrative action
$% {$lan p/knot q/@t} :: local announce
{$exp p/@t} :: hoon line
{$non $~} :: no content (yo)
{$ext p/@tas q/*} :: extended action
{$fat p/torso q/speech} :: attachment
{$url p/purf} :: parsed url
{$ire p/serial q/speech} :: in-reply-to
{$lin p/? q/@t} :: no/@ text line
{$mor p/(list speech)} :: multiplex
{$app p/@tas q/@t} :: app message
$: $api :: api message
service/@tas :: service name
id/@t :: id on the service
id-url/purf :: link to id
summary/@t :: summary of event
body/@t :: body of event
url/purf :: link to event
meta/json :: other data for web
== ::
== ::
++ serial @uvH :: unique identity
++ partner (each station passport) :: interlocutor
++ statement (trel @da bouquet speech) :: when this
++ station (pair ship knot) :: domestic flow
++ telegram (pair ship thought) :: who which whom what
++ thought (trel serial audience statement) :: which whom what
++ torso :: attachment
$% {$name (pair @t torso)} :: named attachment
{$text (list @t)} :: text lines
{$tank (list tank)} :: tank list
== ::
--
|%
++ from-json
=> [jo ..telegram]
|= a/^json ^- (list telegram:hall)
=- %- zing
%+ turn
(need ((ar (ot ship+(su fed:ag) thought+thot ~)) a))
convert-telegram
|%
++ of
|* a/(pole {@tas fist})
|= b/^json
%. ((of:jo a) b)
%- slog
?+ b ~
{$o *}
%+ murn `(list {@tas fist})`a
|= {c/term d/fist} ^- (unit tank)
=+ (~(get by p.b) c)
?~ - ~
=+ (d u)
?~ - (some >[c u]<)
~
==
++ op :: parse keys of map
|* {fel/rule wit/fist}
%+ cu malt
%+ ci
|= a/(map cord _(need *wit))
^- (unit (list _[(wonk *fel) (need *wit)]))
(zl (turn ~(tap by a) (head-rush fel)))
(om wit)
::
++ as :: array as set
|* a/fist
(cu ~(gas in *(set _(need *a))) (ar a))
::
++ ke :: callbacks
|* {gar/* sef/_|.(fist)}
|= jon/^json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ lake |*(a/_* $-(^json (unit a)))
++ head-rush
|* a/rule
|* {cord *}
=+ nit=(rush +<- a)
?~ nit ~
(some [u.nit +>->])
::
++ thot
^- $-(^json (unit thought))
%- ot :~
serial+`$-(^json (unit serial))`(ci (slat %uv) so)
audience+`$-(^json (unit audience))`audi
statement+`$-(^json (unit statement))`stam
==
::
++ audi `$-(^json (unit audience))`(op parn memb)
++ auri (op parn (ci (soft presence) so))
++ memb ^- $-(^json (unit (pair envelope delivery)))
(ot envelope+lope delivery+(ci (soft delivery) so) ~)
++ lope (ot visible+bo sender+(mu (su parn)) ~)
::
++ parn
^- $-(nail (like partner))
%+ pick
;~((glue fas) ;~(pfix sig fed:ag) urs:ab)
%+ sear (soft passport)
;~((glue fas) sym urs:ab) :: XX [a-z0-9_]{1,15}
::
++ stam (ot date+di bouquet+(as (ar so)) speech+spec ~)
++ spec
%+ ke *speech |. ~+
%- of :~
lin+(ot say+bo txt+so ~)
url+(ot txt+(su aurf:urlp) ~)
exp+(ot txt+so ~)
app+(ot txt+so src+so ~)
fat+(ot tor+tors taf+spec ~)
ext+(ot nom+so txe+blob ~)
non+ul
mor+(ar spec)
:: inv+(ot ship+(su fed:ag) party+(su urs:ab) ~)
==
++ tors
%+ ke *torso |. ~+
%- of :~
name+(ot nom+so mon+tors ~)
text+(cu to-wain:format so)
tank+(ot dat+(cu (hard (list tank)) blob) ~)
==
::
++ blob (cu cue (su fel:ofis))
::
::
++ convert-telegram
|= t/telegram
^- (list telegram:hall)
=+ aud=(convert-audience q.q.t)
%+ turn (convert-speech r.r.q.t)
|= s/speech:hall
[p.t p.q.t aud p.r.q.t s]
::
++ convert-audience
|= a/audience
^- audience:hall
%- sy
^- (list circle:hall)
%+ murn ~(tap in ~(key by a))
|= p/partner
^- (unit circle:hall)
?- -.p
$& :+ ~ p.p.p
?: ?| =(q.p.p 'porch')
=(q.p.p 'court')
=(q.p.p 'floor')
==
%inbox
q.p.p
$| ~
==
::
++ convert-speech
|= s/speech
^- (list speech:hall)
?+ -.s ~&([%ignoring -.s] ~)
$lin [%lin !p.s q.s]~
$url [%url p.s]~
$exp [%exp p.s ~]~
$ire %+ turn (convert-speech q.s)
|= i/speech:hall
[%ire p.s i]
$app [%app p.s [%lin | q.s]]~
$fat ?: &(?=($exp -.q.s) ?=($tank -.p.s))
[%exp p.q.s +.p.s]~
=+ ses=(convert-speech q.s)
=? ses =(0 (lent ses)) [%lin | '']~
[[%fat p.s (snag 0 ses)] (slag 1 ses)]
$mor (zing (turn p.s convert-speech))
==
--
--

244
lib/hall.hoon Normal file
View File

@ -0,0 +1,244 @@
::
:::: /lib/hall/hoon
::
/- hall
::
::::
::
[. ^hall]
|_ bol/bowl:gall
::
::TODO add to zuse?
++ true-self
|= who/ship
?. ?=($earl (clan:title who)) who
(sein:title who)
::
++ above
|= who/ship
?: ?=($czar (clan:title who)) ~zod
(sein:title who)
::
++ said-url :: app url
|= url/purl:eyre
:^ ost.bol %poke /said-url
:+ [our.bol %hall] %hall-action
^- action
:+ %phrase
[[our.bol %inbox] ~ ~]
[%app dap.bol %lin | (crip (en-purl:html url))]~ :: XX
::
++ said :: app message
|= mes/(list tank)
:- %hall-action
^- action
:- %phrase
:- [[our.bol %inbox] ~ ~]
|- ^- (list speech)
?~ mes ~
:_ $(mes t.mes)
^- speech
[%app dap.bol %lin | (crip ~(ram re i.mes))]
::
++ uniq
^- {serial _eny.bol}
[(shaf %serial eny.bol) (shax eny.bol)]
::
++ range-to-path
:> msg range to path
:>
:> turns a range structure into a path used for
:> subscriptions.
::
|= ran/range
^- path
?~ ran ~
%+ welp
/(scot -.hed.u.ran +.hed.u.ran)
?~ tal.u.ran ~
/(scot -.u.tal.u.ran +.u.tal.u.ran)
::
++ path-to-range
:> path to msg range
:>
:> turns the tail of a subscription path into a
:> range structure, skipping over non-range terms.
::
|= pax/path
^- range
?~ pax ~
:: skip past non-number parts of path.
?: ?=({$~ $~} [(slaw %da i.pax) (slaw %ud i.pax)])
$(pax t.pax)
:+ ~
=+ hed=(slaw %da i.pax)
?^ hed [%da u.hed]
[%ud (slav %ud i.pax)]
?~ t.pax ~
:- ~
=+ tal=(slaw %da i.t.pax)
?^ tal [%da u.tal]
[%ud (slav %ud i.t.pax)]
::
++ change-glyphs :< ...
::
|= {gys/(jug char audience) bin/? gyf/char aud/audience}
^+ gys
:: simple bind.
?: bin (~(put ju gys) gyf aud)
:: unbind all of glyph.
?~ aud (~(del by gys) gyf)
:: unbind single.
(~(del ju gys) gyf aud)
::
++ change-nicks
:> change nick map
:>
:> changes a nickname in a map, adding if it doesn't
:> yet exist, removing if the nickname is empty.
::
|= {nis/(map ship cord) who/ship nic/cord}
^+ nis
?: =(nic '')
(~(del by nis) who)
(~(put by nis) who nic)
::
++ change-config
:> applies a config diff to the given config.
::
|= {cof/config dif/diff-config}
^+ cof
?- -.dif
$full cof.dif
$caption cof(cap cap.dif)
$filter cof(fit fit.dif)
$remove cof
::
$source
%= cof
src
%. src.dif
?: add.dif
~(put in src.cof)
~(del in src.cof)
==
::
$permit
%= cof
sis.con
%. sis.dif
?: add.dif
~(uni in sis.con.cof)
~(dif in sis.con.cof)
==
::
$secure
%= cof
sec.con
sec.dif
::
sis.con
?. .= ?=(?($white $green) sec.dif)
?=(?($white $green) sec.con.cof)
~
sis.con.cof
==
==
::
++ change-status
:> applies a status diff to the given status.
::
|= {sat/status dif/diff-status}
^+ sat
?- -.dif
$full sat.dif
$presence sat(pec pec.dif)
$remove sat
::
$human
%= sat
man
?- -.dif.dif
$full man.dif.dif
$true [han.man.sat tru.dif.dif]
$handle [han.dif.dif tru.man.sat]
==
==
==
::
::TODO annotate all!
++ depa :: de-pathing core
=> |% ++ grub * :: result
++ weir (list coin) :: parsed wire
++ fist $-(weir grub) :: reparser instance
--
|%
::
++ al
|* {hed/$-(coin *) tal/fist}
|= wir/weir ^+ [*hed *tal]
?~ wir !!
[(hed i.wir) (tal t.wir)]
::
++ at
|* typ/{@tas (pole @tas)}
=+ [i-typ t-typ]=typ
|= wer/weir
^- (tup:dray:wired i-typ t-typ) :: ie, (tup %p %tas ~) is {@p @tas}
?~ wer !!
?~ t-typ
?^ t.wer !!
((do i-typ) i.wer)
:- ((do i-typ) i.wer)
(^$(typ t-typ) t.wer)
::
++ mu :: true unit
|* wit/fist
|= wer/weir
?~(wer ~ (some (wit wer)))
::
++ af :: object as frond
|* buk/(pole {cord fist})
|= wer/weir
?> ?=({{$$ $tas @tas} *} wer)
?~ buk !!
=+ [[tag wit] t-buk]=buk
?: =(tag q.p.i.wer)
[tag ~|(tag+`@tas`tag (wit t.wer))]
?~ t-buk ~|(bad-tag+`@tas`q.p.i.wer !!)
(^$(buk t-buk) wer)
::
++ or
=+ tmp=|-($@(@tas {@tas $})) ::TODO typ/that syntax-errors...
|* typ/tmp
|= con/coin
::^- _(snag *@ (turn (limo typ) |*(a/@tas [a (odo:raid:wired a)])))
?> ?=($$ -.con)
=/ i-typ ?@(typ typ -.typ)
?: =(i-typ p.p.con)
:- i-typ
^- (odo:raid:wired i-typ)
q.p.con
?@ typ ~|(%bad-odor !!)
(^$(typ +.typ) con)
::
++ do
|* typ/@tas
=/ typecheck `@tas`typ
|= con/coin
^- (odo:raid:wired typ)
?. ?=($$ -.con) ~|(%not-dime !!)
?. =(typ p.p.con) ~|(bad-odor+`@tas`p.p.con !!)
q.p.con
::
++ ul :: null
|=(wer/weir ?~(wer ~ !!))
::
++ un
|* wit/$-(coin *)
|= wer/weir ^+ *wit
?~ wer !!
?^ t.wer !!
(wit i.wer)
--
--

85
lib/drum.hoon → lib/hood/drum.hoon
View File

@ -1,26 +1,26 @@
:: :: ::
:::: /hoon/drum/lib :: ::
:::: /hoon/drum/hood/lib :: ::
:: :: ::
/? 310 :: version
/- sole
/- sole, hall
/+ sole
[. ^sole]
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ drum-part {$drum $2 drum-pith-2} ::
++ drum-part-old {$drum $1 drum-pith-1} ::
++ part {$drum $2 pith-2} ::
++ part-old {$drum $1 pith-1} ::
:: ::
++ drum-pith-1 :: pre-style
%+ cork drum-pith-2 ::
|=(drum-pith-2 +<(bin *(map bone source-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
:: ::
++ drum-pith-2 ::
++ pith-2 ::
$: sys/(unit bone) :: local console
eel/(set gill:gall) :: connect to
ray/(set well:gall) ::
@ -60,8 +60,8 @@
== ::
++ target :: application target
$: $= blt :: curr & prev belts
%+ pair
(unit dill-belt:dill)
%+ pair
(unit dill-belt:dill)
(unit dill-belt:dill)
ris/(unit search) :: reverse-i-search
hit/history :: all past input
@ -79,22 +79,18 @@
^- (list well:gall)
=+ myr=(clan:title our)
?: ?=($pawn myr)
[[%base %talk] [%base %dojo] ~]
?: ?=($earl myr)
[[%home %dojo] ~]
[[%home %talk] [%home %dojo] ~]
[[%base %hall] [%base %talk] [%base %dojo] ~]
[[%home %hall] [%home %talk] [%home %dojo] ~]
::
++ deft-fish :: default connects
|= our/ship
%- ~(gas in *(set gill:gall))
^- (list gill:gall)
?: ?=($earl (clan:title our))
[[(sein:title our) %talk] [our %dojo] ~]
[[our %talk] [our %dojo] ~]
::
++ drum-make :: initial part
++ make :: initial part
|= our/ship
^- drum-part
^- part
:* %drum
%2
~ :: sys
@ -104,25 +100,26 @@
~ :: bin
== ::
::
++ drum-path :: encode path
|= gyl/gill:gall
::
++ en-gill :: gill to wire
|= gyl/gill:gall
^- wire
[%drum %phat (scot %p p.gyl) q.gyl ~]
::
++ drum-phat :: decode path
++ de-gill :: gill from wire
|= way/wire ^- gill:gall
?>(?=({@ @ $~} way) [(slav %p i.way) i.t.way])
--
::
::::
::
|= {hid/bowl:gall drum-part} :: main drum work
|= {hid/bowl:gall part} :: main drum work
=+ (fall (~(get by bin) ost.hid) *source)
=* dev -
=> |% :: arvo structures
++ pear :: request
$% {$sole-action p/sole-action} ::
{$talk-command command:talk} ::
{$hall-command command:hall} ::
== ::
++ lime :: update
$% {$dill-blit dill-blit:dill} ::
@ -140,7 +137,7 @@
++ diff-sole-effect-phat :: app event
|= {way/wire fec/sole-effect}
=< se-abet =< se-view
=+ gyl=(drum-phat way)
=+ gyl=(de-gill way)
?: (se-aint gyl) +>.$
(se-diff gyl fec)
::
@ -172,7 +169,7 @@
(se-klin gyl)
::
++ poke-exit :: shutdown
|= $~
|= $~
se-abet:(se-blit-sys `dill-blit:dill`[%qit ~])
::
++ poke-put :: write file
@ -182,7 +179,7 @@
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view
=+ gyl=(drum-phat way)
=+ gyl=(de-gill way)
?~ saw
(se-join gyl)
(se-dump:(se-drop & gyl) u.saw)
@ -191,7 +188,7 @@
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view
?~ saw +>
=+ gyl=(drum-phat way)
=+ gyl=(de-gill way)
?: (se-aint gyl) +>.$
%- se-dump:(se-drop & gyl)
:_ u.saw
@ -213,15 +210,15 @@
++ quit-phat ::
|= way/wire
=< se-abet =< se-view
=+ gyl=(drum-phat way)
=+ gyl=(de-gill way)
~& [%drum-quit src.hid ost.hid gyl]
(se-drop %| gyl)
:: :: ::
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip move drum-part)
=* pith +>+>+<+
^- (quip move part)
=* pith +<+.$
?. se-ably
=. . se-adit
[(flop moz) pith]
@ -353,7 +350,7 @@
++ se-dump :: print tanks
|= tac/(list tank)
^+ +>
?. se-ably (se-talk tac)
?. se-ably (se-hall tac)
=/ wol/wall
(zing (turn (flop tac) |=(a/tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
@ -387,7 +384,7 @@
|= bil/dill-blit:dill
+>(biz [bil biz])
::
++ se-blit-sys :: output to system
++ se-blit-sys :: output to system
|= bil/dill-blit:dill ^+ +>
?~ sys ~&(%se-blit-no-sys +>)
(se-emit [u.sys %diff %dill-blit bil])
@ -430,13 +427,13 @@
|= mov/move
%_(+> moz [mov moz])
::
++ se-talk
++ se-hall
|= tac/(list tank)
^+ +>
:: XX talk should be usable for stack traces, see urbit#584 which this change
:: XX hall should be usable for stack traces, see urbit#584 which this change
:: closed for the problems there
((slog (flop tac)) +>)
::(se-emit 0 %poke /drum/talk [our.hid %talk] (said:talk our.hid %drum now.hid eny.hid tac))
::(se-emit 0 %poke /drum/hall [our.hid %hall] (said:hall our.hid %drum now.hid eny.hid tac))
::
++ se-text :: return text
|= txt/tape
@ -444,21 +441,21 @@
?. ((sane %t) (crip txt)) :: XX upstream validation
~& bad-text+<`*`txt>
+>
?. se-ably (se-talk [%leaf txt]~)
?. se-ably (se-hall [%leaf txt]~)
(se-blit %out (tuba txt))
::
++ se-poke :: send a poke
|= {gyl/gill:gall par/pear}
(se-emit [ost.hid %poke (drum-path gyl) gyl par])
(se-emit [ost.hid %poke (en-gill gyl) gyl par])
::
++ se-peer :: send a peer
|= gyl/gill:gall
%- se-emit(fug (~(put by fug) gyl ~))
[ost.hid %peer (drum-path gyl) gyl /sole]
[ost.hid %peer (en-gill gyl) gyl /sole]
::
++ se-pull :: cancel subscription
|= gyl/gill:gall
(se-emit [ost.hid %pull (drum-path gyl) gyl ~])
(se-emit [ost.hid %pull (en-gill gyl) gyl ~])
::
++ se-tame :: switch connection
|= gyl/gill:gall
@ -472,7 +469,7 @@
::
++ ta :: per target
|_ {gyl/gill:gall target} :: app and state
++ ta-abet :: resolve
++ ta-abet :: resolve
^+ ..ta
..ta(fug (~(put by fug) gyl ``target`+<+))
::
@ -806,12 +803,12 @@
%_ pom
cad
;: welp
?. ?=($earl (clan:title p.gyl))
(cite:title p.gyl)
?. ?=($earl (clan:title p.gyl))
(cite:title p.gyl)
(scow %p p.gyl)
::
":"
(trip q.gyl)
":"
(trip q.gyl)
cad.pom
==
==

133
lib/helm.hoon → lib/hood/helm.hoon
View File

@ -1,23 +1,22 @@
:: :: ::
:::: /hoon/helm/lib :: ::
:::: /hoon/helm/hood/lib :: ::
:: :: ::
/? 310 :: version
/- sole
/+ talk
/- sole, hall
[. sole]
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ helm-part {$helm $0 helm-pith} :: helm state
++ helm-pith :: helm content
$: bur/(unit (pair ship mace:ames)) :: requesting ticket
hoc/(map bone helm-session) :: consoles
== ::
++ helm-session ::
++ part {$helm $0 pith} :: helm state
++ pith :: helm content
$: bur/(unit (pair ship mace:ames)) :: requesting ticket
hoc/(map bone session) :: consoles
== ::
++ session ::
$: say/sole-share :: console state
mud/(unit (sole-dialog @ud)) :: console dialog
== ::
== ::
:: :: ::
:::: :: ::
:: :: ::
@ -30,6 +29,9 @@
++ hood-init :: report init
$: him/ship ::
== ::
++ hood-nuke :: block/unblock
$: him/ship ::
== ::
++ hood-reset :: reset command
$~ ::
++ helm-verb :: reset command
@ -40,43 +42,46 @@
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:gall helm-part} :: main helm work
=+ sez=(fall (~(get by hoc) ost) *helm-session)
|= {bowl:gall part} :: main helm work
=+ sez=(fall (~(get by hoc) ost) *session)
=> |% :: arvo structures
++ card ::
$% {$cash wire p/@p q/buck:ames} ::
$% {$cash wire p/@p q/buck:ames} ::
{$conf wire dock $load ship term} ::
{$flog wire flog:dill} ::
{$funk wire @p @p @} ::
{$flog wire flog:dill} ::
{$funk wire @p @p @} ::
{$nuke wire ship} ::
{$serv wire ?(desk beam)} ::
{$poke wire dock pear} ::
{$wont wire sock path *} :: send message
{$want wire sock path *} :: send message
== ::
++ move (pair bone card) :: user-level move
++ pear :: poke fruit
$% {$hood-unsync desk ship desk} ::
{$talk-command command:talk} ::
{$ask-mail cord} ::
{$helm-hi cord} ::
{$drum-start well:gall} ::
{$hall-action action:hall} ::
== ::
--
|_ moz/(list move)
++ abet :: resolve
[(flop moz) %_(+>+>+<+ hoc (~(put by hoc) ost sez))]
[(flop moz) %_(+<+.$ hoc (~(put by hoc) ost sez))]
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
|= (list card)
|= (list card)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ poke-begin :: make/send keypair
|= hood-begin =< abet
?> ?=($~ bur)
~& [%poke-begin our his]
=+ buz=(shaz :(mix (jam ges) eny))
=+ loy=(pit:nu:crub:crypto 512 buz)
%- emit(bur `[his [0 sec:ex:loy]~])
[%wont /helm/ticket [our (sein:title his)] /a/ta his tic ges pub:ex:loy]
[%want /helm/ticket [our (sein:title his)] /a/ta his tic ges pub:ex:loy]
::
++ poke-spawn
|= {him/ship key/@pG} =< abet
@ -87,11 +92,15 @@
|= him/ship =< abet
(emit %flog /helm %crud %hax-init leaf+(scow %p him) ~)
::
++ poke-nuke :: initialize
|= him/ship =< abet
(emit %nuke /helm him)
::
++ poke-mass
|= $~ =< abet
(emit %flog /heft %crud %hax-heft ~)
::
++ poke-send-hi
++ poke-send-hi
|= {her/ship mes/(unit tape)} =< abet
%^ emit %poke /helm/hi/(scot %p her)
[[her %hood] %helm-hi ?~(mes '' (crip u.mes))]
@ -105,8 +114,15 @@
|= top/?(desk beam) =< abet
(emit %serv /helm/serv top)
::
++ poke-hi |=(mes/@t abet:(emit %flog /di %text "< {<src>}: {(trip mes)}"))
++ poke-atom
++ poke-hi
|= mes/@t
~| %poke-hi-fail
?: =(%fail mes)
~& %poke-hi-fail
!!
abet:(emit %flog /di %text "< {<src>}: {(trip mes)}")
::
++ poke-atom
|= ato/@
=+ len=(scow %ud (met 3 ato))
=+ gum=(scow %p (mug ato))
@ -142,24 +158,40 @@
?> ?=({{@ $~} $~} zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ zus==('z' tip)
=+ zus==('z' tip)
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))
[%flog /reload [%veer ?:(=('z' tip) %$ tip) way fil]]
::
++ poke-invite :: send invite; fake
|= {who/@p myl/@t} =< abet
%^ emit %poke /helm/invite
:- [our %talk]
(said:talk our %helm now eny [%leaf "invited: {<who>} at {(trip myl)}"]~)
::
++ poke-reset :: reset system
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/sys
:- [%flog /reset %vega (weld top /hoon) (weld top /arvo)]
%+ turn
^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%a /vane/ames]
[%b /vane/behn]
[%c /vane/clay]
[%d /vane/dill]
[%e /vane/eyre]
[%f /vane/ford]
[%g /vane/gall]
==
|= {p/@tas q/path}
=+ way=`path`(welp top q)
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
::
++ poke-meset :: reset system (new)
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/sys
=+ hun=.^(@ %cx (welp top /hoon/hoon))
=+ arv=.^(@ %cx (welp top /arvo/hoon))
=+ arv=.^(@ %cx (welp top /arvo/hoon))
:- [%flog /reset [%velo `@t`hun `@t`arv]]
:- =+ way=(weld top `path`/zuse)
[%flog /reset %veer %$ way .^(@ %cx (welp way /hoon))]
@ -179,10 +211,10 @@
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
::
++ poke-wyll :: hear certificate
++ poke-will :: hear certificate
|= wil/(unit wyll:ames)
?> ?=(^ bur)
?> ?=(^ wil)
?> ?=(^ wil)
=< abet
%- emil(bur ~)
:~ [%cash /helm p.u.bur q.u.bur u.wil]
@ -205,7 +237,38 @@
|= {way/wire chr/@tD tan/tank} =< abet
(emit %flog ~ %text chr ' ' ~(ram re tan))
::
++ take-woot :: result of %wont
++ take-woot :: result of %want
|= {way/wire her/ship cop/coop} =< abet
(emit %flog ~ %text "woot: {<[way cop]>}")
::
++ poke-tlon-init-web
|= met/ship =< abet
%- emil
%- flop
:~ ^- card
:^ %poke /helm/web/fora [our %hood]
[%drum-start q.byk %fora]
::
:^ %poke /helm/web/stream/create [our %hall]
:- %hall-action
:- %create
[%stream 'stream relay channel' %channel]
::
:^ %poke /helm/web/stream/filter [our %hall]
:- %hall-action
:- %filter
[%stream | |]
::
:^ %poke /helm/web/stream/source [our %hall]
:- %hall-action
:- %source
[%stream & [[[met %urbit-meta] `[da+(sub now ~d1) ~]] ~ ~]]
==
::
++ poke-tlon-add-stream
|= web/ship =< abet
%- emit
:^ %poke /helm/web/stream/source [our %hall]
:+ %hall-action %source
[%urbit-meta & [[[web %stream] `[da+now ~]] ~ ~]]
--

40
lib/kiln.hoon → lib/hood/kiln.hoon
View File

@ -1,5 +1,5 @@
:: :: ::
:::: /hoon/kiln/lib :: ::
:::: /hoon/kiln/hood/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
@ -9,9 +9,9 @@
=, space:userlib
=, format
|% :: ::
++ kiln-part {$kiln $0 kiln-pith} :: kiln state
++ kiln-pith ::
$: rem/(map desk kiln-desk) ::
++ part {$kiln $0 pith} :: kiln state
++ pith :: ::
$: rem/(map desk per-desk) ::
syn/(map kiln-sync {let/@ud ust/bone}) ::
autoload-on/? ::
cur-hoon/@uvI ::
@ -19,7 +19,7 @@
cur-zuse/@uvI ::
cur-vanes/(map @tas @uvI) ::
== ::
++ kiln-desk :: per-desk state
++ per-desk :: per-desk state
$: auto/? :: escalate on failure
gem/germ :: strategy
her/@p :: from ship
@ -56,7 +56,7 @@
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:gall kiln-part} :: main kiln work
|= {bowl:gall part} :: main kiln work
?> =(src our)
=> |% :: arvo structures
++ card ::
@ -73,7 +73,7 @@
{$warp wire sock riff} ::
== ::
++ pear :: poke fruit
$% {$talk-command command:talk} ::
$% {$hall-command command:hall} ::
{$kiln-merge kiln-merge} ::
{$helm-reload (list term)} ::
{$helm-reset $~} ::
@ -82,7 +82,7 @@
--
|_ moz/(list move)
++ abet :: resolve
[(flop moz) `kiln-part`+>+>->]
[(flop moz) `part`+<+.$]
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
@ -192,7 +192,7 @@
|%
++ emit |=(a/card +>(..autoload (^emit a)))
++ tracked-vanes
`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))
@ -254,12 +254,19 @@
+>.$
=. cur-vanes (~(put by cur-vanes) syd new-vane)
(emit [%poke /kiln/reload/[syd] [our %hood] %helm-reload ~[syd]])
::
++ coup-reload
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-reload-lame u.saw]
+>.$
--
::
++ poke-overload
|= tym/@dr
abet:(emit %wait /kiln/overload/(scot %dr tym) (add ~s10 now))
::
++ poke-wipe-ford |=($~ abet:(emit %wipe /kiln our ~))
::
++ take |=(way/wire ?>(?=({@ $~} way) (work i.way))) :: general handler
++ take-mere ::
|= {way/wire are/(each (set path) (pair term tang))}
@ -273,6 +280,15 @@
|= {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]
abet
::
++ take-mere-sync ::
|= {way/wire mes/(each (set path) (pair term tang))}
?> ?=({@ @ @ *} way)
@ -313,7 +329,7 @@
|= mes/(list tank)
((slog mes) ..spam)
:: %- emit :: XX not displayed/immediately
:: [%poke /kiln/spam [our %talk] (said our %kiln now eny mes)]
:: [%poke /kiln/spam [our %hall] (said our %kiln now eny mes)]
::
++ auto
|= kiln-sync
@ -404,9 +420,9 @@
::
++ work :: state machine
|= syd/desk
=+ ^- kiln-desk
=+ ^- per-desk
%+ fall (~(get by rem) syd)
=+ *kiln-desk
=+ *per-desk
%_(- cas [%da now])
|%
++ abet :: resolve

856
lib/hood/womb.hoon Normal file
View File

@ -0,0 +1,856 @@
:: :: ::
:::: /hoon/womb/hood/lib :: ::
:: :: ::
/? 310 :: version
/+ hall, old-phon
=, wired
=, title
:: :: ::
:::: :: ::
:: :: ::
|%
++ foil :: ship allocation map
|* a=mold :: entry mold
$: min/@u :: minimum entry
ctr/@u :: next allocated
und/(set @u) :: free under counter
ove/(set @u) :: alloc over counter
max/@u :: maximum entry
box/(map @u a) :: entries
== ::
-- ::
:: ::
:::: ::
:: ::
|% ::
++ managed :: managed plot
|* mold ::
%- unit :: unsplit
%+ each +< :: subdivided
mail :: delivered
:: ::
++ divided :: get division state
|* (managed) ::
?- +< ::
$~ ~ :: unsplit
{$~ $| *} ~ :: delivered
{$~ $& *} (some p.u.+<) :: subdivided
== ::
:: ::
++ moon (managed _!!) :: undivided moon
::
++ planet :: subdivided planet
(managed (lone (foil moon))) ::
:: ::
++ star :: subdivided star
(managed (pair (foil moon) (foil planet))) ::
:: ::
++ galaxy :: subdivided galaxy
(managed (trel (foil moon) (foil planet) (foil star)))::
:: ::
++ ticket @G :: old 64-bit ticket
++ passcode @uvH :: 128-bit passcode
++ passhash @uwH :: passocde hash
++ mail @t :: email address
++ balance :: invitation balance
$: planets/@ud :: planet count
stars/@ud :: star count
owner/mail :: owner's email
history/(list mail) :: transfer history
== ::
++ client :: per email
$: sta/@ud :: unused star refs
has/(set @p) :: planets owned
== ::
++ property :: subdivided plots
$: galaxies/(map @p galaxy) :: galaxy
planets/(map @p planet) :: star
stars/(map @p star) :: planet
== ::
++ invite ::
$: who/mail :: who to send to
pla/@ud :: planets to send
sta/@ud :: stars to send
wel/welcome :: welcome message
== ::
++ welcome :: welcome message
$: intro/tape :: in invite email
hello/tape :: as hall message
== ::
++ reference :: affiliate credit
(unit (each @p mail)) :: ship or email
:: ::
++ reference-rate 2 :: star refs per star
++ stat (pair live dist) :: external info
++ live ?($cold $seen $live) :: online status
++ dist :: allocation
$% {$free $~} :: unallocated
{$owned p/mail} :: granted, status
{$split p/(map ship stat)} :: all given ships
== ::
:: ::
++ ames-tell :: .^ a+/=tell= type
|^ {p/(list elem) q/(list elem)} ::
++ elem $^ {p/elem q/elem} ::
{term p/*} :: underspecified
-- ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|%
++ part {$womb $1 pith} :: womb state
++ pith :: womb content
$: boss/(unit ship) :: outside master
bureau/(map passhash balance) :: active invitations
office/property :: properties managed
hotel/(map (each ship mail) client) :: everyone we know
recycling/(map ship @) :: old ticket keys
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|% :: arvo structures
++ card ::
$% {$flog wire flog:dill} ::
{$info wire @p @tas nori:clay} :: fs write (backup)
:: {$wait $~} :: delay acknowledgment
{$diff gilt} :: subscription response
{$poke wire dock pear} :: app RPC
{$next wire p/ring} :: update private key
{$tick wire p/@pG q/@p} :: save ticket
{$knew wire p/ship q/wyll:ames} :: learn will (old pki)
== ::
++ pear ::
$% {$email mail tape wall} :: send email
{$womb-do-ticket ship} :: request ticket
{$womb-do-claim ship @p} :: issue ship
{$drum-put path @t} :: log transaction
== ::
++ gilt :: scry result
$% {$ships (list ship)} ::
{$womb-balance balance} ::
{$womb-balance-all (map passhash mail)} ::
{$womb-stat stat} ::
{$womb-stat-all (map ship stat)} ::
{$womb-ticket-info passcode ?($fail $good $used)} ::
==
++ move (pair bone card) :: user-level move
::
++ transaction :: logged poke
$% {$report her/@p wyl/wyll:ames}
{$release gal/@ud sta/@ud}
{$release-ships (list ship)}
{$claim aut/passcode her/@p}
{$recycle who/mail him/knot tik/knot}
{$bonus tid/cord pla/@ud sta/@ud}
{$invite tid/cord ref/reference inv/invite}
{$reinvite aut/passcode new/passcode inv/invite}
==
--
|%
++ ames-grab :: XX better ames scry
|= {a/term b/ames-tell} ^- *
=; all (~(got by all) a)
%- ~(gas by *(map term *))
%- zing
%+ turn (weld p.b q.b)
|= b/elem:ames-tell ^- (list {term *})
?@ -.b [b]~
(weld $(b p.b) $(b q.b))
::
++ murn-by
|* {a/(map) b/$-(* (unit))}
^+ ?~(a !! *(map _p.n.a _(need (b q.n.a))))
%- malt
%+ murn ~(tap by a)
?~ a $~
|= _c=n.a ^- (unit _[p.n.a (need (b q.n.a))])
=+ d=(b q.c)
?~(d ~ (some [p.c u.d]))
::
++ unsplit
|= a/(map ship (managed)) ^- (list {ship *})
%+ skim ~(tap by a)
|=({@ a/(managed)} ?=($~ a))
::
++ issuing
|* a/(map ship (managed))
^- (list [ship _(need (divided (~(got by a))))])
(sort ~(tap by (murn-by a divided)) lor)
::
++ issuing-under
|* {a/bloq b/ship c/(map @u (managed))}
^- (list [ship _(need (divided (~(got by c))))])
%+ turn (sort ~(tap by (murn-by c divided)) lor)
|*(d/{@u *} [(rep a b -.d ~) +.d])
++ cursor (pair (unit ship) @u)
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
::
:: Create new foil of size
++ fo-init
|= a/bloq :: ^- (foil *)
[min=1 ctr=1 und=~ ove=~ max=(dec (bex (bex a))) box=~]
::
++ fo
|_ (foil $@($~ *))
++ nth :: index
|= a/@u ^- (pair (unit @u) @u)
?: (lth a ~(wyt in und))
=+ out=(snag a (sort ~(tap in und) lth))
[(some out) 0]
=. a (sub a ~(wyt in und))
|- ^- {(unit @u) @u}
?: =(ctr +(max)) [~ a]
?: =(0 a) [(some ctr) a]
$(a (dec a), +<.nth new)
::
+- fin +< :: abet
++ new :: alloc
?: =(ctr +(max)) +<
=. ctr +(ctr)
?. (~(has in ove) ctr) +<
new(ove (~(del in ove) ctr))
::
+- get :: nullable
|= a/@p ^+ ?~(box ~ q.n.box)
(fall (~(get by box) (neis a)) ~)
::
+- put
|* {a/@u b/*} ^+ fin :: b/_(~(got by box))
~| put+[a fin]
?> (fit a)
=; adj adj(box (~(put by box) a b))
?: (~(has in box) a) fin
?: =(ctr a) new
?: (lth a ctr)
?. (~(has in und) a) fin
fin(und (~(del in und) a))
?. =(a ctr:new) :: heuristic
fin(ove (~(put in ove) a))
=+ n=new(+< new)
n(und (~(put in und.n) ctr))
::
++ fit |=(a/@u &((lte min a) (lte a max))) :: in range
++ gud :: invariant
?& (fit(max +(max)) ctr)
(~(all in und) fit(max ctr))
(~(all in ove) fit(min ctr))
(~(all in box) |=({a/@u *} (fit a)))
|- ^- ?
?: =(min max) &
=- &(- $(min +(min)))
%+ gte 1 :: at most one of
;: add
?:(=(min ctr) 1 0)
?:((~(has in und) min) 1 0)
?:((~(has in ove) min) 1 0)
?:((~(has by box) min) 1 0)
==
==
--
--
:: :: ::
:::: :: ::
:: :: ::
=+ cfg=[can-claim=| can-recycle=|] :: temporarily disabled
=+ [replay=| stat-no-email=|] :: XX globals
|= {bowl:gall part} :: main womb work
|_ moz/(list move)
++ abet :: resolve
^- (quip move part)
[(flop moz) +>+<+]
::
++ teba :: install resolved
|= a/(quip move part) ^+ +>
+>(moz (flop -.a), +>+<+ +.a)
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
|= (list card)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
::
++ take-n :: compute range
|= {{index/@u count/@u} get/$-(@u cursor)}
^- (list ship)
?~ count ~
%+ biff p:(get index)
|= a/ship ^- (list ship)
[a ^$(index +(index), count (dec count))]
::
++ available :: enumerate free ships
|= all/(map ship (managed)) ^- $-(@u cursor)
=+ pur=(sort (turn (unsplit all) head) lth)
=+ len=(lent pur)
|=(a/@u ?:((gte a len) [~ (sub a len)] [(some (snag a pur)) a]))
::
:: foil cursor to ship cursor, using sized parent
++ prefix
|= {a/bloq b/@p {c/(unit @u) d/@u}} ^- cursor
?~ c [c d]
[(some (rep a b u.c ~)) d]
::
++ in-list :: distribute among options
|* {a/(list) b/@u} ^+ [(snag *@ a) b]
=+ c=(lent a)
[(snag (mod b c) a) (div b c)]
::
++ ames-last-seen :: last succesful ping
|= a/ship ~+ ^- (unit time)
?: =(a our) (some now)
%- (hard (unit time))
~| ames-look+/(scot %p our)/tell/(scot %da now)/(scot %p a)
%+ ames-grab %rue
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
::
++ neighboured :: filter for connectivity
|* a/(list {ship *}) ^+ a
%+ skim a
|= {b/ship *}
?=(^ (ames-last-seen b))
::
++ shop-galaxies (available galaxies.office) :: unassigned %czar
::
:: Stars can be either whole or children of galaxies
++ shop-stars :: unassigned %king
|= nth/@u ^- cursor
=^ out nth %.(nth (available stars.office))
?^ out [out nth]
%+ shop-star nth
(neighboured (issuing galaxies.office))
::
++ shop-star :: star from galaxies
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
(prefix 3 who.sel (~(nth fo r.sel) nth))
::
++ shop-planets :: unassigned %duke
|= nth/@u ^- cursor
=^ out nth %.(nth (available planets.office))
?^ out [out nth]
=^ out nth
%+ shop-planet nth
(neighboured (issuing stars.office))
?^ out [out nth]
(shop-planet-gal nth (issuing galaxies.office))
::
++ shop-planet :: planet from stars
|= {nth/@u sta/(list {who/@p * q/(foil planet)})} ^- cursor
?: =(~ sta) [~ nth]
=^ sel nth (in-list sta nth)
(prefix 4 who.sel (~(nth fo q.sel) nth))
::
++ shop-planet-gal :: planet from galaxies
|= {nth/@u lax/(list {who/@p * * r/(foil star)})} ^- cursor
?: =(~ lax) [~ nth]
=^ sel nth (in-list lax nth)
%+ shop-planet nth
(neighboured (issuing-under 3 who.sel box.r.sel))
::
++ peek-x-shop :: available ships
|= tyl/path ^- (unit (unit {$ships (list @p)}))
=; a ~& peek-x-shop+[tyl a] a
=; res (some (some [%ships res]))
=+ [typ nth]=~|(bad-path+tyl (raid tyl typ=%tas nth=%ud ~))
:: =. nth (mul 3 nth)
?+ typ ~|(bad-type+typ !!)
$galaxies (take-n [nth 3] shop-galaxies)
$planets (take-n [nth 3] shop-planets)
$stars (take-n [nth 3] shop-stars)
==
::
++ get-managed-galaxy ~(got by galaxies.office) :: office read
++ mod-managed-galaxy :: office write
|= {who/@p mod/$-(galaxy galaxy)} ^+ +>
=+ gal=(mod (get-managed-galaxy who))
+>.$(galaxies.office (~(put by galaxies.office) who gal))
::
++ get-managed-star :: office read
|= who/@p ^- star
=+ (~(get by stars.office) who)
?^ - u
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-star+(sein who) !!)
(fall (~(get by box.r.p.u.gal) (neis who)) ~)
::
++ mod-managed-star :: office write
|= {who/@p mod/$-(star star)} ^+ +>
=+ sta=(mod (get-managed-star who)) :: XX double traverse
?: (~(has by stars.office) who)
+>.$(stars.office (~(put by stars.office) who sta))
%+ mod-managed-galaxy (sein who)
|= gal/galaxy ^- galaxy
?> ?=({$~ $& *} gal)
gal(r.p.u (~(put fo r.p.u.gal) (neis who) sta))
::
++ get-managed-planet :: office read
|= who/@p ^- planet
=+ (~(get by planets.office) who)
?^ - u
?: (~(has by galaxies.office) (sein who))
=+ gal=(get-managed-galaxy (sein who))
?. ?=({$~ $& *} gal) ~|(unavailable-galaxy+(sein who) !!)
(~(get fo q.p.u.gal) who)
=+ sta=(get-managed-star (sein who))
?. ?=({$~ $& *} sta) ~|(unavailable-star+(sein who) !!)
(~(get fo q.p.u.sta) who)
::
++ mod-managed-planet :: office write
|= {who/@p mod/$-(planet planet)} ^+ +>
=+ pla=(mod (get-managed-planet who)) :: XX double traverse
?: (~(has by planets.office) who)
+>.$(planets.office (~(put by planets.office) who pla))
?: (~(has by galaxies.office) (sein who))
%+ mod-managed-galaxy (sein who)
|= gal/galaxy ^- galaxy
?> ?=({$~ $& *} gal)
gal(q.p.u (~(put fo q.p.u.gal) (neis who) pla))
%+ mod-managed-star (sein who)
|= sta/star ^- star
?> ?=({$~ $& *} sta)
sta(q.p.u (~(put fo q.p.u.sta) (neis who) pla))
::
++ get-live :: last-heard time ++live
|= a/ship ^- live
=+ rue=(ames-last-seen a)
?~ rue %cold
?:((gth (sub now u.rue) ~m5) %seen %live)
::
++ stat-any :: unsplit status
|= {who/@p man/(managed _!!)} ^- stat
:- (get-live who)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned p.u.man]
::
++ stat-planet :: stat of planet
|= {who/@p man/planet} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
=+ pla=u:(divided man)
:- %split
%- malt
%+ turn ~(tap by box.p.pla)
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::
++ stat-star :: stat of star
|= {who/@p man/star} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
:- (get-live who)
=+ sta=u:(divided man)
:- %split
%- malt
%+ welp
%+ turn ~(tap by box.p.sta)
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
%+ turn ~(tap by box.q.sta)
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
++ stat-galaxy :: stat of galaxy
|= {who/@p man/galaxy} ^- stat
?. ?=({$~ $& ^} man) (stat-any who man)
=+ gal=u:(divided man)
:- (get-live who)
:- %split
%- malt
;: welp
%+ turn ~(tap by box.p.gal)
|=({a/@u b/moon} =+((rep 5 who a ~) [- (stat-any - b)]))
::
%+ turn ~(tap by box.q.gal)
|=({a/@u b/planet} =+((rep 4 who a ~) [- (stat-planet - b)]))
::
%+ turn ~(tap by box.r.gal)
|=({a/@u b/star} =+((rep 3 who a ~) [- (stat-star - b)]))
==
::
++ stats-ship :: inspect ship
|= who/@p ^- stat
?- (clan who)
$pawn !!
$earl !!
$duke (stat-planet who (get-managed-planet who))
$king (stat-star who (get-managed-star who))
$czar (stat-galaxy who (get-managed-galaxy who))
==
::
++ peek-x-stats :: inspect ship/system
|= tyl/path
?^ tyl
?> |(=(our src) =([~ src] boss)) :: privileged info
``womb-stat+(stats-ship ~|(bad-path+tyl (raid tyl who=%p ~)))
^- (unit (unit {$womb-stat-all (map ship stat)}))
=. stat-no-email & :: censor adresses
:^ ~ ~ %womb-stat-all
%- ~(uni by (~(urn by planets.office) stat-planet))
%- ~(uni by (~(urn by stars.office) stat-star))
(~(urn by galaxies.office) stat-galaxy)
::
++ peek-x-balance :: inspect invitation
|= tyl/path
?~ tyl
?> |(=(our src) =([~ src] boss)) :: priveledged
``[%womb-balance-all (~(run by bureau) |=(balance owner))]
^- (unit (unit {$womb-balance balance}))
=+ pas=~|(bad-path+tyl (raid tyl pas=%uv ~))
%- some
%+ bind (~(get by bureau) (shaf %pass pas))
|=(bal/balance [%womb-balance bal])
::
:: ++ old-phon ;~(pfix sig fed:ag:hoon151) :: library
++ parse-ticket
|= {a/knot b/knot} ^- {him/@ tik/@}
[him=(rash a old-phon) tik=(rash b old-phon)]
::
++ check-old-ticket
|= {a/ship b/@pG} ^- (unit ?)
%+ bind (~(get by recycling) (sein a))
|= key/@ ^- ?
=(b `@p`(end 6 1 (shaf %tick (mix a (shax key)))))
::
::
++ peek-x-ticket
|= tyl/path
^- (unit (unit {$womb-ticket-info passcode ?($fail $good $used)}))
?. ?=({@ @ $~} tyl) ~|(bad-path+tyl !!)
=+ [him tik]=(parse-ticket i.tyl i.t.tyl)
%+ bind (check-old-ticket him tik)
|= gud/?
:+ ~ %womb-ticket-info
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:- pas
?. gud %fail
?: (~(has by bureau) (shaf %pass pas)) %used
%good
::
++ peer-scry-x :: subscription like .^
|= tyl/path
=< abet
=+ gil=(peek-x tyl)
~| tyl
?~ gil ~|(%block-stub !!)
?~ u.gil ~|(%bad-path !!)
(emit %diff u.u.gil)
::
++ peek-x :: stateless read
|= tyl/path ^- (unit (unit gilt))
~| peek+x+tyl
?~ tyl ~
?+ -.tyl ~
:: /shop/planets/@ud (list @p) up to 3 planets
:: /shop/stars/@ud (list @p) up to 3 stars
:: /shop/galaxies/@ud (list @p) up to 3 galaxies
$shop (peek-x-shop +.tyl)
:: /stats general stats dump
:: /stats/@p what we know about @p
$stats (peek-x-stats +.tyl)
:: /balance all invitations
:: /balance/passcode invitation status
$balance (peek-x-balance +.tyl)
:: /ticket/ship/ticket check ticket usability
$ticket (peek-x-ticket +.tyl)
==
::
++ poke-manage-old-key :: add to recyclable tickets
|= {a/ship b/@}
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
.(recycling (~(put by recycling) a b))
::
++ poke-manage :: add to property
|= a/(list ship)
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
|-
?~ a .
?+ (clan i.a) ~|(bad-size+(clan i.a) !!)
$duke
?. (~(has by planets.office) i.a)
$(a t.a, planets.office (~(put by planets.office) i.a ~))
~|(already-managing+i.a !!)
::
$king
?. (~(has by stars.office) i.a)
$(a t.a, stars.office (~(put by stars.office) i.a ~))
~|(already-managing+i.a !!)
::
$czar
?. (~(has by galaxies.office) i.a)
$(a t.a, galaxies.office (~(put by galaxies.office) i.a ~))
~|(already-managing+i.a !!)
==
::
++ email :: send email
|= {wir/wire adr/mail msg/tape} ^+ +>
?: replay +> :: dont's send email in replay mode
~& do-email+[adr msg]
::~&([%email-stub adr msg] +>)
(emit %poke womb+[%mail wir] [our %gmail] %email adr "Your Urbit Invitation" [msg]~)
::
++ log-transaction :: logged poke
|= a/transaction ^+ +>
?: replay +>
(emit %poke /womb/log [our %hood] %drum-put /womb-events/(scot %da now)/hoon (crip <eny a>))
::
++ poke-replay-log :: rerun transactions
|= a/(list {eny/@uvJ pok/transaction})
?~ a abet
~& womb-replay+-.pok.i.a
=. eny eny.i.a
=. replay &
%_ $
a t.a
+>
?- -.pok.i.a
$claim (teba (poke-claim +.pok.i.a))
$bonus (teba (poke-bonus +.pok.i.a))
$invite (teba (poke-invite +.pok.i.a))
$report (teba (poke-report +.pok.i.a))
$release (teba (poke-release +.pok.i.a))
$recycle (teba (poke-recycle +.pok.i.a))
$reinvite (teba (poke-reinvite +.pok.i.a))
$release-ships (teba (poke-release-ships +.pok.i.a))
==
==
::
++ poke-bonus :: expand invitation
|= {tid/cord pla/@ud sta/@ud}
=< abet
=. log-transaction (log-transaction %bonus +<)
?> |(=(our src) =([~ src] boss)) :: priveledged
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
%_ .
bureau
%+ ~(put by bureau) (shaf %pass pas)
=/ bal ~|(%bad-passcode (~(got by bureau) (shaf %pass pas)))
bal(planets (add pla planets.bal), stars (add sta stars.bal))
==
::
++ poke-invite :: create invitation
|= {tid/cord ref/reference inv/invite}
=< abet
=. log-transaction (log-transaction %invite +<)
=. hotel
?~ ref hotel
?~ sta.inv hotel
%+ ~(put by hotel) u.ref
=+ cli=(fall (~(get by hotel) u.ref) *client)
cli(sta +(sta.cli))
(invite-from ~ tid inv)
::
++ invite-from :: traced invitation
|= {hiz/(list mail) tid/cord inv/invite} ^+ +>
?> |(=(our src) =([~ src] boss)) :: priveledged
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
?: (~(has by bureau) (shaf %pass pas))
~|([%duplicate-passcode pas who.inv replay=replay] !!)
=. bureau (~(put by bureau) (shaf %pass pas) [pla.inv sta.inv who.inv hiz])
(email /invite who.inv intro.wel.inv)
::
:: ++ coup-invite :: invite sent
::
++ poke-reinvite :: split invitation
|= {aut/passcode new/passcode inv/invite} :: further invite
=< abet
=. log-transaction (log-transaction %reinvite +<)
?> =(src src) :: self-authenticated
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
=. stars.bal (sub stars.bal sta.inv)
=. planets.bal (sub planets.bal pla.inv)
=. bureau (~(put by bureau) (shaf %pass aut) bal)
=+ tid=(scot %uv new)
(invite-from [owner.bal history.bal] (scot %uv new) inv)
::
++ poke-obey :: set/reset boss
|= who/(unit @p)
=< abet
?> =(our src) :: me only
.(boss who)
::
++ poke-save :: write backup
|= pax/path
=< abet
?> =(our src) :: me only
=+ pas=`@uw`(shas %back eny)
~& [%backing-up pas=pas]
=; dif (emit %info /backup [our dif])
%+ foal:space:userlib
(welp pax /jam-crub)
[%jam-crub !>((en:crub:crypto pas (jam `part`+:abet)))]
::
++ poke-rekey :: extend wyll
|= $~
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
:: (emit /rekey %next sec:ex:(pit:nu:crub 512 (shaz (mix %next (shaz eny)))))
~& %rekey-stub .
::
++ poke-report :: report wyll
|= {her/@p wyl/wyll:ames} ::
=< abet
=. log-transaction (log-transaction %report +<)
?> =(src src) :: self-authenticated
(emit %knew /report her wyl)
::
++ use-reference :: bonus stars
|= a/(each @p mail) ^- (unit _+>)
?. (~(has by hotel) a) ~
=+ cli=(~(get by hotel) a)
?~ cli ~
?. (gte sta.u.cli reference-rate) ~
=. sta.u.cli (sub sta.u.cli reference-rate)
`+>.$(hotel (~(put by hotel) a u.cli))
::
++ poke-do-ticket :: issue child ticket
|= her/ship
=< abet
?> =(our (sein her))
?> |(=(our src) =([~ src] boss)) :: privileged
=+ tik=.^(@p %a /(scot %p our)/tick/(scot %da now)/(scot %p her))
:: =. emit (emit /tick %tick tik her)
(emit %poke /womb/tick [src %hood] [%womb-do-claim her tik]) :: XX peek result
::
++ needy
|* a/(each * tang)
?- -.a
$& p.a
$| ((slog (flop p.a)) (mean p.a))
==
::
++ poke-do-claim :: deliver ticket
|= {her/ship tik/@p}
=< abet
^+ +>
?> =(src (sein her)) :: from the parent which could ticket
=+ sta=(stats-ship her)
?> ?=($cold p.sta) :: a ship not yet started
?- -.q.sta
$free !! :: but allocated
$owned :: to an email
(email /ticket p.q.sta "Ticket for {<her>}: {<`@pG`tik>}")
::
$split :: or ship distribution
%.(+>.$ (slog leaf+"Ticket for {<her>}: {<`@pG`tik>}" ~)) :: XX emit via console formally?
==
::
++ poke-recycle :: save ticket as balance
|= {who/mail him-t/knot tik-t/knot}
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
=< abet
=. log-transaction (log-transaction %recycle +<)
?> =(src src)
=+ [him tik]=(parse-ticket him-t tik-t)
?> (need (check-old-ticket him tik))
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
?: (~(has by bureau) (shaf %pass pas))
~|(already-recycled+[him-t tik-t] !!)
=+ bal=`balance`?+((clan him) !! $duke [1 0 who ~], $king [0 1 who ~])
.(bureau (~(put by bureau) (shaf %pass pas) bal))
::
++ poke-claim :: claim plot, req ticket
|= {aut/passcode her/@p}
?. can-claim.cfg ~|(%ticketing-offline !!)
=< abet
=. log-transaction (log-transaction %claim +<)
?> =(src src)
(claim-any aut her)
::
++ claim-any :: register
|= {aut/passcode her/@p}
=; claimed
:: =. claimed (emit.claimed %wait $~) :: XX delay ack
(emit.claimed %poke /womb/tick [(sein her) %hood] [%womb-do-ticket her])
=+ ~|(%bad-passcode bal=(~(got by bureau) (shaf %pass aut)))
?+ (clan her) ~|(bad-size+(clan her) !!)
$king
=; all (claim-star.all owner.bal her)
=+ (use-reference &+src)
?^ - u :: prefer using references
=+ (use-reference |+owner.bal)
?^ - u
=. stars.bal ~|(%no-stars (dec stars.bal))
+>.$(bureau (~(put by bureau) (shaf %pass aut) bal))
::
$duke
=. planets.bal ~|(%no-planets (dec planets.bal))
=. bureau (~(put by bureau) (shaf %pass aut) bal)
(claim-planet owner.bal her)
==
::
++ claim-star :: register
|= {who/mail her/@p} ^+ +>
%+ mod-managed-star her
|= a/star ^- star
?^ a ~|(impure-star+[her ?:(-.u.a %owned %split)] !!)
(some %| who)
::
++ claim-planet :: register
|= {who/mail her/@p} ^+ +>
=. hotel
%+ ~(put by hotel) |+who
=+ cli=(fall (~(get by hotel) |+who) *client)
cli(has (~(put in has.cli) her))
%+ mod-managed-planet her
|= a/planet ^- planet
?^ a ~|(impure-planet+[her ?:(-.u.a %owned %split)] !!)
(some %| who)
::
++ poke-release-ships :: release specific
|= a/(list ship)
=< abet ^+ +>
=. log-transaction (log-transaction %release-ships +<)
?> =(our src) :: privileged
%+ roll a
=+ [who=*@p res=+>.$]
|. ^+ res
?+ (clan who) ~|(bad-size+(clan who) !!)
$king (release-star who res)
$czar (release-galaxy who res)
==
::
++ poke-release :: release to subdivide
|= {gal/@ud sta/@ud} ::
=< abet ^+ +>
=. log-transaction (log-transaction %release +<)
?> =(our src) :: privileged
=. +>
?~ gal +>
=+ all=(take-n [0 gal] shop-galaxies)
?. (gth gal (lent all))
(roll all release-galaxy)
~|(too-few-galaxies+[want=gal has=(lent all)] !!)
^+ +>
?~ sta +>
=+ all=(take-n [0 sta] shop-stars)
~& got-stars+all
%- (slog leaf+"For issuing to proceed smoothly, immediately upon boot, ".
"each should |obey {<our>} to honor ticket requests." ~)
?. (gth sta (lent all))
(roll all release-star)
~|(too-few-stars+[want=sta has=(lent all)] !!)
::
++ release-galaxy :: subdivide %czar
=+ [who=*@p res=.]
|. ^+ res
%+ mod-managed-galaxy:res who
|= gal/galaxy ^- galaxy
~& release+who
?^ gal ~|(already-used+who !!)
(some %& (fo-init 5) (fo-init 4) (fo-init 3))
::
++ release-star :: subdivide %king
=+ [who=*@p res=.]
|. ^+ res
=. res
%- emit.res
[%poke /womb/tick [(sein who) %hood] [%womb-do-ticket who]]
%+ mod-managed-star:res who
|= sta/star ^- star
~& release+who
?^ sta ~|(already-used+[who u.sta] !!)
(some %& (fo-init 5) (fo-init 4))
--

7
lib/write.hoon → lib/hood/write.hoon
View File

@ -1,6 +1,6 @@
:: File writer module
::
:::: /hoon/write/lib
:::: /hoon/write/hood/lib
::
/? 310
/- plan-diff, plan-acct
@ -53,8 +53,11 @@
|= dif/plan-diff ^+ abet
?. =(our src)
~|(foreign-write+[our=our src=src] !!)
=/ sev
=+ .^(path %e /(scot %p our)/serv/(scot %da now))
?>(?=({@tas @tas *} -) -)
=; sob/soba:clay
?~(sob abet abet:(emit %info write+~ our `toro:clay`[q.byk %& sob]))
?~(sob abet abet:(emit %info write+~ our `toro:clay`[i.t.sev %& sob]))
=+ pax=`path`/web/plan
=+ paf=(en-beam beak-now (flop pax))
?~ [fil:.^(arch %cy paf)]

12
lib/http.hoon
View File

@ -12,18 +12,18 @@
$: domain/(list cord)
end-point/path
req-type/$?($get {$post p/json})
headers/math
queries/quay
headers/math:eyre
queries/quay:eyre
==
++ send
|= {ost/bone pour-path/wire params/request}
:^ ost %them pour-path
`(unit hiss)`[~ (request-to-hiss params)]
`(unit hiss:eyre)`[~ (request-to-hiss params)]
::
++ request-to-hiss
|= request ^- hiss
|= request ^- hiss:eyre
=- ~& hiss=- -
:- ^- parsed-url/purl
:- ^- parsed-url/purl:eyre
:+ :+ security=%.y
port=~
host=[%.y [path=domain]]
@ -31,5 +31,5 @@
q-strings=queries :: ++quay
?@ req-type
[%get headers ~]
[%post headers ~ (as-octt (en-json p.req-type))]
[%post headers ~ (as-octt:mimes:html (en-json p.req-type))]
--

504
lib/new-hoon.hoon
View File

File diff suppressed because it is too large Load Diff

46
lib/oauth1.hoon
View File

@ -12,7 +12,7 @@
$% {$request-token oauth-token/@t token-secret/@t} :: intermediate
{$access-token oauth-token/@t token-secret/@t} :: full
==
++ quay-enc (list tape):quay :: partially rendered query string
++ quay-enc (list tape) :: partially rendered query string
--
::
::::
@ -26,23 +26,26 @@
::
++ joint :: between every pair
|= {a/tape b/wall} ^- tape
?~(b b |-(?~(t.b i.b :(weld i.b a $(b t.b)))))
?~ b b
|- ^- tape
?~ t.b i.b
:(weld i.b a $(b t.b))
::
++ join-urle |=(a/(list tape) (joint "&" (turn a urle)))
++ join-en-urle |=(a/(list tape) (joint "&" (turn a en-urlt:html)))
:: query string in oauth1 'k1="v1", k2="v2"' form
++ to-header
|= a/quay ^- tape
%+ joint ", "
(turn a |=({k/@t v/@t} `tape`~[k '="' v '"'])) :: normalized later
::
:: partial tail:earn for sorting
:: partial tail:en-purl:html for sorting
++ encode-pairs
|= a/quay ^- quay-enc
%+ turn a
|= {k/@t v/@t} ^- tape
:(weld (urle (trip k)) "=" (urle (trip v)))
:(weld (en-urlt:html (trip k)) "=" (en-urlt:html (trip v)))
::
++ parse-pairs :: x-form-urlencoded
++ parse-pairs :: x-form-en-urlt:htmlncoded
|= bod/(unit octs) ^- quay-enc
~| %parsing-body
?~ bod ~
@ -51,21 +54,21 @@
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:earn b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:en-purl:html b))))]
(my content-type+['application/x-www-form-en-urlt:htmlncoded']~ ~)
::
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
=- (mean (flop `tang`[>a< -]))
(turn (to-wain (crip b)) |=(c/cord leaf+(trip c)))
(turn (to-wain:format (crip b)) |=(c/cord leaf+(trip c)))
::
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ quay-keys |-($@(knot {$ $})) :: improper tree
++ grab-quay :: ?=({@t @t @t} (grab-quay r:*httr %key1 %key2 %key3))
|* {a/(unit octs) b/quay-keys}
=+ ~| bad-quay+a
c=(rash q:(need `(unit octs)`a) yquy:urlp)
c=(rash q:(need `(unit octs)`a) yquy:de-purl:html)
~| grab-quay+[c b]
=+ all=(malt c)
%. b
@ -83,7 +86,7 @@
^- {key/@t sec/@t $~}
?. =(~ `@`key)
~| %oauth-bad-keys
((hard {key/@t sec/@t $~}) (to-wain key))
((hard {key/@t sec/@t $~}) (to-wain:format key))
%+ mean-wall %oauth-no-keys
"""
Run |init-oauth1 {<`path`dom>}
@ -102,8 +105,8 @@
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ oauth-callback
~& [%oauth-warning "Make sure this urbit ".
"is running on {(earn our-host `~ ~)}"]
%- crip %- earn
"is running on {(en-purl:html our-host `~ ~)}"]
%- crip %- en-purl:html
%^ into-url:interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
@ -135,7 +138,8 @@
?: =(usr nam) &
=< |
%- %*(. slog pri 1)
(flop p:(mule |.(~|(wrong-user+[req=usr got=nam] !!))))
:: XX cgyarvin should figure out why we need to cast to $~
(flop p:(mule |.(~|(wrong-user+[req=usr got=nam] `$~`!!))))
::
++ check-token-quay
|= a/quay ^+ %&
@ -164,7 +168,7 @@
(encode-pairs (weld auq quy))
=+ bay=(base-string med url qen)
=+ sig=(sign signing-key bay)
=. auq ['oauth_signature'^(crip (urle sig)) auq]
=. auq ['oauth_signature'^(crip (en-urlt:html sig)) auq]
(crip "OAuth {(to-header auq)}")
::
++ computed-query
@ -172,24 +176,24 @@
:~ oauth-consumer-key+consumer-key
oauth-nonce+(scot %uw (shaf %non eny))
oauth-signature-method+'HMAC-SHA1'
oauth-timestamp+(rsh 3 2 (scot %ui (unt now)))
oauth-timestamp+(rsh 3 2 (scot %ui (unt:chrono:userlib now)))
oauth-version+'1.0'
==
++ base-string
|= {med/meth url/purl qen/quay-enc} ^- tape
=. qen (sort qen aor)
%- join-urle
%- join-en-urle
:~ (cuss (trip `@t`med))
(earn url)
(en-purl:html url)
(joint "&" qen)
==
++ sign
|= {key/cord bay/tape} ^- tape
(sifo (swap 3 (hmac key (crip bay))))
(en-base64:mimes:html (swp 3 (hmac:crypto key (crip bay))))
::
++ signing-key
%- crip
%- join-urle :~
%- join-en-urle :~
(trip consumer-secret)
(trip ?^(tok token-secret.tok ''))
==
@ -199,7 +203,7 @@
|= {extra/quay request/{url/purl meth hed/math (unit octs)}}
^- hiss
:: =. url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-header+(earn url.request)
~& add-auth-header+(en-purl:html url.request)
%_ request
hed
(~(add ja hed.request) %authorization (header:auth extra request))

66
lib/oauth2.hoon
View File

@ -2,10 +2,12 @@
::
:::: /hoon/oauth2/lib
::
/+ hep-to-cab, interpolate
/+ hep-to-cab, interpolate, old-zuse
=, old-zuse
=, eyre
=, mimes:html
=, html
=, format
|%
++ parse-url parse-url:interpolate
++ join
@ -16,8 +18,15 @@
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:earn b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:en-purl b))))]
%^ my
:+ %accept
'application/json'
~
:+ %content-type
'application/x-www-form-urlencoded'
~
~
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
@ -26,12 +35,27 @@
::
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ grab-json
|* {a/httr b/fist:jo}
|* {a/httr b/fist:dejs-soft:format}
~| bad-json+r.a
~| (de-json q:(need r.a))
(need (;~(biff de-json b) q:(need r.a)))
--
::
::::
::
:: XX belongs back in zuse
|%
++ pack :: light path encoding
|= {a/term b/path} ^- knot
%+ rap 3 :- (wack a)
(turn b |=(c/knot (cat 3 '_' (wack c))))
::
++ pick :: light path decoding
=+ fel=(most cab (sear wick urt:ab))
|=(a/knot `(unit {p/term q/path})`(rush a fel))
::
--
::
::::
::
|%
@ -44,10 +68,10 @@
::::
::
=+ state-usr=|
|_ {(bale keys) tok/token}
|_ {(bale:eyre keys) tok/token}
++ client-id cid:decode-keys
++ client-secret cis:decode-keys
++ decode-keys :: XX from bale w/ typed %jael
++ decode-keys :: XX from bale:eyre w/ typed %jael
^- {cid/@t cis/@t $~}
?. =(~ `@`key)
~| %oauth-bad-keys
@ -62,7 +86,7 @@
++ auth-url
|= {scopes/(list @t) url/$@(@t purl)} ^- purl
~& [%oauth-warning "Make sure this urbit ".
"is running on {(earn our-host `~ ~)}"]
"is running on {(en-purl our-host `~ ~)}"]
%+ add-query:interpolate url
%- quay:hep-to-cab
:~ state+?.(state-usr '' (pack usr /''))
@ -71,9 +95,15 @@
scope+(join ' ' scopes)
==
::
:: XX duplicated from eyre
++ pack :: light path encoding
|= {a/term b/path} ^- knot
%+ rap 3 :- (wack a)
(turn b |=(c/knot (cat 3 '_' (wack c))))
::
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ redirect-uri
%- crip %- earn
%- crip %- en-purl
%^ into-url:interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
@ -97,15 +127,17 @@
::
++ grab-token
|= a/httr ^- axs/@t
(grab-json a (ot 'access_token'^so ~):jo)
(grab-json a (ot 'access_token'^so ~):dejs-soft:format)
::
++ grab-expiring-token
|= a/httr ^- {axs/@t exp/@u}
(grab-json a (ot 'access_token'^so 'expires_in'^ni ~):jo)
(grab-json a (ot 'access_token'^so 'expires_in'^ni ~):dejs-soft:format)
::
++ grab-both-tokens
|= a/httr ^- {axs/@t exp/@u ref/@t}
(grab-json a (ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~):jo)
%+ grab-json a
=, dejs-soft:format
(ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~)
::
++ auth
?~ tok ~|(%no-bearer-token !!)
@ -118,14 +150,14 @@
|= request/{url/purl meth hed/math (unit octs)}
^+ request
:: =. p.url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-header+(earn url.request)
~& add-auth-header+(en-purl url.request)
request(hed (~(add ja hed.request) %authorization header:auth))
::
++ add-auth-query
|= {token-name/cord request/{url/purl meth math (unit octs)}}
^+ request
:: =. p.url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-query+(earn url.request)
~& add-auth-query+(en-purl url.request)
request(r.url [[token-name query:auth] r.url.request])
::
++ re
@ -255,7 +287,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
:: ++ out
:: %+ out-add-header:aut scope=/full
@ -279,7 +311,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++ aut ~(. oauth2 bal tok)
:: ++ out :: add header
:: =+ aut
@ -316,7 +348,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2 ref/refresh:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2 ref/refresh:oauth2}
:: ++ aut
:: %^ ~(standard-refreshing oauth2 bal tok) . ref
:: |=({tok/token ref/refresh}:oauth2 +>(tok tok, ref ref))
@ -343,7 +375,7 @@
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) axs/token:oauth2 ref/refresh:oauth2}
:: |_ {bal/(bale:eyre keys:oauth2) axs/token:oauth2 ref/refresh:oauth2}
:: ++ aut ~(. oauth2 bal axs)
:: ++ exchange-url 'https://my-api.com/access_token'
:: ++ out :: refresh or add header

22
lib/old-zuse.hoon
View File

@ -7,10 +7,6 @@
++ fu fu:number :: modulo (mul p q)
++ aes aes:crypto :: aes, all sizes
++ crua crua:crypto :: cryptosuite A (RSA)
++ bruw bruw:suite:crypto :: create keypair
++ haul haul:suite:crypto :: activate public key
++ weur weur:suite:crypto :: activate secret key
++ trua trua:test:crypto :: test rsa
++ crub crub:crypto :: cryptosuite B (Ed)
++ trub trub:test:crypto :: test crub
++ hmac hmac:crypto :: HMAC-SHA1
@ -24,8 +20,8 @@
++ yu yu:chrono:userlib :: UTC format constants
++ moon en-mite:mimes:html :: mime type to text
++ perk perk.is :: parse cube fork
++ poja en-json:html :: parse JSON
++ pojo de-json:html :: print json
++ poja de-json:html :: parse JSON
++ pojo en-json:html :: print json
++ poxo en-xml:html :: node to tape
++ poxa de-xml:html :: xml parser
++ jo dejs-soft:format :: json reparser
@ -54,7 +50,6 @@
++ ofis de-base64:mimes:html :: 64-bit decode
++ dray dray:wired :: load tuple into path
++ raid raid:wired :: demand path odors
++ read read:wired :: parse odored path
++ urle en-urlt:html :: URL encode
++ urld de-urlt:html :: URL decode
++ earn en-purl:html :: purl to tape
@ -83,9 +78,8 @@
++ agon !! :: XX deprecated
++ ankh ankh:clay :: fs node (new)
++ apex !! :: XX deprecated
++ ares ares.is :: possible error
++ bale bale:eyre :: driver state
++ iden !! :: username
++ iden user:eyre :: username
++ sec-move sec-move:eyre :: driver effect
++ ball !! :: XX deprecated
++ bait bait:ames :: fmt nrecvd spec
@ -112,7 +106,6 @@
++ coal !! :: XX depreacted
++ code code:xmas :: symmetric key
++ cone !! :: XX depreacted
++ coop coop.is :: e2e ack
++ corn !! :: XX depreacted
++ cred cred:eyre :: credential
++ deco deco:dill :: text decoration
@ -144,7 +137,6 @@
++ httr httr:eyre :: raw http response
++ httx httx:eyre :: encapsulated http
++ kite !! :: XX deprecated
++ json json.is :: normal json value
++ lamb !! :: XX deprecated
++ lane lane:xmas :: packet route
++ lang lang:ames :: IETF lang as code
@ -164,7 +156,6 @@
++ mess mess:eyre :: raw http headers
++ meta !! :: path metadata
++ meth meth:eyre :: http methods
++ mime mime.is :: mimetyped data
++ mite mite:eyre :: mime type
++ miso miso:clay :: ankh delta
++ misu misu:clay :: computed delta
@ -207,7 +198,6 @@
++ rout rout:eyre :: http route (new)
++ rump rump:clay :: relative path
++ saba saba:clay :: patch+merge
++ sack sack.is :: incoming [our his]
++ sufi sufi:ames :: domestic host
++ salt !! :: XX deprecated
++ seal !! :: XX deprecated
@ -220,7 +210,6 @@
++ soup soup:ames :: new statement id
++ soul soul:ames :: packet in travel
++ soba soba:clay :: delta
++ sock sock.is :: outgoing [from to]
++ spur spur.is :: ship desk case spur
++ step step:ames :: identity stage
++ stub stub:dill :: styled tuba
@ -231,7 +220,7 @@
++ tako tako:clay :: yaki ref
++ tick tick:ames :: process id
++ tint tint:dill :: text color
++ toro toro:clay :: general change
++ toro toro:clay :: general change
++ town town:ames :: all security state
++ tube !! :: canonical path
++ tutu !! :: XX deprecated
@ -289,4 +278,7 @@
++ kiss-arvo task-arvo :: in request ->$
++ note-arvo note-arvo :: out request $->
++ sign-arvo sign-arvo :: in result $<-
++ nule nule:unix:userlib :: lines to unix cord
++ lore to-wain:format :: atom to line list
++ role of-wain:format :: line list to atom
--

7
gen/cat/pretty.hoon → lib/pretty-file.hoon
View File

@ -1,9 +1,10 @@
:: Pretty-printing util, should be in lib/
:: Untyped best-guess printer
::
:::: /hoon/pretty/cat/gen
:::: /hoon/pretty-file/lib
::
/? 310
::
=< pretty-file
|%
++ pretty-noun
|= pri/* ^- tank
@ -21,8 +22,8 @@
::
++ vale-cord |=(a/cord `?`(levy (trip a) |=(b/@ |((gte b 32) =(10 b)))))
::
++ wain-to-tang |=(a/wain (turn a |=(b/cord leaf+(trip b))))
++ pretty-file
=+ wain-to-tang=|=(a/wain (turn a |=(b/cord leaf+(trip b))))
|= fyl/* ^- tang
=+ `(unit wain)`?@(fyl `(to-wain:format fyl) ((soft wain) fyl))
?^ - (wain-to-tang u)

22
lib/show-dir.hoon Normal file
View File

@ -0,0 +1,22 @@
:: Display directory contents
::
:::: /hoon/show-dir/lib
::
/? 310
|= {vane/?($g $c) pax/path des/(map @t $~)}
^- tank
:+ %rose [" " `~]
%+ turn (sort ~(tap by des) aor)
|= {kid/@ta $~}
=+ paf=`path`/[kid]
=- :+ %rose ["/" ~ ?:(dir "/" ~)]
(turn paf |=(a/knot leaf+(trip a)))
|- ^- {dir/? paf/path}
=+ arf=.^(arch (cat 3 vane %y) (weld pax paf))
?^ fil.arf
[| paf]
?~ dir.arf
[& paf] :: !!
?. ?=({^ $~ $~} dir.arf)
[& paf]
$(paf (welp paf /[p.n.dir.arf]))

45
lib/talk.hoon
View File

@ -1,45 +0,0 @@
::
:::: /hoon/talk/lib
::
:: This file is in the public domain.
::
/? 310
/- talk
::
::::
::
[. ^talk]
|_ bol/bowl:gall
++ main :: main story
|= our/ship ^- cord
=+ can=(clan:title our)
?+ can %porch
$czar %court
$king %floor
==
::
++ said-url :: app url
|= url/purl:eyre
:^ ost.bol %poke /said-url
:+ [our.bol %talk] %talk-command
^- command
:- %publish
:_ ~
^- thought
:+ (shaf %thot eny.bol)
[[[%& our.bol (main our.bol)] [*envelope %pending]] ~ ~]
[now.bol *bouquet [%app dap.bol (crip (en-purl:html url))]] :: XX
::
++ said :: app message
|= {our/@p dap/term now/@da eny/@uvJ mes/(list tank)}
:- %talk-command
^- command
:- %publish
|- ^- (list thought)
?~ mes ~
:_ $(mes t.mes, eny (sham eny mes))
^- thought
:+ (shaf %thot eny)
[[[%& our (main our)] [*envelope %pending]] ~ ~]
[now *bouquet [%app dap (crip ~(ram re i.mes))]]
--

165
lib/tester.hoon Normal file
View File

@ -0,0 +1,165 @@
/+ new-hoon
::
:> testing utilities
|%
:> # %models
+|
+= tests
:> a hierarchical structure of tests
:>
:> a recursive association list mapping a part of a path
:> to either a test trap or a sublist of the same type.
(list instance)
::
+= instance
:> a mapping between a term and part of a test tree.
(pair term (each $-(@uvJ (list tape)) tests))
::
:> # %generate
:> utilities for generating ++tests from files and directories.
+|
++ merge-base-and-recur
:> combine the current file and subdirectory.
:>
:> this merges the file {base} with its child files {recur}.
|= [base=vase recur=(map @ta tests:tester)]
^- tests
=+ a=(gen-tests base)
=+ b=(test-map-to-test-list recur)
:: todo: why does ++weld not work here? {a} and {b} are cast and have the
:: correct faces.
(welp a b)
::
++ test-map-to-test-list
:> translates ford output to something we can work with.
:>
:> ford gives us a `(map @ta tests:tester)`, but we actually
:> want something like ++tests.
|= a=(map @ta tests:tester)
:: todo: i'd like to sort this, but ++sort has -find.a problems much like
:: ++weld does above!?
^- tests
%+ turn
(to-list:dct:new-hoon a)
|= {key/@ta value/tests:tester}
[key [%| value]]
::
++ gen-tests
:> creates a {tests} list out of a vase of a test suite
|= v=vase
^- tests
=+ arms=(sort (sloe p.v) aor)
%+ turn arms
|= arm/term
:- arm
:- %&
|= eny=@uvJ
=+ context=(slop !>((init-test eny)) v)
=/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]])
((hard (list tape)) q:(slap r [%limb %results]))
::
:> # %per-test
:> data initialized on a per-test basis.
::
++ init-test
|= {cookie/@uvJ}
~(. tester `(list tape)`~ cookie 10 0)
::
++ tester-type _(init-test `@uvJ`0)
::
++ tester
|_ $: error-lines=(list tape) :< output messages
eny=@uvJ :< entropy
check-iterations=@u :< # of check trials
current-iteration=@u :< current iteration
==
:> #
:> # %check
:> #
:> gates for quick check style tests.
+|
+- check
|* [generator=$-(@uvJ *) test=$-(* ?)]
|-
^+ +>.$
?: (gth current-iteration check-iterations)
+>.$
:: todo: wrap generator in mule so it can crash.
=+ sample=(generator eny)
:: todo: wrap test in mule so it can crash.
=+ ret=(test sample)
?: ret
%= $
eny (shaf %huh eny) :: xxx: better random?
current-iteration (add current-iteration 1)
==
=+ case=(add 1 current-iteration)
=+ case-plural=?:(=(case 1) "case" "cases")
%= +>.$
error-lines :*
"falsified after {(noah !>(case))} {case-plural} by '{(noah !>(sample))}'"
error-lines
==
==
::
:: todo: a generate function that takes an arbitrary span.
::
++ generate-range
|= [min=@ max=@]
|= c=@uvJ
^- @
=+ gen=(random:new-hoon c)
=^ num gen (range:gen min max)
num
::
++ generate-dict
:> generator which will produce a dict with {count} random pairs.
|= count=@u
:> generate a dict with entropy {c}.
|= c=@uvJ
:>
:> gen: stateful random number generator
:> out: resulting map
:> i: loop counter
:>
=/ gen (random:new-hoon c)
=| out=(dict:new-hoon @ud @ud)
=| i=@u
|-
^- (dict:new-hoon @ud @ud)
?: =(i count)
out
=^ first gen (range:gen 0 100)
=^ second gen (range:gen 0 100)
$(out (put:dct:new-hoon out first second), i +(i))
:> #
:> # %test
:> #
:> test expectation functions
+|
:: todo: unit testing libraries have a lot more to them than just eq.
++ expect-eq
|* [a=* b=* c=tape]
^+ +>
?: =(a b)
+>.$
%= +>.$
error-lines :*
"failure: '{c}'"
" actual: '{(noah !>(a))}'"
" expected: '{(noah !>(b))}'"
error-lines
==
==
::
:> #
:> # %output
:> #
:> called by the test harness
::
++ results
:> returns results.
^- (list tape)
error-lines
--
--

438
lib/womb.hoon
View File

@ -1,438 +0,0 @@
:: :: ::
:::: /hoon/womb/lib :: ::
:: :: ::
/? 310 :: version
/+ talk, old-phon
=, wired
=, title
=, womb:jael
:: :: ::
:::: :: ::
:: :: ::
:: |%
:: ++ foil :: ship allocation map
:: |* mold :: entry mold
:: $: min/@u :: minimum entry
:: ctr/@u :: next allocated
:: und/(set @u) :: free under counter
:: ove/(set @u) :: alloc over counter
:: max/@u :: maximum entry
:: box/(map @u +<) :: entries
:: == ::
:: -- ::
:: ::
:::: ::
:: ::
|% ::
:: ++ managed :: managed plot
:: |* mold ::
:: %- unit :: unsplit
:: %+ each +< :: subdivided
:: mail :: delivered
:: :: ::
:: ++ divided :: get division state
:: |* (managed) ::
:: ?- +< ::
:: $~ ~ :: unsplit
:: {$~ $| *} ~ :: delivered
:: {$~ $& *} (some p.u.+<) :: subdivided
:: == ::
:: :: ::
:: ++ moon (managed _!!) :: undivided moon
:: ::
:: ++ planet :: subdivided planet
:: (managed (lone (foil moon))) ::
:: :: ::
:: ++ star :: subdivided star
:: (managed (pair (foil moon) (foil planet))) ::
:: :: ::
:: ++ galaxy :: subdivided galaxy
:: (managed (trel (foil moon) (foil planet) (foil star)))::
:: :: ::
++ ticket @G :: old 64-bit ticket
++ passcode @uvH :: 128-bit passcode
++ passhash @uwH :: passocde hash
++ mail @t :: email address
++ balance :: invitation balance
$: planets/@ud :: planet count
stars/@ud :: star count
owner/mail :: owner's email
history/(list mail) :: transfer history
== ::
:: ++ property :: subdivided plots
:: $: galaxies/(map @p galaxy) :: galaxy
:: planets/(map @p planet) :: star
:: stars/(map @p star) :: planet
:: == ::
++ invite ::
$: who/mail :: who to send to
pla/@ud :: planets to send
sta/@ud :: stars to send
wel/welcome :: welcome message
== ::
++ welcome :: welcome message
$: intro/tape :: in invite email
hello/tape :: as talk message
== ::
++ stat (pair live dist) :: external info
++ live ?($cold $seen $live) :: online status
++ dist :: allocation
$% {$free $~} :: unallocated
{$owned p/mail} :: granted, status
{$split p/(map ship stat)} :: all given ships
== ::
:: ::
++ ames-tell :: .^ a+/=tell= type
|^ {p/(list elem) q/(list elem)} ::
++ elem $^ {p/elem q/elem} ::
{term p/*} :: underspecified
-- ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|%
++ part {$womb $1 pith} :: womb state
++ pith :: womb content
$: boss/(unit ship) :: outside master
:: bureau/(map passhash balance) :: active invitations
:: office/property :: properties managed
recycling/(map ship @) :: old ticket keys
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|% :: arvo structures
++ invite-j {who/mail pla/@ud sta/@ud} :: invite data
++ balance-j {who/mail pla/@ud sta/@ud} :: balance data
++ womb-task :: manage ship %fungi
$% {$claim aut/passcode her/@p tik/ticket} :: convert to %final
{$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode
{$invite tid/passcode inv/invite-j} :: alloc to passcode
{$reinvite aut/passcode tid/passcode inv/invite-j}:: move to another
== ::
++ card ::
$% {$flog wire flog:dill} ::
{$info wire @p @tas nori:clay} :: fs write (backup)
:: {$wait $~} :: delay acknowledgment
{$diff gilt} :: subscription response
{$poke wire dock pear} :: app RPC
{$next wire p/ring} :: update private key
{$tick wire p/@pG q/@p} :: save ticket
{$knew wire p/ship q/wyll:ames} :: learn will (old pki)
{$jaelwomb wire task:womb} :: manage rights
== ::
++ pear ::
$% {$email mail tape wall} :: send email
{$womb-do-ticket ship} :: request ticket
{$womb-do-claim ship @p} :: issue ship
{$drum-put path @t} :: log transaction
== ::
++ gilt :: scry result
$% {$ships (list ship)} ::
{$womb-balance balance} ::
{$womb-balance-all (map passhash mail)} ::
{$womb-stat stat} ::
:: {$womb-stat-all (map ship stat)} ::
{$womb-ticket-info passcode ?($fail $good $used)} ::
==
++ move (pair bone card) :: user-level move
::
++ transaction :: logged poke
$% {$report her/@p wyl/wyll:ames}
{$claim aut/passcode her/@p}
{$recycle who/mail him/knot tik/knot}
{$bonus tid/cord pla/@ud sta/@ud}
{$invite tid/cord inv/invite}
{$reinvite aut/passcode inv/invite}
==
--
|%
++ ames-grab :: XX better ames scry
|= {a/term b/ames-tell} ^- *
=; all (~(got by all) a)
%- ~(gas by *(map term *))
%- zing
%+ turn (weld p.b q.b)
|= b/elem:ames-tell ^- (list {term *})
?@ -.b [b]~
(weld $(b p.b) $(b q.b))
::
++ murn-by
|* {a/(map) b/$-(* (unit))}
^+ ?~(a !! *(map _p.n.a _(need (b q.n.a))))
%- malt
%+ murn ~(tap by a)
?~ a $~
|= _c=n.a ^- (unit _[p.n.a (need (b q.n.a))])
=+ d=(b q.c)
?~(d ~ (some [p.c u.d]))
::
++ neis |=(a/ship ^-(@u (rsh (dec (xeb (dec (xeb a)))) 1 a))) :: postfix
::
--
:: :: ::
:::: :: ::
:: :: ::
=+ cfg=[can-claim=& can-recycle=&] :: temporarily disabled
=+ [replay=| stat-no-email=|] :: XX globals
|= {bowl:gall part} :: main womb work
|_ moz/(list move)
++ abet :: resolve
^- (quip move part)
[(flop moz) +>+<+]
::
++ teba :: install resolved
|= a/(quip move part) ^+ +>
+>(moz (flop -.a), +>+<+ +.a)
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
|= (list card)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ ames-last-seen :: last succesful ping
|= a/ship ~+ ^- (unit time)
?: =(a our) (some now)
%- (hard (unit time))
~| ames-look+/(scot %p our)/tell/(scot %da now)/(scot %p a)
%+ ames-grab %rue
.^(ames-tell %a /(scot %p our)/tell/(scot %da now)/(scot %p a))
::
++ jael-scry
|* {typ/mold pax/path} ^- typ
.^(typ %j (welp /(scot %p our)/womb/(scot %da now) pax))
::
++ jael-pas-balance
|= pas/passcode ^- (unit balance)
%+ bind (jael-scry (unit balance-j) /balance/(scot %uv pas)/womb-balance)
|= a/balance-j ^- balance
=/ hiz/(list mail) ~ :: XX track history in jael
[pla.a sta.a who.a hiz]
::
::
++ peek-x-shop :: available ships
|= tyl/path ^- (unit (unit {$ships (list @p)}))
=; a ~& peek-x-shop+[tyl a] a
=; res/(list ship) (some (some [%ships res]))
:: XX redundant parse?
=+ [typ nth]=~|(bad-path+tyl (raid tyl /[typ=%tas]/[nth=%ud]))
(jael-scry (list ship) /shop/[typ]/(scot %ud nth)/ships)
::
++ get-live :: last-heard time ++live
|= a/ship ^- live
=+ rue=(ames-last-seen a)
?~ rue %cold
?:((gth (sub now u.rue) ~m5) %seen %live)
::
::
++ stats-ship :: inspect ship
|= who/@p ^- stat
:- (get-live who)
=/ man (jael-scry (unit mail) /stats/(scot %p who)/womb-owner)
?~ man [%free ~]
?: stat-no-email [%owned '']
[%owned u.man]
::
++ peek-x-stats :: inspect ship/system
|= tyl/path
?^ tyl
?> |(=(our src) =([~ src] boss)) :: privileged info
:: XX redundant parse?
=+ who=~|(bad-path+tyl (raid tyl /[who=%p]))
``womb-stat+(stats-ship who)
!! :: XX meaningful and/or useful in sein-jael model?
:: ^- (unit (unit {$womb-stat-all (map ship stat)}))
:: =. stat-no-email & :: censor adresses
:: :^ ~ ~ %womb-stat-all
:: %- ~(uni by (~(urn by planets.office) stat-planet))
:: %- ~(uni by (~(urn by stars.office) stat-star))
:: (~(urn by galaxies.office) stat-galaxy)
::
++ peek-x-balance :: inspect invitation
|= tyl/path
^- (unit (unit {$womb-balance balance}))
:: XX redundant parse?
=+ pas=~|(bad-path+tyl (raid tyl /[pas=%uv]))
%- some
%+ bind (jael-pas-balance pas)
|=(a/balance [%womb-balance a])
::
++ parse-ticket
|= {a/knot b/knot} ^- {him/@ tik/@}
[him=(rash a old-phon) tik=(rash b old-phon)]
::
++ check-old-ticket
|= {a/ship b/@pG} ^- (unit ?)
%+ bind (~(get by recycling) (sein a))
|= key/@ ^- ?
=(b `@p`(end 6 1 (shaf %tick (mix a (shax key)))))
::
::
++ peek-x-ticket
|= tyl/path
^- (unit (unit {$womb-ticket-info passcode ?($fail $good $used)}))
?. ?=({@ @ $~} tyl) ~|(bad-path+tyl !!)
=+ [him tik]=(parse-ticket i.tyl i.t.tyl)
%+ bind (check-old-ticket him tik)
|= gud/?
:+ ~ %womb-ticket-info
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:- pas
?. gud %fail
?^ (jael-pas-balance pas) %used
%good
::
++ peer-scry-x :: subscription like .^
|= tyl/path
=< abet
=+ gil=(peek-x tyl)
~| tyl
?~ gil ~|(%block-stub !!)
?~ u.gil ~|(%bad-path !!)
(emit %diff u.u.gil)
::
++ peek-x :: stateless read
|= tyl/path ^- (unit (unit gilt))
~| peek+x+tyl
?~ tyl ~
?+ -.tyl ~
:: /shop/planets/@ud (list @p) up to 3 planets
:: /shop/stars/@ud (list @p) up to 3 stars
:: /shop/galaxies/@ud (list @p) up to 3 galaxies
$shop (peek-x-shop +.tyl)
:: /stats general stats dump
:: /stats/@p what we know about @p
$stats (peek-x-stats +.tyl)
:: /balance/passcode invitation status
$balance (peek-x-balance +.tyl)
:: /ticket/ship/ticket check ticket usability
$ticket (peek-x-ticket +.tyl)
==
::
++ poke-manage-old-key :: add to recyclable tickets
|= {a/ship b/@}
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
.(recycling (~(put by recycling) a b))
::
++ email :: send email
|= {wir/wire adr/mail msg/tape} ^+ +>
?: replay +> :: dont's send email in replay mode
~& do-email+[adr msg]
::~&([%email-stub adr msg] +>)
(emit %poke womb+[%mail wir] [our %gmail] %email adr "Your Urbit Invitation" [msg]~)
::
++ log-transaction :: logged poke
|= a/transaction ^+ +>
?: replay +>
(emit %poke /womb/log [our %hood] %drum-put /womb-events/(scot %da now)/hoon (crip <eny a>))
::
++ poke-replay-log :: rerun transactions
|= a/(list {eny/@uvJ pok/transaction})
?~ a abet
~& womb-replay+-.pok.i.a
=. eny eny.i.a
=. replay &
%_ $
a t.a
+>
?- -.pok.i.a
$claim (teba (poke-claim +.pok.i.a))
$bonus (teba (poke-bonus +.pok.i.a))
$invite (teba (poke-invite +.pok.i.a))
$report (teba (poke-report +.pok.i.a))
$recycle (teba (poke-recycle +.pok.i.a))
$reinvite (teba (poke-reinvite +.pok.i.a))
==
==
::
++ poke-bonus :: expand invitation
|= {tid/cord pla/@ud sta/@ud}
=< abet
=. log-transaction (log-transaction %bonus +<)
?> |(=(our src) =([~ src] boss)) :: priveledged
=/ pas ~|(bad-invite+tid `passcode`(slav %uv tid))
(emit %jaelwomb / %bonus pas pla sta)
::
++ poke-invite :: create invitation
|= {tid/cord inv/invite}
=< abet
=. log-transaction (log-transaction %invite +<)
?> |(=(our src) =([~ src] boss)) :: priveledged
=+ pas=~|(bad-invite+tid `passcode`(slav %uv tid))
=. emit (emit %jaelwomb / %invite pas [who pla sta]:inv)
(email /invite who.inv intro.wel.inv)
::
++ poke-reinvite :: split invitation
|= {aut/passcode inv/invite} :: further invite
=< abet
=. log-transaction (log-transaction %reinvite +<)
?> =(src src) :: self-authenticated
=/ pas/@uv (end 7 1 (shaf %pass eny))
=. emit (emit %jaelwomb / %reinvite aut pas [who pla sta]:inv)
(email /invite who.inv intro.wel.inv)
::
++ poke-obey :: set/reset boss
|= who/(unit @p)
=< abet
?> =(our src) :: me only
.(boss who)
::
++ poke-save :: write backup
|= pax/path
=< abet
?> =(our src) :: me only
=+ pas=`@uw`(shas %back eny)
~& [%backing-up pas=pas]
=; dif (emit %info /backup [our dif])
%+ foal:space:userlib
(welp pax /jam-crub)
[%jam-crub !>((en:crub:crypto pas (jam `part`+:abet)))]
::
++ poke-rekey :: extend wyll
|= $~
=< abet
?> |(=(our src) =([~ src] boss)) :: privileged
:: (emit /rekey %next sec:ex:(pit:nu:crub 512 (shaz (mix %next (shaz eny)))))
~& %rekey-stub .
::
++ poke-report :: report wyll
|= {her/@p wyl/wyll:ames} ::
=< abet
=. log-transaction (log-transaction %report +<)
?> =(src src) :: self-authenticated
(emit %knew /report her wyl)
::
++ poke-recycle :: save ticket as balance
|= {who/mail him-t/knot tik-t/knot}
?. can-recycle.cfg ~|(%ticket-recycling-offline !!)
=< abet
=. log-transaction (log-transaction %recycle +<)
?> =(src src)
=+ [him tik]=(parse-ticket him-t tik-t)
?> (need (check-old-ticket him tik))
=+ pas=`passcode`(end 7 1 (sham %tick him tik))
:: ?^ (scry-womb-invite (shaf %pass pas))
:: ~|(already-recycled+[him-t tik-t] !!)
=/ inv/{pla/@ud sta/@ud}
?+((clan him) !! $duke [0 1], $king [1 0])
(emit %jaelwomb / %invite pas who inv)
::
::
:: ++ jael-claimed 'Move email here if an ack is necessary'
::
++ poke-claim :: claim plot, req ticket
|= {aut/passcode her/@p}
?. can-claim.cfg ~|(%ticketing-offline !!)
=< abet
=. log-transaction (log-transaction %claim +<)
?> =(src src)
=/ bal ~|(%bad-invite (need (jael-pas-balance aut)))
=/ tik/ticket (end 6 1 (shas %tick eny))
=. emit (emit %jaelwomb / %claim aut her tik)
:: XX event crashes work properly yes?
(email /ticket owner.bal "Ticket for {<her>}: {<`@pG`tik>}")
--

4
mar/talk/comment.hoon → mar/fora/comment.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hoon/comment/talk/mar
:::: /mar/fora/comment/hoon
::
/? 310
/+ old-zuse
@ -9,7 +9,7 @@
++ grab
|%
++ noun {path spur @t}
++ json
++ json
(corl need =>(jo (ot pax+(su fel:stab) sup+(su fel:stab) txt+so ~)))
--
--

4
mar/talk/fora-post.hoon → mar/fora/post.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hoon/fora-post/talk/mar
:::: /mar/fora/post/hoon
::
/? 310
/+ old-zuse
@ -9,7 +9,7 @@
++ grab
|%
++ noun {path spur @t @t}
++ json
++ json
(corl need =>(jo (ot pax+(su fel:stab) sup+(su fel:stab) hed+so txt+so ~)))
--
--

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