polwex/ustj
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

m

Browse Source
This commit is contained in:
polwex 2024-06-27 11:44:31 +07:00
parent d3efa52d29
commit 9a55f89650
37 changed files with 6207 additions and 181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

751
app/proxy.hoon Normal file
View File

@ -0,0 +1,751 @@
/- spider
/+ libstrand=strand, default-agent, verb, server, dbug
=, strand=strand:libstrand
~% %spider-top ..part ~
|%
+$ card card:agent:gall
+$ thread thread:spider
+$ tid tid:spider
+$ input input:spider
+$ yarn (list tid)
+$ thread-form _*eval-form:eval:(strand ,vase)
+$ trying ?(%build %none)
+$ state
$: starting=(map yarn [=trying =vase])
running=(axal thread-form)
tid=(map tid yarn)
serving=(map tid [(unit [rid=@ta take=?(%json %noun)]) =mark =desk])
scrying=(jug tid [=wire =ship =path])
==
::
+$ clean-slate-any
$^ clean-slate-ket
$% clean-slate-sig
clean-slate-1
clean-slate-2
clean-slate-3
clean-slate-4
clean-slate-5
clean-slate-6
clean-slate
==
::
+$ clean-slate
$: %7
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit [rid=@ta take=?(%json %noun)]) =mark =desk])
scrying=(jug tid [wire ship path])
==
::
+$ clean-slate-6
$: %6
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
scrying=(jug tid [wire ship path])
==
::
+$ clean-slate-5
$: %5
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
scrying=(map tid [ship path])
==
::
+$ clean-slate-4
$: %4
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
==
::
+$ clean-slate-3
$: %3
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [@ta =mark =desk])
==
::
+$ clean-slate-2
$: %2
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [@ta =mark])
==
::
+$ clean-slate-1
$: %1
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ clean-slate-ket
$: starting=(map yarn [trying=?(%build %find %none) =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ clean-slate-sig
$: starting=~
running=(list yarn)
tid=(map tid yarn)
==
--
::
%- agent:dbug
^- agent:gall
=| =state
=<
%+ verb |
~% %spider-agent ..bind-eyre ~
|_ =bowl:gall
+* this .
spider-core +>
sc ~(. spider-core bowl)
def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
::
++ on-init
^- (quip card _this)
:_ this
~[bind-eyre:sc]
++ on-save clean-state:sc
++ on-load
|^
|= old-state=vase
=+ !<(any=clean-slate-any old-state)
=? any ?=(^ -.any) (old-to-1 any)
=? any ?=(~ -.any) (old-to-1 any)
=^ upgrade-cards any
(old-to-2 any)
=. any (old-to-3 any)
=. any (old-to-4 any)
=. any (old-to-5 any)
=. any (old-to-6 any)
=. any (old-to-7 any)
?> ?=(%7 -.any)
::
=. tid.state tid.any
=/ yarns=(list yarn)
%+ welp running.any
~(tap in ~(key by starting.any))
|- ^- (quip card _this)
?~ yarns
[~[bind-eyre:sc] this]
=^ cards-1 state
%. [(yarn-to-tid i.yarns) nice=%.n]
:: the |sc core needs to now about the previous
:: scrying state in order to send $yawns to %ames
::
%*(handle-stop-thread sc scrying.state scrying.any)
=^ cards-2 this
$(yarns t.yarns)
[:(weld upgrade-cards cards-1 cards-2) this]
::
++ old-to-1
|= old=clean-slate-ket
^- clean-slate-1
1+old(starting (~(run by starting.old) |=([* v=vase] none+v)))
::
++ old-to-2
|= old=clean-slate-any
^- (quip card clean-slate-any)
?> ?=(?(%1 %2 %3 %4 %5 %6 %7) -.old)
?: ?=(?(%2 %3 %4 %5 %6 %7) -.old)
`old
:- ~[bind-eyre:sc]
:* %2
starting.old
running.old
tid.old
~
==
::
++ old-to-3
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%2 %3 %4 %5 %6 %7) -.old)
?: ?=(?(%3 %4 %5 %6 %7) -.old)
old
:* %3
starting.old
running.old
tid.old
(~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
==
::
++ old-to-4
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%3 %4 %5 %6 %7) -.old)
?: ?=(?(%4 %5 %6 %7) -.old)
old
:* %4
starting.old
running.old
tid.old
(~(run by serving.old) |=([id=@ta =mark =desk] [`id mark q.byk.bowl]))
==
::
++ old-to-5
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%4 %5 %6 %7) -.old)
?: ?=(?(%5 %6 %7) -.old) old
[%5 +.old(serving [serving.old ~])]
::
++ old-to-6
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%5 %6 %7) -.old)
?: ?=(?(%6 %7) -.old) old
:- %6
%= +.old
scrying
%- ~(run by scrying.old)
|= [=ship =path]
%- ~(gas in *(set [wire ^ship ^path]))
:: XX +keen:strandio used /keen as the default wire
:: this assumes that any old thread used that as well
::
[/keen ship path]~
==
::
++ old-to-7
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%6 %7) -.old)
?: ?=(%7 -.old) old
=- old(- %7, serving -)
%- ~(run by serving.old)
|= [request=(unit @ta) =mark =desk]
[(bind request (late %json)) mark desk]
--
::
++ on-poke
~/ %on-poke
|= [=mark =vase]
^- (quip card _this)
:: ?> (team:title [our src]:bowl)
?: ?=(%spider-kill mark)
(on-load on-save)
=^ cards state
?+ mark (on-poke:def mark vase)
%spider-input (on-poke-input:sc !<(input vase))
%spider-start (handle-start-thread:sc !<(start-args:spider vase))
%spider-inline (handle-inline-thread:sc !<(inline-args:spider vase))
%spider-stop (handle-stop-thread:sc !<([tid ?] vase))
%handle-http-request
(handle-http-request:sc !<([@ta =inbound-request:eyre] vase))
==
[cards this]
::
++ on-watch
~/ %on-watch
|= =path
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
[%thread @ *] (on-watch:sc t.path)
[%thread-result @ ~] (on-watch-result:sc i.t.path)
[%http-response *] `state
==
[cards this]
::
++ on-leave on-leave:def
++ on-peek
~/ %on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %tree ~]
``noun+!>((turn ~(tap of running.state) head))
::
[%x %starting @ ~]
``noun+!>((~(has of running.state) (~(got by tid.state) i.t.t.path)))
::
[%x %saxo @ ~]
``noun+!>((~(got by tid.state) i.t.t.path))
==
::
++ on-agent
~/ %on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards state
?+ wire !!
[%thread @ *] (on-agent:sc i.t.wire t.t.wire sign)
==
[cards this]
::
++ on-arvo
~/ %on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
=^ cards state
?+ wire (on-arvo:def wire sign-arvo)
[%thread @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
[%bind ~] `state
==
[cards this]
:: On unexpected failure, kill all outstanding strands
::
++ on-fail
|= [=term =tang]
^- (quip card _this)
%- (slog leaf+"spider crashed, killing all strands: {<term>}" tang)
(on-load on-save)
--
::
~% %spider-helper ..card ~
|_ =bowl:gall
++ bec `beak`byk.bowl(r da+now.bowl)
++ bind-eyre
^- card
[%pass /bind %arvo %e %connect [~ /kumo] %proxy]
::
++ new-thread-id
|= file=term
:((cury cat 3) file '--' (scot %uv (sham eny.bowl)))
::
++ handle-http-request
~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
:: ?> authenticated.inbound-request
=/ url
(parse-request-line:server url.request.inbound-request)
?> ?=([%kumo @t @t @t @t ~] site.url)
=* desk i.t.site.url
=* input-mark i.t.t.site.url
=* thread i.t.t.t.site.url
=* output-mark i.t.t.t.t.site.url
:: TODO: speed this up somehow. we spend about 15ms in this arm alone
::
?> ?=(^ body.request.inbound-request)
=/ test=$-(@t ?(%json %noun))
|= head=@t
=; type=(unit @t)
?:(=(`'application/x-urb-jam' type) %noun %json)
%+ bind
(get-header:http head header-list.request.inbound-request)
:(cork trip cass crip)
=/ give (test 'content-type')
=/ take (test 'accept')
::
=/ =tid (new-thread-id thread)
=. serving.state
(~(put by serving.state) tid [`[eyre-id take] output-mark desk])
::
=/ input=vase
%+ slop !>(~)
?- give
%json
=/ tube (convert-tube %json input-mark desk bowl)
=/ body=json (need (de:json:html q.u.body.request.inbound-request))
(tube !>(body))
::
%noun
=/ tube (convert-tube %noun input-mark desk bowl)
=/ body=noun (cue q.u.body.request.inbound-request)
(tube !>(body))
==
=/ boc bec
=/ =start-args:spider [~ `tid boc(q desk, r da+now.bowl) thread input]
(handle-start-thread start-args)
::
++ on-poke-input
|= input
=/ yarn (~(got by tid.state) tid)
(take-input yarn ~ %poke cage)
::
++ on-watch
|= [=tid =path]
(take-input (~(got by tid.state) tid) ~ %watch path)
::
++ on-watch-result
|= =tid
^- (quip card ^state)
`state
::
++ handle-sign
~/ %handle-sign
|= [=tid =wire =sign-arvo]
=/ yarn (~(get by tid.state) tid)
?~ yarn
%- (slog leaf+"spider got sign for non-existent {<tid>}" ~)
`state
(take-input u.yarn ~ %sign wire sign-arvo)
::
++ on-agent
|= [=tid =wire =sign:agent:gall]
=/ yarn (~(get by tid.state) tid)
?~ yarn
%- (slog leaf+"spider got agent for non-existent {<tid>}" ~)
`state
(take-input u.yarn ~ %agent wire sign)
::
++ handle-start-thread
~/ %handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) =beak file=term =vase]
(prep-thread parent-tid use beak %| file vase)
::
++ handle-inline-thread
~/ %handle-inline-thread
|= [parent-tid=(unit tid) use=(unit tid) =beak =shed:khan]
(prep-thread parent-tid use beak %& shed)
::
++ prep-thread
|= $: parent-tid=(unit tid) use=(unit tid) =beak
source=(each shed:khan [file=term =vase])
==
^- (quip card ^state)
=/ parent-yarn=yarn
?~ parent-tid
/
(~(got by tid.state) u.parent-tid)
=/ new-tid
?^ use
u.use
%- new-thread-id
?- -.source
%& (cat 3 'inline-' q.beak)
%| file.p.source
==
::
=/ =yarn (snoc parent-yarn new-tid)
::
?: (~(has of running.state) yarn)
~| [%already-started yarn]
!!
?: (~(has by starting.state) yarn)
~| [%already-starting yarn]
!!
::
=? serving.state !(~(has by serving.state) new-tid)
(~(put by serving.state) new-tid [~ %noun q.beak])
::
=. tid.state (~(put by tid.state) new-tid yarn)
?- -.source
%& (begin-shed yarn p.source)
%|
=. starting.state (~(put by starting.state) yarn [%build vase.p.source])
=/ pax=path
~| no-file-for-thread+file.p.source
(need (get-fit:clay beak %ted file.p.source))
:_ state
:_ ~
:+ %pass /build/[new-tid]
[%arvo %c %warp p.beak q.beak ~ %sing %a r.beak pax]
==
::
++ handle-build
~/ %handle-build
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
~| sign+[- +<]:sign-arvo
?> ?=([?(%behn %clay) %writ *] sign-arvo)
=/ =riot:clay p.sign-arvo
?~ riot
(thread-fail-not-running tid %build-thread-error *tang)
?. ?=(%vase p.r.u.riot)
(thread-fail-not-running tid %build-thread-strange >[p q]:u.riot< ~)
=/ maybe-thread (mule |.(!<(thread !<(vase q.r.u.riot))))
?: ?=(%| -.maybe-thread)
(thread-fail-not-running tid %thread-not-thread ~)
(slam-thread yarn p.maybe-thread)
::
++ slam-thread
~/ %slam-thread
|= [=yarn =thread]
^- (quip card ^state)
=/ =vase vase:(~(got by starting.state) yarn)
=/ res (mule |.((thread vase)))
?: ?=(%| -.res)
(thread-fail-not-running (yarn-to-tid yarn) %false-start p.res)
=. starting.state (~(del by starting.state) yarn)
(begin-shed yarn p.res)
::
++ begin-shed
|= [=yarn =shed:khan]
?< (~(has of running.state) yarn)
=/ m (strand ,vase)
=/ =eval-form:eval:m (from-form:eval:m shed)
=. running.state (~(put of running.state) yarn eval-form)
(take-input yarn ~)
::
++ handle-stop-thread
|= [=tid nice=?]
^- (quip card ^state)
=/ yarn=(unit yarn) (~(get by tid.state) tid)
?~ yarn
~& %stopping-nonexistent-thread
[~ state]
?: (~(has of running.state) u.yarn)
?. nice
(thread-fail u.yarn %cancelled ~)
=^ done-cards state (thread-done u.yarn *vase silent=%.n)
[done-cards state]
?: (~(has by starting.state) u.yarn)
(thread-fail-not-running tid %stopped-before-started ~)
~& [%thread-not-started u.yarn]
?: nice
(thread-done u.yarn *vase silent=%.y)
(thread-fail u.yarn %cancelled ~)
::
++ take-input
~/ %take-input
|= [=yarn input=(unit input:strand)]
^- (quip card ^state)
=/ m (strand ,vase)
?. (~(has of running.state) yarn)
%- (slog leaf+"spider got input for non-existent {<yarn>}" ~)
`state
=/ =eval-form:eval:m
(need fil:(~(dip of running.state) yarn))
=| cards=(list card)
|- ^- (quip card ^state)
=^ r=[cards=(list card) =eval-result:eval:m] eval-form
=/ out
%- mule |.
(take:eval:m eval-form (convert-bowl yarn bowl) input)
?- -.out
%& p.out
%| [[~ [%fail %crash p.out]] eval-form]
==
=. running.state (~(put of running.state) yarn eval-form)
=/ =tid (yarn-to-tid yarn)
=^ new-cards state
^- [(list card) _state]
%+ roll cards.r
|= [=card cards=(list card) s=_state]
:_ =? scrying.s ?=([%pass ^ %arvo %a %keen ?(~ ^) @ *] card)
:: &2=wire &7=ship 7|=path
(~(put ju scrying.s) tid [&2 &7 |7]:card)
s
:_ cards
^- ^card
?+ card card
[%pass * *] [%pass [%thread tid p.card] q.card]
[%give ?(%fact %kick) *]
=- card(paths.p -)
%+ turn paths.p.card
|= =path
^- ^path
[%thread tid path]
==
=. cards (weld cards (flop new-cards))
=^ final-cards=(list card) state
?- -.eval-result.r
%next `state
%fail (thread-fail yarn err.eval-result.r)
%done (thread-done yarn value.eval-result.r silent=%.y)
==
[(weld cards final-cards) state]
::
++ thread-fail-not-running
|= [=tid =term =tang]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
:_ state(starting (~(del by starting.state) yarn))
=/ moz (thread-say-fail tid term tang)
?. ?=([~ %build *] (~(get by starting.state) yarn))
moz
:_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %base ~])
::
++ thread-say-fail
|= [=tid =term =tang]
^- (list card)
:~ [%give %fact ~[/thread-result/[tid]] %thread-fail !>([term tang])]
[%give %kick ~[/thread-result/[tid]] ~]
==
::
++ cancel-scry
|= [=tid silent=?]
^- (quip card _state)
?~ scrying=(~(get ju scrying.state) tid)
`state
:_ state(scrying (~(del by scrying.state) tid))
?: silent ~
%- ~(rep in `(set [wire ship path])`scrying)
|= [[=wire =ship =path] cards=(list card)]
%- (slog leaf+"cancelling {<tid>}: [{<[wire ship path]>}]" ~)
:_ cards
[%pass (welp /thread/[tid] wire) %arvo %a %yawn ship path]
::
++ thread-http-fail
|= [=tid =term =tang]
^- (quip card ^state)
=- (fall - `state)
%+ bind
(~(get by serving.state) tid)
|= [request=(unit [rid=@ta take=?(%json %noun)]) output=mark =desk]
:_ state(serving (~(del by serving.state) tid))
?~ request
~
%+ give-simple-payload:app:server rid.u.request
^- simple-payload:http
?. ?=(http-error:spider term)
%- (slog tang)
?- take.u.request
%json
=/ tube (convert-tube %tang %json desk bowl)
:- [500 [['content-type' 'application/json'] ~]]
=- `(as-octs:mimes:html (en:json:html -))
o/(malt `(list [key=@t json])`[term+s/term tang+!<(json (tube !>(tang))) ~])
::
%noun
:- [500 [['content-type' 'application/x-urb-jam'] ~]]
`(as-octs:mimes:html (jam [term tang]))
==
:_ ~ :_ ~
?- term
%bad-request 400
%forbidden 403
%nonexistent 404
%offline 504
==
::
++ thread-fail
|= [=yarn =term =tang]
^- (quip card ^state)
::%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ http-cards state (thread-http-fail tid term tang)
=^ scry-card state (cancel-scry tid silent=%.n)
=^ cards state (thread-clean yarn)
:_ state
:(weld fail-cards cards http-cards scry-card)
::
++ thread-http-response
|= [=tid =vase]
^- (quip card ^state)
=- (fall - `state)
%+ bind
(~(get by serving.state) tid)
|= [request=(unit [rid=@ta take=?(%json %noun)]) output=mark =desk]
?~ request
`state
?- take.u.request
%json
=/ tube (convert-tube output %json desk bowl)
:_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server rid.u.request
(json-response:gen:server !<(json (tube vase)))
::
%noun
:_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server rid.u.request
:- [200 ['content-type' 'application/x-urb-jam']~]
`(as-octs:mimes:html (jam q.vase))
==
::
++ thread-done
|= [=yarn =vase silent=?]
^- (quip card ^state)
:: %- (slog leaf+"strand {<yarn>} finished" (sell vase) ~)
=/ =tid (yarn-to-tid yarn)
=/ done-cards=(list card)
:~ [%give %fact ~[/thread-result/[tid]] %thread-done vase]
[%give %kick ~[/thread-result/[tid]] ~]
==
=^ http-cards state
(thread-http-response tid vase)
=^ scry-card state (cancel-scry tid silent)
=^ cards state (thread-clean yarn)
[:(weld done-cards cards http-cards scry-card) state]
::
++ thread-clean
|= =yarn
^- (quip card ^state)
=/ children=(list ^yarn)
%+ turn
~(tap of (~(dip of running.state) yarn))
|= [child=^yarn *]
(welp yarn child)
|- ^- (quip card ^state)
?~ children
`state
=^ cards-children state $(children t.children)
=^ cards-our state
=/ =^yarn i.children
=/ =tid (yarn-to-tid yarn)
=: running.state (~(lop of running.state) yarn)
tid.state (~(del by tid.state) tid)
serving.state (~(del by serving.state) (yarn-to-tid yarn))
==
:_ state
%+ murn ~(tap by wex.bowl)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit card)
?. ?& ?=([%thread @ *] wire)
=(tid i.t.wire)
==
~
`[%pass wire %agent [ship term] %leave ~]
[(welp cards-children cards-our) state]
::
++ convert-bowl
|= [=yarn =bowl:gall]
^- bowl:spider
:* our.bowl
src.bowl
(yarn-to-tid yarn)
(yarn-to-parent yarn)
wex.bowl
sup.bowl
eny.bowl
now.bowl
(yarn-to-byk yarn bowl)
==
::
++ yarn-to-tid
|= =yarn
^- tid
=/ nary (flop yarn)
?> ?=([@ *] nary)
i.nary
::
++ yarn-to-parent
|= =yarn
^- (unit tid)
=/ nary (flop yarn)
?> ?=([@ *] nary)
?~ t.nary
~
`i.t.nary
::
++ yarn-to-byk
|= [=yarn =bowl:gall]
=/ [* * =desk]
~| "no desk associated with {<tid>}"
%- ~(got by serving.state) (yarn-to-tid yarn)
=/ boc bec
boc(q desk)
::
++ clean-state
!> ^- clean-slate
7+state(running (turn ~(tap of running.state) head))
::
++ convert-tube
|= [from=mark to=mark =desk =bowl:gall]
.^
tube:clay
%cc
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
==
--

170
app/ustj.hoon
View File

@ -1,5 +1,5 @@
/- *forum
/+ dbug, lib=forum, const=constants
/+ dbug, sr=sortug, lib=forum, const=constants, seeds, cacher
/= router /web/router
|%
++ card card:agent:gall
@ -17,6 +17,8 @@
|_ =bowl:gall
+* this .
hd ~(. +> [state bowl])
rout ~(. router:router [state bowl])
cache ~(. cacher [state bowl])
++ on-fail |~(* `this)
++ on-leave |~(* `this)
++ on-save !>(state)
@ -40,53 +42,131 @@
==
++ on-poke-noun
|= a=*
?: ?=([%ui *] a) (handle-ui a)
?: ?=([%cache *] a) (handle-cache +.a)
?: ?=(%test a) test
?: ?=(%print a) print
?: ?=(%seed a) seed
?: ?=(%seed a) teds:seed
?: ?=(%seed2 a) coms:seed
?: ?=(%seed3 a) reps:seed
~& wtf=a
`this
++ handle-cache |= a=* :_ this
=/ which ($?(%root %ted %sta %all) a)
?- which
%root :~(cache-root:cache)
%sta cache-static:cache
%ted cache-threads:cache
%all cache-all:cache
==
++ handle-ui |= noun=*
=^ cards state (handle-ui:cache noun)
[cards this]
++ test
=/ teds (tap:torm threads)
~& teds=(lent teds)
=/ coms (tap:gorm:tp comments)
~& coms=(lent coms)
`this
++ print
~& > state=state
`this
++ seed
=/ authors=(list @p) :~
~zod
~polwex
~lagrev-nocfep
~lagrev-nocfep
==
=/ titles=(list @t)
:~
'Helldivers 2 has caused over 20k Steam accounts to be banned'
'UI elements with a hand-drawn, sketchy look'
'60 kHz (2022)'
'Show HN: Every mountain, building and tree shadow mapped for any date and time'
'Snowflake breach: Hacker confirms access through infostealer infection'
'Heroku Postgres is now based on AWS Aurora'
'Armor from Mycenaean Greece turns out to have been effective'
'Why is no Laravel/Rails in JavaScript? Will there be one?'
'Moving Beyond Type Systems'
'Japanese \'My Number Card\' Digital IDs Coming to Apple\'s Wallet App'
'How to copy a file from a 30-year-old laptop'
'(some) good corporate engineering blogs are written'
'Debian KDE: Right Linux distribution for professional digital painting in 2024'
'Go: Sentinel errors and errors.Is() slow your code down by 3000%'
'"Moveable Type" to end 17-year run in The New York Times\'s lobby'
'London\'s Evening Standard axes daily print edition'
==
=/ rng ~(. og eny.bowl)
|- ?~ titles `this
=^ r1 rng (rads:rng 1)
~& >> rng=rng
=/ r (rad:rng 3)
=/ =content ?: .=(0 r1)
[%link 'https://urbit.org'] [%text ~]
=/ author (snag r authors)
=/ date (sub now.bowl (mul ~h1 (rad:rng 500)))
=/ ted (build-thread:lib i.titles author date content)
=/ tally (new:si [(? r1) (rad:rng 1.000)])
=. ted ted(votes [tally ~])
=. threads (put:torm threads [author date] ted)
|%
++ teds
=/ titles titles:seeds
=. state
|- ?~ titles state
=^ r1 rng (rads:rng 100)
=/ coinflip=? (lte 50 r1)
=/ =content ?: coinflip
=/ ind (rad:rng (lent links:seeds))
=/ url (snag ind links:seeds)
[%link url]
=/ ind (rad:rng (lent md:seeds))
=/ md (snag ind md:seeds)
=/ cl (build-content:lib md)
[%text cl]
=/ author
=/ ind (rad:rng (lent authors:seeds))
(snag ind authors.seeds)
=/ date (sub now.bowl (mul ~h1 (rad:rng 500)))
=/ ted (build-thread:lib i.titles author date content)
=/ tally (new:si [coinflip (rad:rng 1.000)])
=. ted ted(votes [tally ~])
=. threads (put:torm threads [author date] ted)
$(titles t.titles)
:_ this cache-all:cache
++ reps
=/ coml (tap:gorm:tp comments)
=^ r rng (rads:rng 100)
=. state
|- ?~ coml state
=/ com=comment:tp +.i.coml
=/ ppid [author.com id.com]
=^ r0 rng (rads:rng 300)
=/ subcoms (make-seed-comments thread.com ppid)
=. state (save-replies subcoms com)
$(coml t.coml)
:_ this cache-all:cache
++ coms
=/ tedl (tap:torm threads)
=^ r rng (rads:rng 100)
=. state
|- ?~ tedl state
=/ ted=thread +.i.tedl
=^ r0 rng (rads:rng 30)
:: important!! renew the rng before every function call
=/ coms (make-seed-comments pid.ted pid.ted)
=. state (save-comments coms ted)
$(tedl t.tedl)
:_ this cache-all:cache
++ save-replies |= [cl=(list comment:tp) par=comment:tp] ^+ state
|- ?~ cl state
=/ c i.cl
=/ cpid=pid:tp [author.c id.c]
=. comments (put:gorm:tp comments cpid c)
=/ nc (~(put in children.par) cpid)
=. par par(children nc)
=/ ppid [author.par id.par]
=. comments (put:gorm:tp comments ppid par)
$(cl t.cl)
++ save-comments |= [cl=(list comment:tp) ted=thread] ^+ state
|- ?~ cl state
=/ c i.cl
=/ cpid=pid:tp [author.c id.c]
=. comments (put:gorm:tp comments cpid c)
=/ nr [cpid replies.ted]
=/ nted ted(replies nr)
=. threads (put:torm threads pid.ted nted)
$(cl t.cl, ted nted)
++ make-seed-comments |= [tpid=pid:tp ppid=pid:tp]
=| coms=(list comment:tp)
=^ r0 rng (rads:rng 30)
:: ~& >> r0=r0
=/ l (gulf 0 r0)
|- ?~ l coms
=^ r1 rng (rads:rng 100)
:: ~& r1=r1
=/ coinflip=? (lte 50 r1)
=/ content
=/ ind (rad:rng (lent md:seeds))
=/ md (snag ind md:seeds)
(build-content:lib md)
=/ author
=/ ind (rad:rng (lent authors:seeds))
(snag ind authors.seeds)
=/ date (sub now.bowl (mul ~h1 (rad:rng 500)))
=. bowl bowl(src author, now date)
=/ com (build-comment:lib content bowl tpid ppid)
=/ tally (new:si [coinflip (rad:rng 1.000)])
=. com com(votes [tally ~])
$(l t.l, coms [com coms])
--
::
++ serve
^- (quip card _this)
@ -95,8 +175,7 @@
=/ address address.req.order
:: ?: (~(has in banned.admin) address) `this
:: ~& >>> malicious-request-alert=req.order `this
:_ this
%- route:router [order state bowl]
:_ this (eyre:rout order)
--
++ on-peek
|= =(pole knot) ~
@ -107,9 +186,10 @@
--
:: helper
|_ [s=versioned-state =bowl:gall]
++ cache-card |= [pathc=@t pl=simple-payload:http] ^- card
=/ entry=cache-entry:eyre [.n %payload pl]
[%pass /root %arvo %e %set-response pathc `entry]
:: ++ static-caches ^- (list card)
:: :~ (cache-card '/forum/new-thread' (render:rout '/new-thread'))
:: :: (cache-card '/forum/new-thread')
:: ==
++ root-path-card ^- card
[%pass /root %arvo %e %connect [~ /forum] dap.bowl]
++ init-cards ^- (list card)

1
desk.bill
View File

@ -1,2 +1,3 @@
:~ %ustj
%proxy
==

196
lib/cacher.hoon Normal file
View File

@ -0,0 +1,196 @@
/- sur=forum, tp=post
/+ lib=forum, sr=sortug, cons=constants
/= router /web/router
|_ [state:sur bowl:gall]
+* this .
rout ~(. router:router +6)
state -.+6
bowl +.+6
+$ card card:agent:gall
++ handle-ui
|= noun=* ^- [(list card) _state]
=/ poke (pokes:sur noun)
~& ui-poke=poke
=/ eyre-id eyre-id.poke
|^
?- -.p.poke
%submit-thread (handle-thread +.p.poke)
%submit-comment (handle-comment +.p.poke)
%submit-reply (handle-reply +.p.poke)
%vote (handle-vote +.p.poke)
==
++ handle-thread |= [title=@t url=@t text=@t]
=/ =content:sur ?. .=('' url) [%link url] [%text (build-content:lib text)]
=/ ted (build-thread:lib title src now content)
=. state (save-ted ted)
:_ state :+
cache-root
(cache-ted ted)
(redirect-ted ted)
++ handle-comment |= [ted=thread:sur text=@t]
=/ cont (build-content:lib text)
=/ com (build-comment:lib cont bowl pid.ted pid.ted)
=. state (save-com com ted)
:_ state :+
cache-root
(cache-ted ted)
(redirect-ted ted)
++ handle-reply |= [par=comment:tp text=@t]
=/ cont (build-content:lib text)
=/ ppid [author.par id.par]
=/ com (build-comment:lib cont bowl thread.par ppid)
=/ ted (get-thread:lib thread.par state)
?~ ted `state
=. state (save-rep com par)
:_ state :*
cache-root
(cache-ted u.ted)
(cache-com com)
(cache-com par)
(redirect-com par)
==
++ handle-vote |= [is-ted=? =pid:tp vote=?]
~& handling-vote=[is-ted pid vote]
?: is-ted
(handle-ted-vote pid vote)
(handle-com-vote pid vote)
++ handle-ted-vote |= [=pid:tp vote=?]
=/ votesi=@si (new:si vote 1)
=/ uted (get-thread:lib pid state)
?~ uted `state
=/ ted u.uted
=/ v votes.ted
=/ nv %= v
tally (sum:si tally.v votesi)
leger (~(put by leger.v) src.bowl vote)
==
=. ted ted(votes nv)
=. state (save-ted ted)
=. state (save-karma ship.pid.ted vote)
:_ state :~
cache-root
(cache-ted ted)
(cache-user ship.pid.ted)
:: (redirect-ted ted)
==
++ handle-com-vote |= [=pid:tp vote=?]
=/ votesi=@si (new:si vote 1)
=/ ucom (get-comment:lib pid state)
?~ ucom `state
=/ com u.ucom
=/ v votes.com
=/ nv %= v
tally (sum:si tally.v votesi)
leger (~(put by leger.v) src.bowl vote)
==
=. com com(votes nv)
=. comments (put:gorm:tp comments pid com)
=. state (save-karma author.com vote)
:_ state :~
cache-root
(cache-com com)
(cache-user author.com)
:: (redirect-com com)
==
:: redirectors
++ redirect-root (redirect:router eyre-id "")
++ redirect-ted |= ted=thread:sur
=/ link (scow:sr %uw (jam pid.ted))
=/ url "/ted/{link}"
(redirect:router eyre-id url)
++ redirect-com |= com=comment:tp
=/ link (scow:sr %uw (jam [author.com id.com]))
=/ url "/com/{link}"
(redirect:router eyre-id url)
--
:: cache builders
++ cache-root (cache-card "")
++ cache-ted |= ted=thread:sur
=/ link (scow:sr %uw (jam pid.ted))
=/ url "/ted/{link}"
(cache-card url)
++ cache-com |= com=comment:tp
=/ link (scow:sr %uw (jam [author.com id.com]))
=/ url "/com/{link}"
(cache-card url)
++ cache-threads ^- (list card)
=| l=(list card)
:: threads
=/ teds (tap:torm:sur threads)
=. l |- ?~ teds l
=/ ted=thread:sur +.i.teds
=/ car (cache-ted ted)
$(teds t.teds, l [car l])
:- cache-root l
++ cache-user |= who=@p
=/ p (scow %p who)
(cache-card "/usr/{p}")
++ cache-static ^- (list card)
:~ (cache-card "/log")
(cache-card "/add")
(cache-card "/style.css")
(cache-card "/imgs/favicon.ico")
(cache-card "/imgs/favicon-16x16.png")
(cache-card "/imgs/favicon-32x32.png")
(cache-card "/site.webmanifest")
==
++ cache-all ^- (list card)
=| l=(list card)
:: threads
=/ teds (tap:torm:sur threads)
=. l |- ?~ teds l
=/ ted=thread:sur +.i.teds
=/ car (cache-ted ted)
$(teds t.teds, l [car l])
=/ coms (tap:gorm:tp comments)
=. l |- ?~ coms l
=/ com=comment:tp +.i.coms
=/ car (cache-com com)
$(coms t.coms, l [car l])
:- cache-root (weld cache-static l)
:: state updaters
++ save-ted |= ted=thread:sur
=. threads (put:torm:sur threads pid.ted ted)
state
:: comments to threads
++ save-com
|= [com=comment:tp ted=thread:sur]
=/ =pid:tp [author.com id.com]
=/ nr [pid replies.ted]
=. ted ted(replies nr)
=. threads (put:torm:sur threads pid.ted ted)
=. comments (put:gorm:tp comments pid com)
state
:: replies to comments
++ save-rep
|= [com=comment:tp par=comment:tp]
=/ =pid:tp [author.com id.com]
=. comments (put:gorm:tp comments pid com)
=/ ppid [author.par id.par]
=/ nc (~(put in children.par) pid)
=. par par(children nc)
=. comments (put:gorm:tp comments ppid par)
state
++ save-karma |= [who=@p vote=?]
=/ curr (~(get by karma) who)
=/ cur ?~ curr `@sd`0 u.curr
=/ votesd (new:si vote 1)
=/ new (sum:si cur votesd)
=. karma (~(put by karma) who new)
state
++ cache-card |= path=tape ^- card
=/ pathc (crip "{base-url:cons}{path}")
=/ router-path ?~ path '/' pathc
=/ pl=simple-payload:http (render:rout router-path)
=/ entry=cache-entry:eyre [.n %payload pl]
[%pass /root %arvo %e %set-response pathc `entry]
--

7
lib/constants.hoon
View File

@ -1,3 +1,10 @@
|%
++ hi %hi
++ page-size 20
++ base-url ^- tape "/forum"
++ admins ^- (set @p)
%- silt
:~ ~lagrev-nocfep
~polwex
==
--

69
lib/default-agent.hoon Normal file
View File

@ -0,0 +1,69 @@
/+ skeleton
|* [agent=* help=*]
?: ?=(%& help)
~| %default-agent-helpfully-crashing
skeleton
|_ =bowl:gall
++ on-init
`agent
::
++ on-save
!>(~)
::
++ on-load
|= old-state=vase
`agent
::
++ on-poke
|= =cage
~| "unexpected poke to {<dap.bowl>} with mark {<p.cage>}"
!!
::
++ on-watch
|= =path
~| "unexpected subscription to {<dap.bowl>} on path {<path>}"
!!
::
++ on-leave
|= path
`agent
::
++ on-peek
|= =path
~| "unexpected scry into {<dap.bowl>} on path {<path>}"
!!
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall _agent)
?- -.sign
%poke-ack
?~ p.sign
`agent
%- (slog leaf+"poke failed from {<dap.bowl>} on wire {<wire>}" u.p.sign)
`agent
::
%watch-ack
?~ p.sign
`agent
=/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
%- (slog tank u.p.sign)
`agent
::
%kick `agent
%fact
~| "unexpected subscription update to {<dap.bowl>} on wire {<wire>}"
~| "with mark {<p.cage.sign>}"
!!
==
::
++ on-arvo
|= [=wire =sign-arvo]
~| "unexpected system response {<-.sign-arvo>} to {<dap.bowl>} on wire {<wire>}"
!!
::
++ on-fail
|= [=term =tang]
%- (slog leaf+"error in {<dap.bowl>}" >term< tang)
`agent
--

102
lib/forum.hoon
View File

@ -1,13 +1,14 @@
/- sur=forum, tp=post
/+ sr=sortug, parser
/+ sr=sortug, parser, cons=constants
|%
:: fetching
++ get-thread |= [=pid:tp =state:sur] ^- (unit thread:sur)
(get:torm:sur threads.state pid)
++ get-thread-page |= [pag=@ud =state:sur] ^- (list thread:sur)
=/ teds (tap:torm:sur threads.state)
=/ start ?: .=(pag 0) 0 (dec pag)
=/ end (add start 9)
=/ pagenum ?: .=(pag 0) 0 (dec pag)
=/ start (mul pagenum page-size:cons)
=/ end (add start page-size:cons)
=| i=@ud
=| res=(list thread:sur)
|- ?~ teds (flop res)
@ -15,6 +16,86 @@
?: (lth i start) $(i +(i), teds t.teds)
=. res [+.i.teds res]
$(i +(i), teds t.teds)
++ get-comment |= [=pid:tp =state:sur] ^- (unit comment:tp)
(get:gorm:tp comments.state pid)
++ get-comment-list
|= [ted=thread:sur f=gfeed:tp] ^- (list full-node:tp)
%- flop
%+ roll replies.ted |= [=pid:tp acc=(list full-node:tp)]
=/ com (get:gorm:tp f pid)
?~ com acc
=/ fn (node-to-full u.com f)
[fn acc]
:: ++ node-to-full-fake
:: |= p=post:post ^- full-node:post
:: =/ fake-children=full-graph:post %- ~(rep in children.p)
:: |= [=id:post acc=full-graph:post]
:: (put:form:post acc id *full-node:post)
:: p(children fake-children)
++ node-to-full
|= [p=comment:tp f=gfeed:tp] ^- full-node:tp
=/ =full-graph:tp (convert-children children.p f)
[p full-graph]
++ convert-children
|= [children=(set pid:tp) f=gfeed:tp]
^- full-graph:tp
%- ~(rep in children)
|= [=pid:tp acc=full-graph:tp]
=/ n (get:gorm:tp f pid)
?~ n acc
=/ full-node (node-to-full u.n f)
(put:form:tp acc pid full-node)
++ total-comments
|= [ted=thread:sur =state:sur] ^- @ud
=/ total 0
=/ reps replies.ted
|- ?~ reps total
=/ =pid:tp i.reps
=/ com (get-comment pid state)
?~ com $(reps t.reps)
=/ fn (node-to-full u.com comments.state)
=/ subt (get-total fn)
=/ ntotal (add total subt)
$(total ntotal, reps t.reps)
++ get-total |= fn=full-node:tp ^- @ud
?~ children.fn 1
=/ lst (tap:form:tp children.fn)
%+ add (lent lst)
%+ roll lst
|= [[=pid:tp n=full-node:tp] acc=@ud]
(add acc (get-total n))
++ get-user-teds |= [who=@p =state:sur]
^- threads:sur
=| teds=threads:sur
=/ l (tap:torm:sur threads.state)
|- ?~ l teds
=/ ted=thread.sur +.i.l
?. .=(ship.pid.ted who) $(l t.l)
=/ nteds (put:torm:sur teds pid.ted ted)
$(l t.l, teds nteds)
++ get-user-coms |= [who=@p =state:sur]
^- gfeed:tp
=| gf=gfeed:tp
=/ l (tap:gorm:tp comments.state)
|- ?~ l gf
=/ com=comment:tp +.i.l
?. .=(author.com who) $(l t.l)
=/ ngf (put:gorm:tp gf [author.com id.com] com)
$(l t.l, gf ngf)
++ get-user-karma |= [who=@p =state:sur]
^- @sd
=/ kar (~(get by karma.state) who)
?~ kar `@sd`0
u.kar
:: ++ tally
:: |= votes=(map @p ?) ^- [tup=@ud tdo=@ud]
:: %- ~(rep by votes) |= [[s=@p v=?] [tup=@ud tdo=@ud]]
@ -65,7 +146,7 @@
content content
==
++ build-comment
|= [contents=content-list:tp =bowl:gall thread=pid:tp]
|= [contents=content-list:tp =bowl:gall thread=pid:tp parent=pid:tp]
^- comment:tp
=/ p *comment:tp
%= p
@ -73,12 +154,15 @@
thread thread
author src.bowl
contents contents
parent parent
==
:: ++ build-content
:: |= [text=@t poll=(unit poll:pols)] ^- content-list:tp
:: =/ contents (tokenize:ui u.text)
:: ?~ contents ~
:: contents
++ build-content
|= [text=@t] ^- content-list:tp
=/ tokens (tokenise:parser text)
?- -.tokens
%| ~
%& +.tokens
==
++ post-date-ago
|= [d=@da now=@da length=?(%tam %yau)] ^- tape

1711
lib/markdown.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

71
lib/matching-parens.hoon Normal file
View File

@ -0,0 +1,71 @@
::|%
:: ++ palindrome
:: %+ knee *@ |. ~+
:: ;~ pose
:: (cook |=(a=@ +(a)) (ifix [(just 'a') (just 'b')] palindrome))
:: (cold 0 (easy ~))
:: ==
::--
|%
++ structs
|%
+$ document (list node)
+$ node $@ ~
$% text
parens
square
==
+$ text [%text @t]
+$ parens [%parens document]
+$ square [%square document]
--
++ de
|_ [text-no-match=(unit @t)]
++ document
%+ cook |=(a=document:structs a)
(star node)
++ node
%+ cook |=(a=node:structs a)
;~ pose
square
parens
text
==
++ square
%+ knee *square:structs |. ~+ :: recurse
%+ cook |=(a=square:structs a) :: cast
%+ stag %square :: tag
%+ ifix [sel ser] :: delimiters
%- star ;~ pose
parens
square
~(text . [~ ']'])
==
++ parens
%+ knee *parens:structs |. ~+ :: recurse
%+ cook |=(a=parens:structs a) :: cast
%+ stag %parens :: tag
%+ ifix [pal par] :: delimiters
%- star ;~ pose
parens
square
~(text . [~ ')'])
==
++ text
%+ cook |=(a=text:structs ~&("text called" a))
%+ stag %text
%+ cook
|= a=tape
~& "tape: {<a>}; match: {<text-no-match>}"
(crip a)
%- plus
;~ less :: text means it doesn't match anything else
square
parens
?~ text-no-match
prn
;~(less (just u.text-no-match) prn)
==
--
--

138
lib/parser.hoon
View File

@ -1,6 +1,130 @@
/- tp=post
/+ sr=sortug
/- tp=post, md=markdown
/+ sr=sortug, mdlib=markdown
|%
:: new! using wispem's lib
++ tokenise
|= t=@t ^- (each content-list:tp @t)
=/ parsed (rush t markdown:de:md:mdlib)
?~ parsed [%| 'parsing error']
:- %&
%+ turn u.parsed de-node
++ de-node |= =node:markdown:md ^- block:tp
?~ node [%paragraph ~]
?- -.node
%leaf (de-leaf +.node)
%container (de-cont +.node)
==
++ de-leaf |= =node:leaf:markdown:md ^- block:tp
?~ node [%paragraph ~]
?- -.node
%heading (de-heading node)
%break [%paragraph :~([%break ~])]
%indent-codeblock [%codeblock text.node '']
%fenced-codeblock [%codeblock text.node info-string.node]
%html [%codeblock text.node 'html']
%link-ref-definition [%paragraph :~([%link '' label.node])]
%paragraph [%paragraph (de-inline contents.node)]
%blank-line [%paragraph :~([%break ~])]
%table [%paragraph :~([%break ~])] :: TODO
==
++ de-heading |= h=heading:leaf:markdown:md
:+ %heading (flatten-inline contents.h)
?: .=(1 level.h) %h1
?: .=(2 level.h) %h2
?: .=(3 level.h) %h3
?: .=(4 level.h) %h4
?: .=(5 level.h) %h5 %h6
++ de-inline |= inls=contents:inline:md
=| res=(list inline:tp)
|- ?~ inls (flop res)
=/ inl i.inls
=/ r=inline:tp ?- -.inl
%escape [%codespan char.inl]
%entity [%codespan code.inl]
%code-span [%codespan text.inl]
%line-break [%break ~]
%soft-line-break [%break ~]
%text [%text text.inl]
%emphasis (de-strong +.inl)
%strong (de-strong +.inl)
%link [%link (de-target target.inl) (flatten-inline contents.inl)]
%image [%img (de-target target.inl) alt-text.inl]
%autolink [%text '']
%html [%codespan text.inl]
==
$(inls t.inls, res [r res])
++ de-strong |= [char=@t inls=contents:inline:md]
?: .=('_' char) [%italic (flatten-inline inls)]
[%bold (flatten-inline inls)]
++ de-target |= tar=target:ln:md
:: TODO lotsa stuff here
?- -.tar
%direct text.url.urlt.tar
%ref label.tar
==
++ flatten-inline |= inls=contents:inline:md ^- @t
=/ res ""
|- ?~ inls (crip res)
=/ inl i.inls
=/ r ?+ -.inl ""
%escape (trip char.inl)
%entity (trip code.inl)
%code-span (trip text.inl)
%text (trip text.inl)
%emphasis (trip (flatten-inline contents.inl))
%strong (trip (flatten-inline contents.inl))
%link (trip (flatten-inline contents.inl))
%image (trip (de-target target.inl))
%html (trip text.inl)
==
$(inls t.inls, res "{res} {r}")
++ de-cont |= =node:container:markdown:md ^- block:tp
?~ node [%paragraph ~]
?- -.node
%block-quote [%blockquote (denest +.node)]
%ol [%list (de-list contents.node) .y]
%ul [%list (de-list contents.node) .n]
%tl [%tasklist (turn contents.node de-task)]
==
++ de-task |= [checked=? mde=markdown:md] ^- task:tp
:_ checked (denest mde)
++ de-list |= lmd=(list markdown:md) ^- (list li:tp)
=| res=(list li:tp)
|- ?~ lmd (flop res)
=/ nodelist i.lmd
=/ blocks %+ turn nodelist de-node
$(lmd t.lmd, res [blocks res])
++ denest |= mde=markdown:md ^- paragraph:tp
=| res=paragraph:tp
|- ?~ mde (flop res)
=/ block (de-node i.mde)
=/ r=paragraph:tp (break-block block)
=/ nr (weld res r)
$(mde t.mde, res nr)
++ break-block |= =block:tp ^- paragraph:tp
?+ -.block ~
%paragraph p.block
%blockquote p.block
%heading :~([%text p.block])
%codeblock :~([%text code.block])
%eval :~([%text hoon.block])
%list (break-list p.block)
==
++ break-list |= lis=(list li:tp) ^- paragraph:tp
=| res=paragraph:tp
|- ?~ lis (flop res)
=/ par (ibreak-list i.lis)
=/ nr (weld res par)
$(lis t.lis, res nr)
++ ibreak-list |= blocks=(list block:tp) ^- paragraph:tp
=| res=paragraph:tp
|- ?~ blocks (flop res)
=/ par (break-block i.blocks)
=/ nr (weld res par)
$(blocks t.blocks, res nr)
:: tape -> post:trill, parsing user input from Sail
+$ heading $?(%h1 %h2 %h3 %h4 %h5 %h6)
@ -191,16 +315,8 @@
%ship (scow %p p.i)
%codespan "`{(trip p.i)}`"
%link "[{(trip show.i)}]({(trip href.i)})"
%img "![{(trip alt.i)}]({(trip src.i)})"
%break "\0a"
:: TODO custom syntax
%date
=/ t (time:enjs:format p.i)
?. ?=(%n -.t) "" (trip p.t)
%note "" :: TODO
%underline (trip p.i)
%sup (trip p.i)
%sub (trip p.i)
%ruby (trip p.i)
==
++ tags-to-tape
|= t=(set @t) ^- tape

285
lib/rudder.hoon Normal file
View File

@ -0,0 +1,285 @@
:: rudder: framework for routing & serving simple web frontends
::
:: v1.0.2: newborn helmsman
::
:: the primary usage pattern involves your app calling steer:rudder
:: with a configuration, then calling the resulting gate with an
:: incoming request and relevant context.
::
:: %. [bowl [eyre-id inbound-request] dat]
:: %- (steer:rudder _dat cmd)
:: [pages route adlib solve]
::
:: dat is app state passed into and transformed by the frontend code.
:: cmd is the type of app actions that the frontend may produce.
:: pages is a (map term (page _dat cmd)), contains per-view frontend logic.
:: route is a routing function, turning a url query into a $place.
:: adlib gets called with the full request when no route is found.
:: solve is a function that applies a cmd resulting from a POST request.
::
:: the library provides some default implementations for route and adlib,
:: which you can construct using +point and +fours respectively.
::
:: for examples and a more detailed description of handling http requests,
:: see /lib/rudder/poke-example.hoon
::
:: pages implement a bundle of view logic, each implementing a door
:: with three arms.
::
:: +build gets called for GET requests, producing a $reply to render.
:: +argue gets called for POST requests, turning it into a cmd.
:: +final gets called after POST requests, producing a $reply to render.
::
:: for examples and a more detailed description of implementing a page,
:: see /lib/rudder/page-example.hoon
::
::TODO
:: - should rudder really be falling back to generic error messages when
:: calling +final after failure? what if apps/pages want to provide
:: their own generic error message?
:: - in the full-default setup, the behavior of +alert is a little bit
:: awkward. because +point forces routes to omit trailing slashes,
:: you cannot refer to "the current page" in a consistent way.
:: you have to either hardcode the page name, or pass the full url
:: from the inbound-request.
:: a router that forces inclusion of trailing slashes would let you
:: use '.', but has unconventional url semantics, and doesn't mesh
:: nicely with single-level routing.
:: - some inconsistency between the expected output of +adlib and +solve.
:: "briefless" +solve results may be common, so it's nice that they're
:: easy to write. for +adlib that probably isn't as relevant, and
:: the current factoring makes for a nice =^ in the lib code, but...
:: on the other hand, they're still different output types semantically,
:: so inconsistency isn't the end of the world. would have to see how
:: this ends up looking in practice.
:: - +argue is awkward because its function signature doesn't really work
:: if the cmd type is an atom.
:: - maybe unsupported methods should go to the fallback too?
:: - currently ambiguous: do you catch would-fail actions during +argue,
:: or in +solve? might be best to catch earlier, but this splits
:: or duplicates business logic between app and pages...
::
|%
+| %types :: outputs, inputs, function signatures
::
+$ reply
$% [%page bod=manx] :: html page
[%xtra hed=header-list:http bod=manx] :: html page w/ heads
[%next loc=@t msg=brief] :: 303, succeeded
[%move loc=@t] :: 308, use other
[%auth loc=@t] :: 307, please log in
[%code cod=@ud msg=brief] :: error code page
[%full ful=simple-payload:http] :: full payload
==
::
+$ place
$% [%page ath=? nom=term] :: serve from pages
[%away loc=(list @t)] :: 308, redirect
==
::
+$ query
$: trail
args=(list [key=@t value=@t])
==
::
+$ trail
[ext=(unit @ta) site=(list @t)]
::
+$ order [id=@ta inbound-request:eyre]
+$ route $-(trail (unit place))
+$ brief ?(~ @t)
::
++ page
|* [dat=mold cmd=mold]
$_ ^|
|_ [bowl:gall order dat]
++ build |~([(list [k=@t v=@t]) (unit [? @t])] *reply)
++ argue |~([header-list:http (unit octs)] *$@(brief cmd))
++ final |~([success=? msg=brief] *reply)
--
::
+$ card card:agent:gall
:: pilot: core server logic
::
+| %pilot
::
++ steer :: main helper constructor
|* [dat=mold cmd=mold]
|^ serve
+$ page (^page dat cmd)
+$ adlib $-(order [[(unit reply) (list card)] dat])
+$ solve $-(cmd $@(brief [brief (list card) dat]))
::
++ serve :: main helper
|= [pages=(map @ta page) =route =adlib =solve]
|= [=bowl:gall =order =dat]
^- (quip card _dat)
=* id id.order
=+ (purse url.request.order)
=/ target=(unit place)
(route -<)
:: if there is no route, fall back to adlib
::
?~ target
=^ [res=(unit reply) caz=(list card)] dat
(adlib order)
:_ dat
?~ res caz
(weld (spout id (paint u.res)) caz)
:: route might be a redirect
::
?: ?=(%away -.u.target)
=+ (rap 3 '/' (join '/' loc.u.target))
[(spout id (paint %move -)) dat]
:: route might require authentication
::
?: &(ath.u.target !authenticated.order)
[(spout id (paint %auth url.request.order)) dat]
:: route might have messed up and pointed to nonexistent page
::
?. (~(has by pages) nom.u.target)
[(spout id (issue 404 (cat 3 'no such page: ' nom.u.target))) dat]
::
%. [bowl order dat]
(apply (~(got by pages) nom.u.target) solve)
::
++ apply :: page usage helper
|= [=page =solve]
|= [=bowl:gall =order =dat]
^- (quip card _dat)
=. page ~(. page bowl order dat)
=* id id.order
?+ method.request.order
[(spout id (issue 405 ~)) dat]
::
%'GET'
:_ dat
=+ (purse url.request.order)
=^ msg args
::NOTE as set by %next replies
?~ msg=(get-header:http 'rmsg' args) [~ args]
[`[& u.msg] (delete-header:http 'rmsg' args)]
%+ spout id
(paint (build:page args msg))
::
%'POST'
?@ act=(argue:page [header-list body]:request.order)
:_ dat
=? act ?=(~ act) 'failed to parse request'
(spout id (paint (final:page | act)))
?@ res=(solve act)
:_ dat
=? act ?=(~ act) 'failed to process request'
(spout id (paint (final:page | res)))
:_ +>.res
=. +<+>.page +>.res
(weld (spout id (paint (final:page & -.res))) +<.res)
==
--
:: easy: hands-off steering behavior
::
+| %easy
::
++ point :: simple single-level routing, +route
|= [base=(lest @t) auth=? have=(set term)]
^- route
|= trail
^- (unit place)
?~ site=(decap base site) ~
?- u.site
~ `[%page auth %index]
[~ ~] `[%away (snip ^site)]
[%index ~] `[%away (snip ^site)]
[@ ~] ?:((~(has in have) i.u.site) `[%page auth i.u.site] ~)
[@ ~ ~] `[%away (snip ^site)]
* ~
==
::
++ fours :: simple 404 responses, +adlib
|* dat=*
:: ^- adlib:(rest * _dat)
|= *
[[`[%code 404 'no route found'] ~] dat]
::
++ alert :: simple redirecting +final handler
|= [next=@t build=$-([(list [@t @t]) (unit [? @t])] reply)]
|= [done=? =brief]
^- reply
?: done [%next next brief]
(build ~ `[| `@t`brief])
:: cargo: payload generation
::
+| %cargo
::
++ paint :: render response
|= =reply
^- simple-payload:http
?- -.reply
%page [[200 ['content-type' 'text/html']~] `(press bod.reply)]
%xtra =? hed.reply ?=(~ (get-header:http 'content-type' hed.reply))
['content-type'^'text/html' hed.reply]
[[200 hed.reply] `(press bod.reply)]
%next =; loc [[303 ['location' loc]~] ~]
?~ msg.reply loc.reply
%+ rap 3
:~ loc.reply
?:(?=(^ (find "?" (trip loc.reply))) '&' '?')
'rmsg='
(crip (en-urlt:html (trip msg.reply)))
==
%move [[308 ['location' loc.reply]~] ~]
%auth =/ loc (crip (en-urlt:html (trip loc.reply)))
[[307 ['location' (cat 3 '/~/login?redirect=' loc)]~] ~]
%code (issue +.reply)
%full ful.reply
==
::
++ issue :: render status code page
|= [cod=@ud msg=brief]
^- simple-payload:http
:- [cod ~]
=; nom=@t
`(as-octs:mimes:html (rap 3 ~[(scot %ud cod) ': ' nom '\0a' msg]))
?+ cod ''
%400 'bad request'
%404 'not found'
%405 'method not allowed'
%500 'internal server error'
==
:: utils: fidgeting
::
+| %utils
::
++ decap :: strip leading base from full site path
|= [base=(list @t) site=(list @t)]
^- (unit (list @t))
?~ base `site
?~ site ~
?. =(i.base i.site) ~
$(base t.base, site t.site)
::
++ frisk :: parse url-encoded form args
|= body=@t
%- ~(gas by *(map @t @t))
(fall (rush body yquy:de-purl:html) ~)
::
::NOTE the below (and $query) are also available in /lib/server.hoon,
:: but we reimplement them here for independence's sake.
::
++ purse :: url cord to query
|= url=@t
^- query
(fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~])
::
++ press :: manx to octs
(cork en-xml:html as-octt:mimes:html)
::
++ spout :: build full response cards
|= [eyre-id=@ta simple-payload:http]
^- (list card)
=/ =path /http-response/[eyre-id]
:~ [%give %fact ~[path] [%http-response-header !>(response-header)]]
[%give %fact ~[path] [%http-response-data !>(data)]]
[%give %kick ~[path] ~]
==
--

174
lib/seeds.hoon Normal file
View File

@ -0,0 +1,174 @@
|%
++ authors
^- (list @p)
:~
~zod
~polwex
~lagrev-nocfep
~lagrev-nocfep-polwex-nocfep
~sorreg-namtyv
==
++ titles
^- (list @t)
:~
'Helldivers 2 has caused over 20k Steam accounts to be banned'
'UI elements with a hand-drawn, sketchy look'
'60 kHz '
'Show HN: Every mountain, building and tree shadow mapped for any date and time'
'Snowflake breach: Hacker confirms access through infostealer infection'
'Heroku Postgres is now based on AWS Aurora'
'Armor from Mycenaean Greece turns out to have been effective'
'Why is no Laravel/Rails in JavaScript? Will there be one?'
'Moving Beyond Type Systems'
'Japanese \'My Number Card\' Digital IDs Coming to Apple\'s Wallet App'
'How to copy a file from a 30-year-old laptop'
' good corporate engineering blogs are written'
'Debian KDE: Right Linux distribution for professional digital painting in 2024'
'Go: Sentinel errors and errors.Is() slow your code down by 3000%'
'"Moveable Type" to end 17-year run in The New York Times\'s lobby'
'London\'s Evening Standard axes daily print edition'
'The Forth Deck mini: a portable Forth computer with a discrete CPU '
'Corcel – Use WordPress backend with Laravel or any PHP application '
'One Million Checkboxes '
'Next gen 3D metal printing '
'Figma Slides '
'GCCs new fortification level: The gains and costs '
'South Korean telecom company attacks torrent users with malware '
'Show HN: R2R V2 – A open source RAG engine with prod features '
'From RSS to My Kindle '
'How the STL Uses Explicit (quuxplusone.github.io)'
'The brain makes a lot of waste. Now scientists think they know where it goes'
'The plan-execute pattern '
'1Living Computers Museum to permanently close, auction vintage items '
'Tracing garbage collection for arenas '
'Upgrading my Chumby 8 kernel part 11: SD/CF card reader)'
'Exploring How Cache Memory Works '
'Compressing graphs and indexes with recursive graph bisection (2016)'
'Motion (YC W20) Is Hiring Our First DevOps Engineer '
'Ghosts in the ROM (2012) '
'Structured logs are the way to start '
'Test firing of a 3D-printed rocket engine designed through computational model (leap7m)'
'Took part in Apache ceremonies. schools expelled them for satanic activities'
'The Alternate Reality Kit (1987) [video] (youtube.com)'
'2How automotive radar measures the velocity of objects'
'2Super Mario 64 ported to the GBA [video]'
'APL Demonstration (1975) [video]'
'Composite modding another Atari, because colors are hard '
'Coup Attempt in Bolivia '
'Documentation Driven Development (2022) '
==
++ links
^- (list @t)
:~
'https://urbit.org'
'https://www.nytimes.com/2024/06/26/world/asia/china-children-crimes.html'
'https://news.ycombinator.com/item?id=40800548'
'https://instagram.com/my.cat.sandy'
'https://xiaohongshu.com'
'https://x.com/urbit/status/1806048064525779405'
'https://x.com/wispem_wantex/status/1790186423804633107'
==
++ md ^- (list @t)
:~
'Random post 1'
'Random post 2'
'Random post 3'
'Random post 4'
'Random post 5'
'![lol](https://afar.brightspotcdn.com/dims4/default/68ef509/2147483647/strip/false/crop/1440x720+0+0/resize/1440x720!/quality/90/?url=https%3A%2F%2Fk3-prod-afar-media.s3.us-west-2.amazonaws.com%2Fbrightspot%2Fcf%2F8a%2F20b4a2c544a58be93512ad67084c%2Fbohler-japankk-4006.jpg)'
'''
## Recipe: Chocolate Chip Cookies
**Ingredients:**
- 2 1/4 cups all-purpose flour
- 1 tsp baking soda
- 1 cup butter, softened
- 3/4 cup sugar
- 3/4 cup brown sugar
- 2 eggs
- 2 cups chocolate chips
**Instructions:**
1. Preheat oven to 375°F (190°C).
2. Mix dry ingredients in a bowl.
3. In another bowl, cream butter and sugars. Add eggs and mix well.
4. Combine wet and dry ingredients. Stir in chocolate chips.
5. Drop spoonfuls onto baking sheets and bake for 9-11 minutes.
![Chocolate Chip Cookies](https://example.com/cookies.jpg)
Enjoy your homemade cookies!
'''
'''
# Programming Languages Comparison
| Language | Type | Popular Use Cases |
|----------|------|-------------------|
| Python | Interpreted | Data Science, Web Development |
| Java | Compiled | Enterprise Applications, Android |
| JavaScript | Interpreted | Web Development, Server-side |
## Code Examples
Python:
```python
def greet(name):
print(f"Hello, {name}!")
'''
'''
# Book Review: "1984" by George Orwell
**Rating:** ⭐⭐⭐⭐⭐
"1984" is a dystopian novel that explores themes of totalitarianism, surveillance, and the manipulation of truth.
## Key Themes
1. Government control
2. Loss of privacy
3. Manipulation of language and history
> "Who controls the past controls the future. Who controls the present controls the past." - George Orwell, 1984
The book serves as a warning about the dangers of totalitarian regimes and the importance of individual freedom.
'''
'''
# The Solar System
Our solar system consists of the Sun and everything that orbits around it.
## Planets in Order from the Sun
1. Mercury
2. Venus
3. Earth (our home!)
4. Mars
5. Jupiter
6. Saturn
7. Uranus
8. Neptune
> Fun Fact: Pluto was once considered the 9th planet but was reclassified as a dwarf planet in 2006.
For more astronomical information, visit [NASA's website](https://www.nasa.gov).
'''
'''
# Travel Guide: Paris, France
Paris, known as the "City of Light," is famous for its art, cuisine, and architecture.
## Must-Visit Attractions
1. Eiffel Tower
2. Louvre Museum
3. Notre-Dame Cathedral
4. Arc de Triomphe
5. Champs-Élysées
> "Paris is always a good idea." - Audrey Hepburn
![Paris Skyline](https://example.com/paris.jpg)
Don't forget to try some authentic French cuisine while you're there!
'''
==
--

51
lib/skeleton.hoon Normal file
View File

@ -0,0 +1,51 @@
:: Similar to default-agent except crashes everywhere
^- agent:gall
|_ bowl:gall
++ on-init
^- (quip card:agent:gall agent:gall)
!!
::
++ on-save
^- vase
!!
::
++ on-load
|~ old-state=vase
^- (quip card:agent:gall agent:gall)
!!
::
++ on-poke
|~ in-poke-data=cage
^- (quip card:agent:gall agent:gall)
!!
::
++ on-watch
|~ path
^- (quip card:agent:gall agent:gall)
!!
::
++ on-leave
|~ path
^- (quip card:agent:gall agent:gall)
!!
::
++ on-peek
|~ path
^- (unit (unit cage))
!!
::
++ on-agent
|~ [wire sign:agent:gall]
^- (quip card:agent:gall agent:gall)
!!
::
++ on-arvo
|~ [wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
!!
::
++ on-fail
|~ [term tang]
^- (quip card:agent:gall agent:gall)
!!
--

83
lib/sortug.hoon
View File

@ -1,17 +1,22 @@
:: Painstakingly built utility functions by Sortug Development Ltd.
:: There's more where it came from
:: Parsing
|%
++ b64 (bass 64 (plus siw:ab))
++ b16 (bass 16 (plus six:ab))
++ scow
|= [mod=@tas a=@] ^- tape
?+ mod ""
%s (signed-scow a)
%ud (a-co:co a)
%ux ((x-co:co 0) a)
%uv ((v-co:co 0) a)
%uw ((w-co:co 0) a)
==
++ signed-scow |= a=@s ^- tape
=/ old (old:si a)
=/ num (scow %ud +.old)
=/ sign=tape ?: -.old "" "-"
"{sign}{num}"
++ slaw
|= [mod=@tas txt=@t] ^- (unit @)
?+ mod ~
@ -30,4 +35,80 @@
?~ a b
=/ nb (c i i.a b)
$(a t.a, b nb, i +(i))
++ parsing
|%
++ link auri:de-purl:html
++ para
|%
++ eof ;~(less next (easy ~))
++ white (mask "\09 ")
++ blank ;~(plug (star white) (just '\0a'))
++ hard-wrap (cold ' ' ;~(plug blank (star white)))
++ one-space (cold ' ' (plus white))
++ empty
;~ pose
;~(plug blank (plus blank))
;~(plug (star white) eof)
;~(plug blank (star white) eof)
==
++ para
%+ ifix
[(star white) empty]
%- plus
;~ less
empty
next
==
--
++ trim para:para :: from whom/lib/docu
++ youtube
;~ pfix
;~ plug
(jest 'https://')
;~ pose
(jest 'www.youtube.com/watch?v=')
(jest 'youtube.com/watch?v=')
(jest 'youtu.be/')
==
==
;~ sfix
(star aln)
(star next)
==
==
++ twatter
;~ pfix
;~ plug
(jest 'https://')
;~ pose
(jest 'x.com/')
(jest 'twitter.com/')
==
(star ;~(less fas next))
(jest '/status/')
==
;~ sfix
(star nud)
(star next)
==
==
++ img-set
%- silt
:~ ~.webp
~.png
~.jpeg
~.jpg
~.svg
==
++ is-img
|= t=@ta
(~(has in img-set) t)
++ is-image
|= url=@t ^- ?
=/ u=(unit purl:eyre) (de-purl:html url)
?~ u .n
=/ ext p.q.u.u
?~ ext .n
(~(has in img-set) u.ext)
--
--

1
lib/strand.hoon Normal file
View File

@ -0,0 +1 @@
rand

832
lib/strandio.hoon Normal file
View File

@ -0,0 +1,832 @@
/- spider
/+ libstrand=strand
=, strand=strand:libstrand
=, strand-fail=strand-fail:libstrand
|%
++ send-raw-cards
|= cards=(list =card:agent:gall)
=/ m (strand ,~)
^- form:m
|= strand-input:strand
[cards %done ~]
::
++ send-raw-card
|= =card:agent:gall
=/ m (strand ,~)
^- form:m
(send-raw-cards card ~)
::
++ ignore
|= tin=strand-input:strand
`[%fail %ignore ~]
::
++ get-bowl
=/ m (strand ,bowl:strand)
^- form:m
|= tin=strand-input:strand
`[%done bowl.tin]
::
++ get-beak
=/ m (strand ,beak)
^- form:m
|= tin=strand-input:strand
`[%done [our q.byk da+now]:bowl.tin]
::
++ get-time
=/ m (strand ,@da)
^- form:m
|= tin=strand-input:strand
`[%done now.bowl.tin]
::
++ get-our
=/ m (strand ,ship)
^- form:m
|= tin=strand-input:strand
`[%done our.bowl.tin]
::
++ get-entropy
=/ m (strand ,@uvJ)
^- form:m
|= tin=strand-input:strand
`[%done eny.bowl.tin]
::
:: Convert skips to %ignore failures.
::
:: This tells the main loop to try the next handler.
::
++ handle
|* a=mold
=/ m (strand ,a)
|= =form:m
^- form:m
|= tin=strand-input:strand
=/ res (form tin)
=? next.res ?=(%skip -.next.res)
[%fail %ignore ~]
res
::
:: Wait for a poke with a particular mark
::
++ take-poke
|= =mark
=/ m (strand ,vase)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~
`[%wait ~]
::
[~ %poke @ *]
?. =(mark p.cage.u.in.tin)
`[%skip ~]
`[%done q.cage.u.in.tin]
==
::
++ take-sign-arvo
=/ m (strand ,[wire sign-arvo])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~
`[%wait ~]
::
[~ %sign *]
`[%done [wire sign-arvo]:u.in.tin]
==
::
:: Wait for a subscription update on a wire
::
++ take-fact-prefix
|= =wire
=/ m (strand ,[path cage])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %fact *]
?. =(watch+wire (scag +((lent wire)) wire.u.in.tin))
`[%skip ~]
`[%done (slag (lent wire) wire.u.in.tin) cage.sign.u.in.tin]
==
::
:: Wait for a subscription update on a wire
::
++ take-fact
|= =wire
=/ m (strand ,cage)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %fact *]
?. =(watch+wire wire.u.in.tin)
`[%skip ~]
`[%done cage.sign.u.in.tin]
==
::
:: Wait for a subscription close
::
++ take-kick
|= =wire
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %kick *]
?. =(watch+wire wire.u.in.tin)
`[%skip ~]
`[%done ~]
==
::
++ echo
=/ m (strand ,~)
^- form:m
%- (main-loop ,~)
:~ |= ~
^- form:m
;< =vase bind:m ((handle ,vase) (take-poke %echo))
=/ message=tape !<(tape vase)
%- (slog leaf+"{message}..." ~)
;< ~ bind:m (sleep ~s2)
%- (slog leaf+"{message}.." ~)
(pure:m ~)
::
|= ~
^- form:m
;< =vase bind:m ((handle ,vase) (take-poke %over))
%- (slog leaf+"over..." ~)
(pure:m ~)
==
::
++ take-watch
=/ m (strand ,path)
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %watch *]
`[%done path.u.in.tin]
==
::
++ take-wake
|= until=(unit @da)
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%wait @ ~] %behn %wake *]
?. |(?=(~ until) =(`u.until (slaw %da i.t.wire.u.in.tin)))
`[%skip ~]
?~ error.sign-arvo.u.in.tin
`[%done ~]
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
==
::
++ take-tune
|= =wire
=/ m (strand ,[spar:ames (unit roar:ames)])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
::
[~ %sign * %ames %tune ^ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
::
++ take-near
|= =wire
=/ m (strand ,[spar:ames (unit (unit page))])
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
::
[~ %sign * %ames %near ^ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
::
++ take-poke-ack
|= =wire
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %poke-ack *]
?. =(wire wire.u.in.tin)
`[%skip ~]
?~ p.sign.u.in.tin
`[%done ~]
`[%fail %poke-fail u.p.sign.u.in.tin]
==
::
++ take-watch-ack
|= =wire
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %watch-ack *]
?. =(watch+wire wire.u.in.tin)
`[%skip ~]
?~ p.sign.u.in.tin
`[%done ~]
`[%fail %watch-ack-fail u.p.sign.u.in.tin]
==
::
++ poke
|= [=dock =cage]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
;< ~ bind:m (send-raw-card card)
(take-poke-ack /poke)
::
++ raw-poke
|= [=dock =cage]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
;< ~ bind:m (send-raw-card card)
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~
`[%wait ~]
::
[~ %agent * %poke-ack *]
?. =(/poke wire.u.in.tin)
`[%skip ~]
`[%done ~]
==
::
++ raw-poke-our
|= [app=term =cage]
=/ m (strand ,~)
^- form:m
;< =bowl:spider bind:m get-bowl
(raw-poke [our.bowl app] cage)
::
++ poke-our
|= [=term =cage]
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(poke [our term] cage)
::
++ watch
|= [=wire =dock =path]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass watch+wire %agent dock %watch path]
;< ~ bind:m (send-raw-card card)
(take-watch-ack wire)
::
++ watch-one
|= [=wire =dock =path]
=/ m (strand ,cage)
^- form:m
;< ~ bind:m (watch wire dock path)
;< =cage bind:m (take-fact wire)
;< ~ bind:m (take-kick wire)
(pure:m cage)
::
++ watch-our
|= [=wire =term =path]
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(watch wire [our term] path)
::
++ scry
|* [=mold =path]
=/ m (strand ,mold)
^- form:m
?> ?=(^ path)
?> ?=(^ t.path)
;< =bowl:spider bind:m get-bowl
%- pure:m
.^(mold i.path (scot %p our.bowl) i.t.path (scot %da now.bowl) t.t.path)
::
++ leave
|= [=wire =dock]
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall [%pass watch+wire %agent dock %leave ~]
(send-raw-card card)
::
++ leave-our
|= [=wire =term]
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(leave wire [our term])
::
++ rewatch
|= [=wire =dock =path]
=/ m (strand ,~)
;< ~ bind:m ((handle ,~) (take-kick wire))
;< ~ bind:m (flog-text "rewatching {<dock>} {<path>}")
;< ~ bind:m (watch wire dock path)
(pure:m ~)
::
++ wait
|= until=@da
=/ m (strand ,~)
^- form:m
;< ~ bind:m (send-wait until)
(take-wake `until)
::
++ keen
|= [=wire =spar:ames]
=/ m (strand ,~)
^- form:m
(send-raw-card %pass wire %arvo %a %keen ~ spar)
::
++ keen-shut
|= [=wire =spar:ames]
=/ m (strand ,~)
^- form:m
(send-raw-card %pass wire %keen & spar)
::
++ sleep
|= for=@dr
=/ m (strand ,~)
^- form:m
;< now=@da bind:m get-time
(wait (add now for))
::
++ send-wait
|= until=@da
=/ m (strand ,~)
^- form:m
=/ =card:agent:gall
[%pass /wait/(scot %da until) %arvo %b %wait until]
(send-raw-card card)
::
++ map-err
|* computation-result=mold
=/ m (strand ,computation-result)
|= [f=$-([term tang] [term tang]) computation=form:m]
^- form:m
|= tin=strand-input:strand
=* loop $
=/ c-res (computation tin)
?: ?=(%cont -.next.c-res)
c-res(self.next ..loop(computation self.next.c-res))
?. ?=(%fail -.next.c-res)
c-res
c-res(err.next (f err.next.c-res))
::
++ set-timeout
|* computation-result=mold
=/ m (strand ,computation-result)
|= [time=@dr computation=form:m]
^- form:m
;< now=@da bind:m get-time
=/ when (add now time)
=/ =card:agent:gall
[%pass /timeout/(scot %da when) %arvo %b %wait when]
;< ~ bind:m (send-raw-card card)
|= tin=strand-input:strand
=* loop $
?: ?& ?=([~ %sign [%timeout @ ~] %behn %wake *] in.tin)
=((scot %da when) i.t.wire.u.in.tin)
==
`[%fail %timeout ~]
=/ c-res (computation tin)
?: ?=(%cont -.next.c-res)
c-res(self.next ..loop(computation self.next.c-res))
?: ?=(%done -.next.c-res)
=/ =card:agent:gall
[%pass /timeout/(scot %da when) %arvo %b %rest when]
c-res(cards [card cards.c-res])
c-res
::
++ send-request
|= =request:http
=/ m (strand ,~)
^- form:m
(send-raw-card %pass /request %arvo %i %request request *outbound-config:iris)
::
++ send-cancel-request
=/ m (strand ,~)
^- form:m
(send-raw-card %pass /request %arvo %i %cancel-request ~)
::
++ take-client-response
=/ m (strand ,client-response:iris)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
::
[~ %sign [%request ~] %iris %http-response %cancel *]
::NOTE iris does not (yet?) retry after cancel, so it means failure
:- ~
:+ %fail
%http-request-cancelled
['http request was cancelled by the runtime']~
::
[~ %sign [%request ~] %iris %http-response %finished *]
`[%done client-response.sign-arvo.u.in.tin]
==
::
:: Wait until we get an HTTP response or cancelation and unset contract
::
++ take-maybe-sigh
=/ m (strand ,(unit httr:eyre))
^- form:m
;< rep=(unit client-response:iris) bind:m
take-maybe-response
?~ rep
(pure:m ~)
:: XX s/b impossible
::
?. ?=(%finished -.u.rep)
(pure:m ~)
(pure:m (some (to-httr:iris +.u.rep)))
::
++ take-maybe-response
=/ m (strand ,(unit client-response:iris))
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%request ~] %iris %http-response %cancel *]
`[%done ~]
[~ %sign [%request ~] %iris %http-response %finished *]
`[%done `client-response.sign-arvo.u.in.tin]
==
::
++ extract-body
|= =client-response:iris
=/ m (strand ,cord)
^- form:m
?> ?=(%finished -.client-response)
%- pure:m
?~ full-file.client-response ''
q.data.u.full-file.client-response
::
++ fetch-cord
|= url=tape
=/ m (strand ,cord)
^- form:m
=/ =request:http [%'GET' (crip url) ~ ~]
;< ~ bind:m (send-request request)
;< =client-response:iris bind:m take-client-response
(extract-body client-response)
::
++ fetch-json
|= url=tape
=/ m (strand ,json)
^- form:m
;< =cord bind:m (fetch-cord url)
=/ json=(unit json) (de:json:html cord)
?~ json
(strand-fail %json-parse-error ~)
(pure:m u.json)
::
++ hiss-request
|= =hiss:eyre
=/ m (strand ,(unit httr:eyre))
^- form:m
;< ~ bind:m (send-request (hiss-to-request:html hiss))
take-maybe-sigh
::
:: +build-file: build the source file at the specified $beam
::
++ build-file
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,(unit vase))
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %a case spur)
?~ riot
(pure:m ~)
?> =(%vase p.r.u.riot)
(pure:m (some !<(vase q.r.u.riot)))
::
++ build-file-hard
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay
bind:m
(warp ship desk ~ %sing %a case spur)
?> ?=(^ riot)
?> ?=(%vase p.r.u.riot)
(pure:m !<(vase q.r.u.riot))
:: +build-mark: build a mark definition to a $dais
::
++ build-mark
|= [[=ship =desk =case] mak=mark]
=* arg +<
=/ m (strand ,dais:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak])
?~ riot
(strand-fail %build-mark >arg< ~)
?> =(%dais p.r.u.riot)
(pure:m !<(dais:clay q.r.u.riot))
:: +build-tube: build a mark conversion gate ($tube)
::
++ build-tube
|= [[=ship =desk =case] =mars:clay]
=* arg +<
=/ m (strand ,tube:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %c case /[a.mars]/[b.mars])
?~ riot
(strand-fail %build-tube >arg< ~)
?> =(%tube p.r.u.riot)
(pure:m !<(tube:clay q.r.u.riot))
::
:: +build-nave: build a mark definition to a $nave
::
++ build-nave
|= [[=ship =desk =case] mak=mark]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %e case /[mak])
?~ riot
(strand-fail %build-nave >arg< ~)
?> =(%nave p.r.u.riot)
(pure:m q.r.u.riot)
:: +build-cast: build a mark conversion gate (static)
::
++ build-cast
|= [[=ship =desk =case] =mars:clay]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %f case /[a.mars]/[b.mars])
?~ riot
(strand-fail %build-cast >arg< ~)
?> =(%cast p.r.u.riot)
(pure:m q.r.u.riot)
::
:: Read from Clay
::
++ warp
|= [=ship =riff:clay]
=/ m (strand ,riot:clay)
;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
(take-writ /warp)
::
++ read-file
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,cage)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
?~ riot
(strand-fail %read-file >arg< ~)
(pure:m r.u.riot)
::
++ check-for-file
|= [[=ship =desk =case] =spur]
=/ m (strand ,?)
;< =riot:clay bind:m (warp ship desk ~ %sing %u case spur)
?> ?=(^ riot)
(pure:m !<(? q.r.u.riot))
::
++ list-tree
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,(list path))
;< =riot:clay bind:m (warp ship desk ~ %sing %t case spur)
?~ riot
(strand-fail %list-tree >arg< ~)
(pure:m !<((list path) q.r.u.riot))
::
:: Take Clay read result
::
++ take-writ
|= =wire
=/ m (strand ,riot:clay)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign * ?(%behn %clay) %writ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
:: +check-online: require that peer respond before timeout
::
++ check-online
|= [who=ship lag=@dr]
=/ m (strand ,~)
^- form:m
%+ (map-err ,~) |=(* [%offline *tang])
%+ (set-timeout ,~) lag
;< ~ bind:m
(poke [who %hood] %helm-hi !>(~))
(pure:m ~)
::
++ eval-hoon
|= [gen=hoon bez=(list beam)]
=/ m (strand ,vase)
^- form:m
=/ sut=vase !>(..zuse)
|-
?~ bez
(pure:m (slap sut gen))
;< vax=vase bind:m (build-file-hard i.bez)
$(bez t.bez, sut (slop vax sut))
::
++ send-thread
|= [=bear:khan =shed:khan =wire]
=/ m (strand ,~)
^- form:m
(send-raw-card %pass wire %arvo %k %lard bear shed)
::
:: Queue on skip, try next on fail %ignore
::
++ main-loop
|* a=mold
=/ m (strand ,~)
=/ m-a (strand ,a)
=| queue=(qeu (unit input:strand))
=| active=(unit [in=(unit input:strand) =form:m-a forms=(list $-(a form:m-a))])
=| state=a
|= forms=(lest $-(a form:m-a))
^- form:m
|= tin=strand-input:strand
=* top `form:m`..$
=. queue (~(put to queue) in.tin)
|^ (continue bowl.tin)
::
++ continue
|= =bowl:strand
^- output:m
?> =(~ active)
?: =(~ queue)
`[%cont top]
=^ in=(unit input:strand) queue ~(get to queue)
^- output:m
=. active `[in (i.forms state) t.forms]
^- output:m
(run bowl in)
::
++ run
^- form:m
|= tin=strand-input:strand
^- output:m
?> ?=(^ active)
=/ res (form.u.active tin)
=/ =output:m
?- -.next.res
%wait `[%wait ~]
%skip `[%cont ..$(queue (~(put to queue) in.tin))]
%cont `[%cont ..$(active `[in.u.active self.next.res forms.u.active])]
%done (continue(active ~, state value.next.res) bowl.tin)
%fail
?: &(?=(^ forms.u.active) ?=(%ignore p.err.next.res))
%= $
active `[in.u.active (i.forms.u.active state) t.forms.u.active]
in.tin in.u.active
==
`[%fail err.next.res]
==
[(weld cards.res cards.output) next.output]
--
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(strand-fail %retry-too-many ~)
;< ~ bind:m (backoff try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ backoff
|= [try=@ud limit=@dr]
=/ m (strand ,~)
^- form:m
;< eny=@uvJ bind:m get-entropy
%- sleep
%+ min limit
?: =(0 try) ~s0
%+ add
(mul ~s1 (bex (dec try)))
(mul ~s0..0001 (~(rad og eny) 1.000))
::
:: ----
::
:: Output
::
++ flog
|= =flog:dill
=/ m (strand ,~)
^- form:m
(send-raw-card %pass / %arvo %d %flog flog)
::
++ flog-text
|= =tape
=/ m (strand ,~)
^- form:m
(flog %text tape)
::
++ flog-tang
|= =tang
=/ m (strand ,~)
^- form:m
=/ =wall
(zing (turn (flop tang) (cury wash [0 80])))
|- ^- form:m
=* loop $
?~ wall
(pure:m ~)
;< ~ bind:m (flog-text i.wall)
loop(wall t.wall)
::
++ trace
|= =tang
=/ m (strand ,~)
^- form:m
(pure:m ((slog tang) ~))
::
++ app-message
|= [app=term =cord =tang]
=/ m (strand ,~)
^- form:m
=/ msg=tape :(weld (trip app) ": " (trip cord))
;< ~ bind:m (flog-text msg)
(flog-tang tang)
::
:: ----
::
:: Handle domains
::
++ install-domain
|= =turf
=/ m (strand ,~)
^- form:m
(send-raw-card %pass / %arvo %e %rule %turf %put turf)
::
:: ----
::
:: Threads
::
++ start-thread
|= file=term
=/ m (strand ,tid:spider)
;< =bowl:spider bind:m get-bowl
(start-thread-with-args byk.bowl file *vase)
::
++ start-thread-with-args
|= [=beak file=term args=vase]
=/ m (strand ,tid:spider)
^- form:m
;< =bowl:spider bind:m get-bowl
=/ tid
(scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl))))
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid beak file args])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start
(pure:m tid)
::
+$ thread-result
(each vase [term tang])
::
++ await-thread
|= [file=term args=vase]
=/ m (strand ,thread-result)
^- form:m
;< =bowl:spider bind:m get-bowl
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid byk.bowl file args])
;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start
;< =cage bind:m (take-fact /awaiting/[tid])
;< ~ bind:m (take-kick /awaiting/[tid])
?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
%thread-done (pure:m %& q.cage)
%thread-fail (pure:m %| ;;([term tang] q.q.cage))
==
--

182
lib/verb.hoon Normal file
View File

@ -0,0 +1,182 @@
:: Print what your agent is doing.
::
/- *verb
::
|= [loud=? =agent:gall]
=| bowl-print=_|
^- agent:gall
|^ !.
|_ =bowl:gall
+* this .
ag ~(. agent bowl)
::
++ on-init
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-init"))
=^ cards agent on-init:ag
:_ this
:_ :_ cards
(emit-event %on-init ~)
(emit-event-plus bowl [%on-init ~] cards)
::
++ on-save
^- vase
%- (print bowl |.("{<dap.bowl>}: on-save"))
on-save:ag
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-load"))
=^ cards agent (on-load:ag old-state)
:_ this
:_ :_ cards
(emit-event %on-load ~)
(emit-event-plus bowl [%on-load ~] cards)
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-poke with mark {<mark>}"))
?: ?=(%verb mark)
?- !<(?(%loud %bowl) vase)
%loud `this(loud !loud)
%bowl `this(bowl-print !bowl-print)
==
=^ cards agent (on-poke:ag mark vase)
:_ this
:_ :_ cards
(emit-event %on-poke mark)
(emit-event-plus bowl [%on-poke mark (mug q.vase)] cards)
::
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-watch on path {<path>}"))
=^ cards agent
?: ?=([%verb ?(%events %events-plus) ~] path)
[~ agent]
(on-watch:ag path)
:_ this
:_ :_ cards
(emit-event %on-watch path)
(emit-event-plus bowl [%on-watch path] cards)
::
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-leave on path {<path>}"))
?: ?=([%verb %event ~] path)
[~ this]
=^ cards agent (on-leave:ag path)
:_ this
:_ :_ cards
(emit-event %on-leave path)
(emit-event-plus bowl [%on-leave path] cards)
::
++ on-peek
|= =path
^- (unit (unit cage))
%- (print bowl |.("{<dap.bowl>}: on-peek on path {<path>}"))
(on-peek:ag path)
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-agent on wire {<wire>}, {<-.sign>}"))
=^ cards agent (on-agent:ag wire sign)
:_ this
:_ :_ cards
(emit-event %on-agent wire -.sign)
=; =^sign
(emit-event-plus bowl [%on-agent wire sign] cards)
?- -.sign
%poke-ack [%poke-ack ?=(~ p.sign)]
%watch-ack [%watch-ack ?=(~ p.sign)]
%kick [%kick ~]
%fact [%fact p.cage.sign (mug q.q.cage.sign)]
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
%- %+ print bowl |.
"{<dap.bowl>}: on-arvo on wire {<wire>}, {<[- +<]:sign-arvo>}"
=^ cards agent (on-arvo:ag wire sign-arvo)
:_ this
:_ :_ cards
(emit-event %on-arvo wire [- +<]:sign-arvo)
(emit-event-plus bowl [%on-arvo wire [- +<]:sign-arvo] cards)
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
%- (print bowl |.("{<dap.bowl>}: on-fail with term {<term>}"))
=^ cards agent (on-fail:ag term tang)
:_ this
:_ :_ cards
(emit-event %on-fail term)
(emit-event-plus bowl [%on-fail term] cards)
--
::
++ print
|= [=bowl:gall render=(trap tape)]
^+ same
=? . bowl-print
%- (slog >bowl< ~)
.
?. loud same
%- (slog [%leaf $:render] ~)
same
::
++ emit-event
|= =event
^- card:agent:gall
[%give %fact ~[/verb/events] %verb-event !>(event)]
::
++ emit-event-plus
|= [=bowl:gall =cause cards=(list card:agent:gall)]
^- card:agent:gall
=; event=event-plus
[%give %fact ~[/verb/events-plus] %verb-event-plus !>(event)]
=- [act.bowl now.bowl src.bowl sap.bowl cause -]
%+ turn cards
|= =card:agent:gall
^- effect
::TODO for %fact, %kick, could calculate how many ships affected
?- card
[%pass * %agent * ?(%poke %poke-as) *]
=, q.card
=/ =cage ?-(-.task.q.card %poke cage.task, %poke-as [mark.task q.cage.task])
[%poke p.card [ship name] p.cage `@`(mug q.q.cage)]
::
[%pass * %agent * ?(%watch %watch-as) *]
=, q.card
=/ =path ?-(-.task.q.card %watch path.task, %watch-as path.task)
[%watch p.card [ship name] path]
::
[%pass * %agent * %leave *]
=, q.card
[%leave p.card [ship name]]
::
[%give %fact *]
=, p.card
[%fact paths p.cage (mug q.q.cage)]
::
[%give %kick *]
[%kick paths.p.card]
::
[%give ?(%poke-ack %watch-ack) *]
~| %explicit-ack
!! :: shouldn't be given explicitly
::
[%pass * %arvo *]
[%arvo p.card -.q.card +<.q.card]
::
[%pass *]
[%arvo p.card %$ -.q.card]
::
[%slip *]
$(card [%pass //slip p.card])
==
--

25
mar/tang.hoon Normal file
View File

@ -0,0 +1,25 @@
::
:::: /hoon/tang/mar
::
/? 310
::
=, format
|_ tan=(list tank)
++ grad %noun
++ grow
|%
++ noun tan
++ json
=/ result=(each (list ^json) tang)
(mule |.((turn tan tank:enjs:format)))
?- -.result
%& a+p.result
%| a+[a+[%s '[[output rendering error]]']~]~
==
--
++ grab :: convert from
|%
++ noun (list ^tank) :: clam from %noun
++ tank |=(a=^tank [a]~)
--
--

9
sur/forum.hoon
View File

@ -1,5 +1,12 @@
/- tp=post
|%
+$ pokes [%ui eyre-id=@ta p=ui-pokes]
+$ ui-pokes
$% [%submit-comment ted=thread text=@t]
[%submit-reply =comment:tp text=@t]
[%submit-thread title=@t url=@t text=@t]
[%vote ted=? =pid:tp vote=?]
==
+$ state
$% state-0
==
@ -8,7 +15,7 @@ $: %0
=threads
popular=pfeed
comments=gfeed:tp
karma=(map @p @ud)
karma=(map @p @sd)
::
mods=(set @p)
admins=(set @p)

157
sur/markdown.hoon Normal file
View File

@ -0,0 +1,157 @@
=> |%
++ ln
|%
::
:: Url: optionally enclosed in triangle brackets
:: A link destination consists of either
:: - a sequence of zero or more characters between an opening < and a closing > that
:: contains no line breaks or unescaped < or > characters, or
:: - a nonempty sequence of characters that does not start with <, does not include
:: ASCII space or control characters, and includes parentheses only if (a) they are
:: backslash-escaped or (b) they are part of a balanced pair of unescaped parentheses.
:: (Implementations may impose limits on parentheses nesting to avoid performance
:: issues, but at least three levels of nesting should be supported.)
+$ url [text=@t has-triangle-brackets=?]
::
:: Url with optional title-text
+$ urlt [=url title-text=(unit @t)]
::
:: Link target: the part of a link after the display text. can be direct or reference
:: A reference link is in square brackets, and refers to a named link elsewhere.
:: - full => [Display][foo]
:: - collapsed => [Display][]
:: - shortcut => [Display]
:: Collapsed and shortcut links have a `label` equal to the display text.
+$ target $% [%direct =urlt]
[%ref type=?(%full %collapsed %shortcut) label=@t]
==
--
--
::
|%
::
:: Markdown document or fragment: a list of nodes
++ markdown =< $+ markdown
(list node)
|%
+$ node $+ markdown-node
$@ ~ :: `$@ ~` is magic that makes recursive structures work
$% [%leaf node:leaf]
[%container node:container]
==
--
::
++ inline
|%
:: A single inline element
++ element $+ inline-element
$@ ~
$%(escape entity code hardbrk softbrk text emphasis strong link image autolink html)
::
:: Any amount of elements
++ contents (list element)
::
:: -----------------------
:: List of inline elements
:: -----------------------
::
:: Backslash-escaped character
+$ escape [%escape char=@t]
::
:: HTML-entity
+$ entity [%entity code=@t]
::
:: Code span (inline code). Interpreted literally, cannot have nested elements.
:: Can be enclosed by any amount of backticks on each side, >= 1. Must be balanced.
+$ code [%code-span num-backticks=@ text=@t]
::
:: Line break
+$ hardbrk [%line-break ~]
::
:: Soft line break: a newline in the source code, will be rendered as a single space
+$ softbrk [%soft-line-break ~]
::
:: Text: Just text
+$ text [%text text=@t]
::
:: Emphasis and strong emphasis
:: Can use either tar "*" or cab "_" as the emphasis character.
:: Can have nested inline elements.
+$ emphasis [%emphasis emphasis-char=@t =contents]
+$ strong [%strong emphasis-char=@t =contents]
::
:: Link
+$ link [%link =contents =target:ln]
::
:: Images
+$ image [%image alt-text=@t =target:ln]
::
:: Autolink: a link that's just itself, surrounded by "<...>"
+$ autolink [%autolink text=@t]
::
:: HTML
+$ html [%html text=@t]
--
::
:: Leaf nodes: non-nested (i.e., terminal) nodes
++ leaf
|%
++ node $+ leaf-node
$@ ~
$%(heading break codeblk-indent codeblk-fenced html link-ref-def table paragraph blank-line)
::
:: Heading, either setext or ATX style
+$ heading [%heading style=?(%setext %atx) level=@ =contents:inline]
::
:: Thematic break (horizontal line)
:: Consists of at least 3 repetitions of either hep '-', cab '_', or tar '*'
+$ break [%break char=@t char-count=@]
::
:: Indentation-based code block: indented 4 spaces. Can include newlines and blank lines.
+$ codeblk-indent [%indent-codeblock text=@t]
::
:: Fenced code block: begins and ends with 3+ repetitions of tic (`) or sig (~).
:: Can be indented up to 3 spaces.
+$ codeblk-fenced [%fenced-codeblock char=@t char-count=@ info-string=@t indent-level=@ text=@t]
::
:: HTML
+$ html [%html text=@t]
::
:: Link reference definition (defines a named link which can be referenced elsewhere)
+$ link-ref-def [%link-ref-definition label=@t =urlt:ln]
::
:: Paragraph
+$ paragraph [%paragraph =contents:inline]
::
:: Blank lines (not rendered, but lets user control aethetic layout of the source code)
+$ blank-line [%blank-line ~]
::
:: Table (alignments: [l]eft, [r]ight, [c]enter, [n]one)
+$ table [%table widths=(list @) head=(list contents:inline) align=(list ?(%l %c %r %n)) rows=(list (list contents:inline))]
--
::
:: Container node: can contain other nodes (either container or leaf).
++ container
|%
++ node $+ container-node
$@ ~
$%(block-quote ol ul tl)
::
:: Block quote. Can be nested.
+$ block-quote [%block-quote =markdown]
::
:: Ordered list: numbered based on first list item marker.
:: Marker char can be either dot '1. asdf' or par '1) asdf'
:: Can be indented up to 3 spaces
+$ ol [%ol indent-level=@ marker-char=@t start-num=@ contents=(list markdown)] :: is-tight=?
::
:: Unordered list: bullet point list
:: Marker char can be either hep (-), lus (+) or tar (*)
:: Can be indented up to 3 spaces
+$ ul [%ul indent-level=@ marker-char=@t contents=(list markdown)] :: is-tight=?
::
:: Task list: unordered list of tasks
:: Can be indented up to 3 spaces
+$ tl [%tl indent-level=@ marker-char=@t contents=(list [is-checked=? =markdown])] :: is-tight=?
--
--

15
sur/post.hoon
View File

@ -17,7 +17,7 @@
$: =id
author=ship
thread=pid
parent=(unit pid)
parent=pid
children=(set pid)
contents=content-list
=votes
@ -33,12 +33,14 @@
+$ block
$% [%paragraph p=paragraph]
[%blockquote p=paragraph]
:: table
clist
[%heading p=cord q=heading]
[%media =media]
[%codeblock code=cord lang=cord]
[%eval hoon=cord]
:: table
clist
[%tasklist p=(list task)]
::
[%ref app=term =ship =path]
@ -68,14 +70,9 @@
[%strike p=cord]
[%codespan p=cord]
[%link href=cord show=cord]
[%img src=cord alt=cord]
[%break ~]
:: not strictly markdown
[%ship p=ship]
[%date p=@da]
[%note id=cord text=(list inline)] :: footnotes and so on
[%underline p=cord]
[%sup p=cord]
[%sub p=cord]
[%ruby p=cord q=cord]
==
--

27
sur/spider.hoon Normal file
View File

@ -0,0 +1,27 @@
/+ libstrand=strand
=, strand=strand:libstrand
|%
+$ thread $-(vase shed:khan)
+$ input [=tid =cage]
+$ tid tid:strand
+$ bowl bowl:strand
+$ http-error
$? %bad-request :: 400
%forbidden :: 403
%nonexistent :: 404
%offline :: 504
==
+$ start-args
$: parent=(unit tid)
use=(unit tid)
=beak
file=term
=vase
==
+$ inline-args
$: parent=(unit tid)
use=(unit tid)
=beak
=shed:khan
==
--

48
sur/verb.hoon Normal file
View File

@ -0,0 +1,48 @@
|%
+$ event
$% [%on-init ~]
[%on-load ~]
[%on-poke =mark]
[%on-watch =path]
[%on-leave =path]
[%on-agent =wire sign=term]
[%on-arvo =wire vane=term sign=term]
[%on-fail =term]
==
::
+$ event-plus
$: act=@ud
now=@da
src=@p
sap=path
=cause
effects=(list effect)
==
::
+$ cause
$% [%on-init ~]
[%on-load ~]
[%on-poke =mark mug=@ux]
[%on-watch =path]
[%on-leave =path]
[%on-agent =wire =sign]
[%on-arvo =wire vane=term sign=term]
[%on-fail =term]
==
::
+$ sign
$% [%poke-ack ack=?]
[%watch-ack ack=?]
[%kick ~]
[%fact =mark mug=@ux]
==
::
+$ effect
$% [%poke =wire =gill:gall =mark mug=@ux]
[%watch =wire =gill:gall =path]
[%leave =wire =gill:gall]
[%fact paths=(list path) =mark mug=@ux]
[%kick paths=(list path)]
[%arvo =wire vane=term task=term]
==
--

53
ted/proxy.hoon Normal file
View File

@ -0,0 +1,53 @@
/- spider
/+ strandio
=, strand=strand:spider
=, dejs-soft:format
=, strand-fail=strand-fail:libstrand:spider
^- thread:spider
|= arg=vase
=/ a !< (unit json) arg
?~ a (strand-fail:strand %no-body ~)
?. ?=(%s -.u.a) (strand-fail:strand %no-body ~)
=/ url +.u.a
=/ m (strand ,vase)
^- form:m
|^ (retry url 0)
+$ res-t (each json @t) :: for redirects
++ retry |= [url=@t count=@]
;< r=res-t bind:m (send-req url)
?- -.r
%& (pure:m !>(p.r))
%| ?: (gte count 5) (pure:m !>(`json`[%s 'error']))
(retry p.r +(count))
==
++ send-req |= url=@t
~& fetching=url
=/ m (strand ,res-t) ^- form:m
=/ headers
:~
['connection' 'keep-alive']
['Accept-language' 'en-US;en;q=0.9']
['Accept' '*/*']
['origin' 'https://www.google.com']
['referer' 'https://www.google.com/']
['DNT' '1']
['User-agent' 'facebookexternalhit/1.1']
:: ['User-agent' 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/90.0.4430.93 Safari/537.36']
==
=/ =request:http [%'GET' url headers ~]
;< ~ bind:m (send-request:strandio request)
;< res=client-response:iris bind:m take-client-response:strandio
?. ?=(%finished -.res) (strand-fail:strand %no-body ~)
=/ headers headers.response-header.res
~& > header=headers
=/ redirect (get-header:http 'location' headers)
~& >> red=redirect
?^ redirect (pure:m [%| u.redirect])
::
?~ full-file.res (strand-fail:strand %no-body ~)
~& mime=-.u.full-file.res
=/ htmls=@t q.data.u.full-file.res
=/ json [%s htmls]
(pure:m [%& json])
--

233
web/assets/style.css
View File

@ -76,6 +76,12 @@ html {
.g2 {
gap: 1rem;
}
.cp{
cursor: pointer;
}
.tc{
text-align:center;
}
/* base */
@ -87,25 +93,74 @@ html {
}
* {
body {
background-color: var(--primary);
color: var(--black);
margin: 0;
padding: 0;
min-height: 100vh;
display: flex;
flex-direction: column;
}
a {
color: inherit;
text-decoration: none;
}
/* nav */
nav {
padding: 1rem;
#topnav {
height: 63px;
& #login-div {
display: flex;
align-items: center;
text-decoration: underline;
margin-right: 2rem;
font-size: 20px;
line-height: 23px;
font-weight: 600;
}
}
#nav-main {
background-color: var(--black);
color: var(--primary);
cursor: pointer;
font-size: 25px;
line-height: 23px;
font-weight: 600;
text-align: center;
display: flex;
align-items: center;
gap: 1rem;
padding: 0 1rem;
}
#nav-links {
display: flex;
align-items: center;
font-size: 25px;
line-height: 23px;
font-weight: 600;
text-align: center;
gap: 1rem;
& a {
opacity: 0.5;
}
& .active {
opacity: 1
}
}
/* index */
main {
padding: 1rem 2rem;
flex-grow: 1;
overflow: auto;
}
#index-top {
@ -137,13 +192,181 @@ main {
}
& a {
font-size: 1.1rem;
text-decoration: none;
font-weight: 500;
}
& .preview{
max-width: 100%;
}
& .title {
font-weight: 600;
font-size: 25px;
line-height: 33px;
}
& .title-text{
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
& .out-link {
font-weight: 600;
font-size: 20px;
& .arrow {
margin-left: 0.3rem;
font-size: 1.3rem;
}
}
& .meta {
opacity: 0.5;
& .upvote-button, & .downvote-button{
}
}
}
.moar {
text-decoration: underline;
font-size: 20px;
margin-top: 1rem;
display: block;
}
.white{
background-color: var(--white);
}
/* thread page */
#thread-main{
background-color: var(--white);
& h1{
margin-top: 0.3rem;
}
& ul{
display: block;
list-style-image: none;
list-style-position: outside;
list-style-type: none;
padding: 0;
& li{
margin-bottom: 1rem;
}
}
& .nested{
padding-left: 2rem !important;
}
& .comment{
& img{
max-width: 60%;
display: block;
margin: 1rem auto;
}
& .comment-proper{
margin-top: 0.5rem;
}
& .content{
font-weight: 600;
margin: 1rem 0;
& p{
margin: 0.2rem 0;
}
}
}
}
.red{
color: red;
}
.green {
color: green;
}
.tally{
font-weight: 600;
}
.uln{
text-decoration: underline;
cursor: pointer;
}
.return-link{
display: block;
margin-bottom: 2rem;
}
#og{
border: 1px solid var(--black);
border-radius: 0.5rem;
& img{
width: 100%;
max-height: 500px;
}
}
#link-url{
padding: 0.5rem 1rem;
}
#thread-composer{
& input{
display: block;
height: 2rem;
width: 100%;
margin: 1rem 0;
}
}
#comment-composer{
margin-top: 3rem;
margin-bottom: 1rem;
padding: 0.5rem 1rem;
border: 1px solid var(--black);
border-radius: 0.5rem;
}
#composer-proper{
margin: 1rem;
padding: 1rem;
& textarea{
width: 100%;
height: 200px;
margin-bottom: 0.5rem;
resize: none;
}
}
#login-page{
& form{
display: block;
width: 50%;
margin: 2rem auto;
& input{
display: block;
width: 30ch;
padding: 0.4rem;
height: 2rem;
margin: 2rem auto;
}
& button{
display: block;
margin: auto;
font-size: 1.2rem;
}
}
}
#sigil-img{
margin: 1rem auto !important;
}
#user-page{
& *{
margin: auto;
}
& #main{
width: 50%;
}
}
#logout{
display: block;
margin: 2rem auto;
font-size: 1.2rem;
}
button, .button{
border: 1px solid var(--black);
background: none;
padding: 0.5rem;
width: max-content;
}

106
web/components/components.hoon Normal file
View File

@ -0,0 +1,106 @@
/- sur=forum, tp=post
/+ lib=forum, sr=sortug
|%
++ votes |= v=votes:tp
=/ old (old:si tally.v)
=/ arrow ?: -.old
"↑"
"↓"
:: =/ img ?: -.old
:: ;img@"/up.svg";
:: ;img@"/down.svg"(cnn.org) ;
;div.f.g1
;div.arrow:"{arrow}"
;div:"{(scow %ud +.old)}"
==
++ tally |= v=votes:tp
=/ old (old:si tally.v)
=/ classn ?: -.old "tally green" "tally red"
;div(class classn):"{(scow %ud +.old)}"
++ upvote ^- manx
;div.upvote-button.cp:"↑"
++ downvote
;div.downvote-button.cp:"↓"
++ thread-metadata
|= [=pid:tp now=@da v=votes:tp reply-count=@ud]
=/ post-link (scow:sr %uw (jam pid))
=/ ago (post-date-ago:lib id.pid now %yau)
=/ author (scow %p ship.pid)
=/ comments ?: .=(0 reply-count) ~
;+ ;div:"{(scow %ud reply-count)} comments"
;div.meta.f.g2
=pid post-link
;+ (votes v)
;div:"{author}"
;a/"/forum/com/{post-link}":"{ago} ago"
;* comments
==
++ post-metadata
|= [=pid:tp now=@da v=votes:tp reply-count=@ud is-ted=?]
=/ teds ?: is-ted "yeah" "nope"
=/ post-link (scow:sr %uw (jam pid))
=/ ago (post-date-ago:lib id.pid now %yau)
=/ author (scow %p ship.pid)
=/ comments ?: .=(0 reply-count) ~
;+ ;div:"{(scow %ud reply-count)} comments"
;div.meta.f.g2
=pid post-link
=ted teds
;+ upvote
;+ (tally v)
;+ downvote
;div:"{author}"
;a/"/forum/com/{post-link}":"{ago} ago"
;* comments
==
++ reply-header
|= [t=thread:sur =comment:tp now=@da]
=/ cpid [author.comment id.comment]
=/ ago (post-date-ago:lib id.comment now %yau)
=/ author (scow %p author.comment)
=/ thread-link (scow:sr %uw (jam pid.t))
=/ parent-link (scow:sr %uw (jam parent.comment))
=/ titlet (trip title.t)
;div.meta.f.g2
;+ (votes votes.comment)
;div:"{author}"
;div:"{ago} ago"
; |
;a/"/forum/com/{parent-link}":"parent"
; |
;a/"/forum/ted/{thread-link}":"Thread: {titlet}"
==
++ reply-composer |= [pids=tape top=?]
=/ action ?: top "/forum/comment" "/forum/reply"
;form#reply-form(action action, method "POST")
;input#thread-id(type "hidden", name "parent", value pids);
;textarea#textarea(name "text");
;button:"Submit"
;script:"{script}"
==
++ script ^~ %- trip
'''
function autoSave(){
const form = document.getElementById("reply-form");
const hiddenInput = document.getElementById("thread-id");
const draftID = hiddenInput.value;
console.log(draftID, "id")
const area = document.getElementById("textarea");
window.addEventListener("load", () => {
const savedContent = localStorage.getItem(draftID);
console.log(savedContent, "saved")
if (savedContent) area.value = savedContent;
})
form.addEventListener("submit", () => {
localStorage.removeItem(draftID);
})
area.addEventListener("input", () => {
console.log("saving", area.value)
localStorage.setItem(draftID, area.value);
})
}
autoSave();
'''
--

37
web/components/navbar.hoon
View File

@ -1,28 +1,47 @@
/+ sig=sigil-sigil
|_ =bowl:gall
++ login
++ login ^- manx
?- (clan:title src.bowl)
%czar sigil
%king sigil
%duke sigil
%earl sigil
%pawn ;a/"/~/login":"Log In"
%pawn login-prompt
==
++ login-prompt ^- manx
;a/"/forum/log":"Log In"
++ sigil
:: ;+ (sig(size 48) src.bowl)
=/ (scow %p src.bowl)
;a/"/":"{p}"
=/ p (scow %p src.bowl)
;div.f.g2
;a/"/forum/add":"new post"
;a/"/forum/usr/{p}":"{p}"
==
++ $
;nav.fs.g2
;div.fg2
;nav#topnav.fs.g2
;div.f.g2
;div#nav-main.fs
;a/"/":"~ Technical Journal"
;div#nav-dropdown:"↓"
==
;div#nav-links
;a:/"/information":"Information"
;a:/"/Forum":"Forum"
;a/"/information":"Information"
;a.active/"/forum":"Forum"
==
==
;+ login
;div#login-div
;+ login-prompt
==
;script:"{script}"
==
++ script ^~ %- trip
'''
async function setSigil(){
const div = document.getElementById("login-div");
const res = await fetch("/forum/f/sigil");
const t = await res.text();
if (t) div.innerHTML = t;
}
setSigil();
'''
--

125
web/components/post-text.hoon Normal file
View File

@ -0,0 +1,125 @@
/- tp=post
/+ sr=sortug
|%
++ content
|= c=content-list:tp ^- marl
(turn c block)
++ block
|= b=block:tp ^- manx
?+ -.b ;p;
%paragraph (pg +.b)
%blockquote (bq +.b)
%heading (heading +.b)
%list (htmlist +.b)
%media (media +.b)
%codeblock (codeblock +.b)
%eval (eval +.b)
==
++ eval
|= txt=@t ^- manx
:: Ream can crash if the cord is wrong
:: soften instead
=/ uhoon (rush txt vest)
?~ uhoon ;p:"The hoon you tried to run ({(trip txt)}) is invalid."
=/ run %- mule |.
%+ slap !>(..zuse) u.uhoon
?: ?=(%.n -.run) :: if virtualization fails get a (list tank)
;p
;span:"Evaluation of {(trip txt)} failed:"
;br;
;* %+ turn p.run |= t=tank ;span:"{~(ram re t)}"
==
;p:"{(text p.run)}"
++ pg
|= l=(list inline:tp) ^- manx
;p
;* %+ turn l inline
==
++ bq
|= l=(list inline:tp) ^- manx
;blockquote
;* %+ turn l inline
==
++ htmlist
|= [l=(list content-list:tp) ordered=?]
?: ordered
;ol
;* %+ turn l li
==
;ul
;* %+ turn l li
==
++ li
|= l=content-list:tp ^- manx
;li
;* (turn l block)
==
++ media
|= m=media:tp ^- manx
?- -.m
%video ;video@"{(trip p.m)}";
%audio ;audio@"{(trip p.m)}";
%images ;div.images
;* %+ turn p.m
|= [url=@t caption=@t] ;img@"{(trip url)}"(alt (trip caption));
==
==
++ codeblock
|= [code=@t lang=@t] :: TODO lang suff
;pre
;code:"{(trip code)}"
==
++ heading
|= [pp=@t q=@] ^- manx
=/ p (trip pp)
?: .=(1 q) ;h1:"{p}"
?: .=(2 q) ;h2:"{p}"
?: .=(3 q) ;h3:"{p}"
?: .=(4 q) ;h4:"{p}"
?: .=(5 q) ;h5:"{p}"
?: .=(6 q) ;h6:"{p}"
;p:""
++ inline
|= l=inline:tp ^- manx
?+ -.l ;span;
%text (parse-text p.l)
%italic ;i:"{(trip p.l)}"
%bold ;strong:"{(trip p.l)}"
:: %strike ;del:"{(trip p.l)}"
%ship ;span.ship:"{(trip (scot %p p.l))}"
%codespan ;code:"{(trip p.l)}"
%break ;br;
%img ;a/"{(trip src.l)}"
;img@"{(trip src.l)}"(alt (trip alt.l));
==
%link ?. (is-image:parsing:sr href.l)
;a/"{(trip href.l)}"(target "_blank"):"{(trip show.l)}"
;a/"{(trip href.l)}"
=target "_blank"
;img@"{(trip href.l)}"(alt (trip show.l));
==
==
++ parse-text
|= txt=@t ^- manx
=/ tpe (trip txt)
=/ youtube (rush txt youtube:parsing:sr)
?^ youtube
:: ;a/"{tpe}"
:: ;img@"https://i.ytimg.com/vi/{u.youtube}/hqdefault.jpg";
:: ==
;iframe.youtube-frame@"https://www.youtube.com/embed/{u.youtube}";
=/ twatter-status (rush txt twatter:parsing:sr)
?^ twatter-status
;div :: goddamn twatter embeds insert themselves as last child
;a.parsed-twatter(status u.twatter-status):"{tpe}"
==
=/ trimmed (rush txt trim:parsing:sr)
?~ trimmed ~& parsing-error=txt ;span.parsing-error;
=/ link=(unit purl:eyre) (rust u.trimmed link:parsing:sr)
?^ link
?^ p.q.u.link
?: (is-img:parsing:sr u.p.q.u.link) ;img@"{u.trimmed}";
;a.parsed-link/"{tpe}"(target "_blank"):"{tpe}" :: normal link
;a.parsed-link/"{tpe}"(target "_blank"):"{tpe}" :: normal link
;span:"{tpe}"
--

16
web/components/tally.hoon Normal file
View File

@ -0,0 +1,16 @@
/- tp=post
=< votes
|%
++ votes |= v=votes:tp
=/ old (old:si tally.v)
=/ arrow ?: -.old
"↑"
"↓"
:: =/ img ?: -.old
:: ;img@"/up.svg";
:: ;img@"/down.svg"(cnn.org) ;
;div.f.g1
;div.arrow:"{arrow}"
;div:"{(scow %ud +.old)}"
==
--

22
web/pages/add-comment.hoon Normal file
View File

@ -0,0 +1,22 @@
/- sur=forum, tp=post
/+ sr=sortug
/= comps /web/components/components
/= pt /web/components/post-text
|_ [ted=thread:sur com=comment:tp =bowl:gall]
++ $
=/ ppid [author.com id.com]
=/ pids (scow:sr %uw (jam ppid))
;main#thread-main
;div#parent
;+ (reply-header:comps ted com now.bowl)
;div.post-text
;* (content:pt contents.com)
==
;div#composer
;div#composer-proper
;+ (reply-composer:comps pids .n)
==
==
==
==
--

43
web/pages/add-thread.hoon Normal file
View File

@ -0,0 +1,43 @@
/- sur=forum, tp=post
/+ sr=sortug
/= comps /web/components/components
/= pt /web/components/post-text
|_ =bowl:gall
++ $
;main#thread-main
;h1.tc:"New Thread"
;div#thread-composer
;div#composer-proper
;form#form(action "new-thread", method "POST")
;input#thread-title(type "text", name "title", placeholder "title");
;input#thread-url(type "text", name "url", placeholder "url");
;textarea#textarea(name "text");
;button:"Submit"
;script:"{script}"
==
==
==
==
++ script ^~ %- trip
'''
function autoSave(){
const form = document.getElementById("form");
const draftID = "new-thread";
const area = document.getElementById("textarea");
window.addEventListener("load", () => {
const savedContent = localStorage.getItem(draftID);
console.log(savedContent, "saved")
if (savedContent) area.value = savedContent;
})
form.addEventListener("submit", () => {
localStorage.removeItem(draftID);
})
area.addEventListener("input", () => {
console.log("saving", area.value)
localStorage.setItem(draftID, area.value);
})
}
autoSave();
'''
--

114
web/pages/comment.hoon Normal file
View File

@ -0,0 +1,114 @@
/- sur=forum, tp=post
/+ lib=forum, sr=sortug
/= comps /web/components/components
/= pt /web/components/post-text
|_ [ted=thread:sur op=full-node:tp =bowl:gall]
++ comments
;div#comments
;+ (grandchildren op 0)
==
++ mini-thread
=| nested=@ud
|= fn=full-node:tp ^- manx
;li.comment
;+ (comment p.fn)
;+ (grandchildren fn +(nested))
==
++ grandchildren |= [fn=full-node:tp nested=@ud]
=/ pid [author.p.fn id.p.fn]
?~ children.fn ;span;
?: (gth nested 5) (show-more pid)
=/ children (tap:form:tp children.fn)
=/ mtf mini-thread
;ul.comment-thread.nested
;* %+ turn children |= [p=pid:tp fnc=full-node:tp]
(mtf(nested nested) fnc)
==
++ show-more |= =pid:tp
=/ pids (scow:sr %uw (jam pid))
;div.show-more-button.uln
=pid pids
; Show more
==
++ comment |= c=comment:tp
=/ pid [author.c id.c]
=/ pids (scow:sr %uw (jam pid))
;div.comment-proper
;+ (post-metadata:comps pid now.bowl votes.c ~(wyt in children.c) .n)
;div.content
;* (content:pt contents.c)
==
;a.uln/"/forum/rep/{pids}":"reply"
==
++ $
=/ ppid [author.p.op id.p.op]
=/ pids (scow:sr %uw (jam ppid))
;main#thread-main
;+ (reply-header:comps ted p.op now.bowl)
;div#thread-body
;* (content:pt contents.p.op)
==
;div#comment-composer
;div#comment-prompt.cp:"add a comment"
;div#composer-proper(hidden "")
;+ (reply-composer:comps pids .y)
==
==
;+ comments
;script:"{reply-script}"
==
++ reply-script ^~ %- trip
'''
function replyToggle(){
const el = document.getElementById("comment-prompt");
if (!el) return
const form = document.getElementById("composer-proper");
if (!form) return
el.addEventListener("click", (e) => {
form.hidden = !form.hidden;
});
}
replyToggle();
'''
++ og-script ^~ %- trip
'''
async function run(){
const urlEl = document.getElementById("og");
const url = urlEl.getAttribute("url");
if (!url) return
const res = await fetch(url);
const text = await res.text();
getMeta(url, text);
}
function getMeta(url, s){
const parser = new DOMParser();
const doc = parser.parseFromString(s, "text/html");
const metaTags = doc.querySelectorAll("meta");
for (let tag of metaTags){
const name = tag.getAttribute("name");
const prop = tag.getAttribute("property");
const cont = tag.getAttribute("content");
if (name && name.includes("image")){
setImage(url, cont);
break;
}
}
}
function setImage(base, path){
console.log([base, path], "bp")
const url = path.includes("http") ? path : (base + path);
console.log("setting image", url);
const el = document.getElementById("link-image");
console.log(el, "el");
el.src = url;
}
run();
'''
--

44
web/pages/index.hoon
View File

@ -1,6 +1,7 @@
/- sur=forum, tp=post
/+ lib=forum, sr=sortug
|_ [thp=thread-page:sur =bowl:gall]
/+ lib=forum, sr=sortug, cons=constants
/= comps /web/components/components
|_ [thp=thread-page:sur =state:sur =bowl:gall]
++ $ ^- manx
;main
;div#index-top.f.g1
@ -14,7 +15,10 @@
==
++ thread-list ^- marl
=/ tl threads.thp
=/ i 1
=/ page -.thp
~& page=page
=/ init (mul (dec -.thp) page-size:cons)
=/ i +(init)
=| res=marl
|- ?~ tl (flop res)
=/ ted (thread i i.tl)
@ -25,38 +29,20 @@
=/ thread-link (scow:sr %uw (jam pid.t))
=/ titlet (trip title.t)
=/ numt (scow %ud num)
=/ descendants (total-comments:lib t state)
=/ link ?. ?=(%link -.content.t) ~
;+ (link-div +.content.t)
=/ ago (post-date-ago:lib id.pid.t now.bowl %yau)
=/ author (scow %p ship.pid.t)
=/ comments ?~ replies.t ~
;+ ;div:"{(scow %ud (lent replies.t))} comments"
;div.thread-preview.f.g2
;div.num:"{numt}."
;div.preview
;div.title.f.g1
;a/"/forum/ted/{thread-link}":"{titlet}"
;a.title-text/"/forum/ted/{thread-link}":"{titlet}"
;* link
==
;div.meta.f.g2
;+ (votes votes.t)
;div:"{author}"
;div:"{ago} ago"
;* comments
==
;+ (thread-metadata:comps pid.t now.bowl votes.t descendants)
==
==
++ votes |= v=votes:tp
=/ old (old:si tally.v)
=/ img ?: -.old
;img@"/up.svg";
;img@"/down.svg";
;div.f.g0
;+ img
;div:"{(scow %ud +.old)}"
==
++ link-div |= l=@t
=/ url (de-purl:html l)
=/ dom ""
@ -72,11 +58,13 @@
?: .=(~ dom) "{el}" "{dom}.{el}"
$(parts t.parts)
;div.out-link
;a/"{(trip l)}":"({domain})"
;img@"/imgs/outlink.svg";
;a.out-link/"{(trip l)}"(target "_blank")
;span:"({domain})"
;span.arrow:"↗"
==
++ moar
=/ len (lent threads.thp)
?: (lth len page-size:cons) ;span;
=/ page-num (add 1 page.thp)
;a/"/forum/p/{(scow %ud page-num)}":"More"
;a.moar/"/forum/p/{(scow %ud page-num)}":"More"
--

21
web/pages/login.hoon Normal file
View File

@ -0,0 +1,21 @@
=< html
|%
++ html
=/ redirect-str "/forum"
;main#login-page.white
;h1.tc:"Login"
;form#form(action "/~/login", method "POST")
;p.tc: Urbit ID
;input.mono(type "text")
=name "name"
=id "name"
=placeholder "~sampel-palnet"
=required "true"
=minlength "4"
=maxlength "14"
=pattern "~((([a-z]\{6})\{1,2}-\{0,2})+|[a-z]\{3})";
;input(type "hidden", name "redirect", value redirect-str);
;button(name "eauth", type "submit"):"Login"
==
==
--

194
web/pages/thread.hoon
View File

@ -1,5 +1,193 @@
/- sur=forum
|_ [ted=thread:sur =bowl:gall]
/- sur=forum, tp=post
/+ lib=forum, sr=sortug
/= comps /web/components/components
/= pt /web/components/post-text
|_ [ted=thread:sur comment-list=(list full-node:tp) =bowl:gall]
++ body
?: ?=(%link -.content.ted)
;+ link-body
(content:pt +.content.ted)
++ link-body
?> ?=(%link -.content.ted)
=/ url (trip +.content.ted)
;a/"{url}"
;div#og
=url url
;img#link-image;
;div#link-url:"{url}"
;script:"{og-script}"
==
==
++ comments
;div#comments
;ul.comment-thread
;* %+ turn comment-list mini-thread
==
==
++ mini-thread
=| nested=@ud
|= fn=full-node:tp ^- manx
;li.comment
;+ (comment p.fn)
;+ (grandchildren fn +(nested))
==
++ grandchildren |= [fn=full-node:tp nested=@ud]
=/ pid [author.p.fn id.p.fn]
?~ children.fn ;span;
?: (gth nested 5) (show-more pid)
=/ children (tap:form:tp children.fn)
=/ mtf mini-thread
;ul.comment-thread.nested
;* %+ turn children |= [p=pid:tp fnc=full-node:tp]
(mtf(nested nested) fnc)
==
++ show-more |= =pid:tp
=/ pids (scow:sr %uw (jam pid))
;div.show-more-button.uln
=pid pids
; Show more
==
++ comment |= c=comment:tp
=/ pid [author.c id.c]
=/ pids (scow:sr %uw (jam pid))
;div.comment-proper
;+ (post-metadata:comps pid now.bowl votes.c ~(wyt in children.c) .n)
;div.content
;* (content:pt contents.c)
==
;a.uln/"/forum/rep/{pids}":"reply"
==
++ $
;div:"lmao"
=/ op (scow %p ship.pid.ted)
=/ op-ago (post-date-ago:lib id.pid.ted now.bowl %yau)
=/ pids (scow:sr %uw (jam pid.ted))
;main#thread-main
;a.return-link/"/forum":"Return to forum"
;+ (post-metadata:comps pid.ted now.bowl votes.ted (lent replies.ted) .y)
;h1#thread-title:"{(trip title.ted)}"
;div#thread-body
;* body
==
;div#comment-composer
;div#comment-prompt.cp:"add a comment"
;div#composer-proper(hidden "")
;+ (reply-composer:comps pids .y)
==
==
;+ comments
;script:"{reply-script}"
==
++ reply-script ^~ %- trip
'''
function replyToggle(){
const el = document.getElementById("comment-prompt");
if (!el) return
const form = document.getElementById("composer-proper");
if (!form) return
el.addEventListener("click", (e) => {
form.hidden = !form.hidden;
});
}
replyToggle();
async function voting(){
const upbs = document.querySelectorAll(".upvote-button");
const downbs = document.querySelectorAll(".downvote-button");
for (let upb of upbs){
const parent = upb.closest(".meta");
if (!parent) continue;
const pid = parent.getAttribute("pid");
const teds = parent.getAttribute("ted");
const postType = (teds && teds === "yeah") ? "ted" : "com"
if (!pid) continue;
upb.addEventListener("click", async () => {
const res = await fetch(`/forum/vote/${postType}/${pid}/gud`, {method: "POST"});
console.log(res, "res");
const t = await res.text();
console.log(t, "t")
})
}
for (let db of downbs){
const parent = db.closest(".meta");
if (!parent) continue;
const pid = parent.getAttribute("pid");
if (!pid) continue;
const teds = parent.getAttribute("ted");
const postType = (teds && teds === "yeah") ? "ted" : "com"
db.addEventListener("click", async () => {
const res = await fetch(`/forum/vote/${postType}/${pid}/bad`, {method: "POST"});
console.log(res, "res");
const t = await res.text();
console.log(t, "t")
})
}
}
voting();
'''
++ og-script ^~ %- trip
'''
async function run(){
const urlEl = document.getElementById("og");
const url = urlEl.getAttribute("url");
if (!url) return
try{
const res = await fetch(url);
const text = await res.text();
getMeta(url, text);
} catch(e){
callThread(url);
}
}
async function callThread(url){
console.log(url, "calling thread")
try{
const opts = {
credentials: 'include',
accept: '*',
method: "POST",
body: JSON.stringify(url),
headers: {
'Content-type': "application/json"
}
};
const res = await fetch("/kumo/ustj/json/proxy/json", opts);
const text = await res.json();
getMeta(url, text);
} catch(e){
console.log(e, "wtf")
}
}
function getMeta(url, s){
const parser = new DOMParser();
const doc = parser.parseFromString(s, "text/html");
console.log(doc, "document")
const metaTags = doc.querySelectorAll("meta");
for (let tag of metaTags){
const name = tag.getAttribute("name");
const prop = tag.getAttribute("property");
const cont = tag.getAttribute("content");
const isImage = (name && name.includes("image") || (prop && prop.includes("image")))
if (isImage){
setImage(url, cont);
break;
}
}
}
function setImage(base, path){
console.log([base, path], "bp")
const url = path.includes("http") ? path : (base + path);
console.log("setting image", url);
const el = document.getElementById("link-image");
console.log(el, "el");
el.src = url;
}
run();
'''
--

27
web/pages/user.hoon Normal file
View File

@ -0,0 +1,27 @@
/- sur=forum, tp=post
/+ sig=sigil-sigil, sr=sortug
|_ [who=@p tedf=threads:sur gf=gfeed:tp karma=@s]
++ sigil
=/ p (scow %p who)
;div#sigil
;h2.tc:"{p}"
;div#sigil-img
;+ (sig(size 128) who)
==
==
++ $
=/ karmas (scow:sr %s karma)
=/ teds (scow %ud (lent (tap:torm:sur tedf)))
=/ coms (scow %ud (lent (tap:gorm:tp gf)))
;main#user-page.white
;div#main
;+ sigil
;div#stats.tc
;div:"Karma: {karmas}"
;div:"Threads: {teds}"
;div:"Comments: {coms}"
==
;a#logout.button/"/~/logout?redirect=/forum":"Logout"
==
==
--

242
web/router.hoon
View File

@ -1,10 +1,16 @@
/- sur=forum, tp=post
/+ lib=forum, sr=sortug
/+ lib=forum, sr=sortug, rd=rudder, cons=constants
/+ server
::
/= layout /web/layout
/= navbar /web/components/navbar
/= index /web/pages/index
/= thread /web/pages/thread
/= comment-page /web/pages/comment
/= add-comment /web/pages/add-comment
/= add-thread /web/pages/add-thread
/= login-page /web/pages/login
/= user-page /web/pages/user
:: /* sw %noun /web/sw/js
:: /* manifest %noun /web/manifest/json
@ -22,68 +28,190 @@
%- manx-to-octs:server
manx-bail
++ manx-bail ^- manx ;div:"404"
++ route
|= [=order =state:sur =bowl:gall] ^- (list card:agent:gall)
=/ rl (parse-request-line:server url.request.req.order)
=. site.rl ?~ site.rl ~ t.site.rl
++ manx-payload |= =manx ^- simple-payload:http
%- html-response:gen:server
%- manx-to-octs:server manx
++ redirect |= [eyre-id=@ta path=tape]
=/ url (crip "{base-url:cons}{path}")
=/ pl (redirect:gen:server url)
(give-simple-payload:app:server eyre-id pl)
:: main
++ router
|_ [=state:sur =bowl:gall]
++ eyre
|= =order ^- (list card:agent:gall)
=/ rl (parse-request-line:server url.request.req.order)
=. site.rl ?~ site.rl ~ t.site.rl
=/ met method.request.req.order
=/ fpath=(pole knot) [met site.rl]
~& > rl=fpath
=/ bail %+ give-simple-payload:app:server id.order pbail
|^
:: if file extension assume its asset
?. ?=(~ ext.rl) (serve-assets rl)
?+ fpath bail
[%'GET' rest=*] (serve-get rl(site rest.fpath))
[%'POST' rest=*] (serve-post rl(site rest.fpath))
==
=/ met method.request.req.order
=/ fpath=(pole knot) [met site.rl]
|^
:: if file extension assume its asset
?. ?=(~ ext.rl) (eyre-give (serve-assets rl))
?+ fpath bail
[%'GET' rest=*] (eyre-manx (serve-get rl(site rest.fpath)))
[%'POST' rest=*] (serve-post id.order rl(site rest.fpath) body.request.req.order)
==
::
++ bail (eyre-give pbail)
++ eyre-give |= pl=simple-payload:http ^- (list card:agent:gall)
(give-simple-payload:app:server id.order pl)
++ eyre-manx |= =manx
=/ pl %- html-response:gen:server %- manx-to-octs:server manx
(eyre-give pl)
--
::
++ serve-assets
|= rl=request-line:server
~& >> assets=rl
=/ pl
?+ [site ext]:rl pbail
[[%style ~] [~ %css]] (css-response:gen:server (as-octs:mimes:html css))
:: [[%spinner ~] [~ %svg]] [%full (serve-other:kaji %svg spinner)]
:: [[%sw ~] [~ %js]] [%mime /text/javascript sw]
:: [[%manifest ~] [~ %json]] [%mime /application/json manifest]
==
(give-simple-payload:app:server id.order pl)
++ render
|= url=@t ^- simple-payload:http
=/ rl (parse-request-line:server url)
=. site.rl ?~ site.rl ~ t.site.rl
=/ =(pole knot) [%'GET' site.rl]
?. ?=(~ ext.rl) (serve-assets rl)
++ serve-get
|= rl=request-line:server
=/ pl %- html-response:gen:server %- manx-to-octs:server
^- manx
=/ p=(pole knot) site.rl ::?. mob.rl pat.rl [%m pat.rl]
?: ?=([%f rest=*] p) (fragment rest.p)
%- layout ^- marl :_ ~
?+ p manx-bail
~ (serve-index '1')
[%p p=@t ~] (serve-index p.p)
[%ted ted=@t ~] (serve-thread ted.p)
%- manx-payload ^- manx
?+ pole manx-bail
[%'GET' rest=*] (serve-get rl(site rest.pole))
:: [%'POST' rest=*] (serve-post rl(site rest.pole))
==
(give-simple-payload:app:server id.order pl)
++ serve-index |= t=@t ^- manx
=/ pag (slaw %ud t) ?~ pag manx-bail
=/ threads (get-thread-page:lib u.pag state)
(index [u.pag threads] bowl)
++ serve-thread |= uidt=@t ^- manx
=/ uid (slaw:sr %uw uidt) ?~ uid manx-bail
=/ cued (cue u.uid)
=/ pid %- (soft pid:tp) cued
?~ pid manx-bail
=/ ted (get-thread:lib u.pid state)
?~ ted manx-bail
(thread u.ted bowl)
++ serve-assets
|= rl=request-line:server
:: ~& >> assets=rl
?+ [site ext]:rl pbail
[[%style ~] [~ %css]] (css-response:gen:server (as-octs:mimes:html css))
:: [[%spinner ~] [~ %svg]] [%full (serve-other:kaji %svg spinner)]
:: [[%sw ~] [~ %js]] [%mime /text/javascript sw]
:: [[%manifest ~] [~ %json]] [%mime /application/json manifest]
==
++ fragment
|= p=(pole knot)
?+ p manx-bail
~ manx-bail
++ serve-get
|= rl=request-line:server ^- manx
=/ p=(pole knot) site.rl ::?. mob.rl pat.rl [%m pat.rl]
?: ?=([%f rest=*] p) (serve-fragment rest.p)
%- add-layout
?+ p manx-bail
~ (serve-index '1')
[~ ~] (serve-index '1')
[%p p=@t ~] (serve-index p.p)
[%ted ted=@t ~] (serve-thread ted.p)
[%com uid=@t ~] (serve-comment uid.p)
[%rep uid=@t ~] (reply-page uid.p)
[%usr p=@t ~] (serve-user p.p)
[%add ~] (add-thread bowl)
[%log ~] login-page
==
++ add-layout |= m=manx
%- layout :~
(navbar bowl)
m
==
++ serve-fragment |= =(pole knot) ^- manx
?+ pole !!
[%sigil ~]
=/ navb ~(. navbar bowl)
=/ userdiv login:navb
userdiv
==
++ serve-user |= t=@t ^- manx
=/ patp (slaw %p t) ?~ patp manx-bail
=/ teds (get-user-teds:lib u.patp state)
=/ coms (get-user-coms:lib u.patp state)
=/ karma (get-user-karma:lib u.patp state)
(user-page u.patp teds coms karma)
++ serve-index |= t=@t ^- manx
=/ pag (slaw %ud t) ?~ pag manx-bail
=/ threads (get-thread-page:lib u.pag state)
(index [u.pag threads] state bowl)
++ serve-comment |= uidt=@t ^- manx
=/ uid (slaw:sr %uw uidt) ?~ uid manx-bail
=/ cued (cue u.uid)
=/ pid %- (soft pid:tp) cued
?~ pid manx-bail
=/ com (get-comment:lib u.pid state)
?~ com manx-bail
=/ ted (get-thread:lib thread.u.com state)
?~ ted manx-bail
=/ fn (node-to-full:lib u.com comments.state)
(comment-page u.ted fn bowl)
++ reply-page |= uidt=@t ^- manx
=/ uid (slaw:sr %uw uidt) ?~ uid manx-bail
=/ cued (cue u.uid)
=/ pid %- (soft pid:tp) cued
?~ pid manx-bail
=/ com (get-comment:lib u.pid state)
?~ com manx-bail
=/ ted (get-thread:lib thread.u.com state)
?~ ted manx-bail
(add-comment u.ted u.com bowl)
++ serve-thread |= uidt=@t ^- manx
=/ uid (slaw:sr %uw uidt) ?~ uid manx-bail
=/ cued (cue u.uid)
=/ pid %- (soft pid:tp) cued
?~ pid manx-bail
=/ ted (get-thread:lib u.pid state)
?~ ted manx-bail
=/ fg (get-comment-list:lib u.ted comments.state)
(thread u.ted fg bowl)
++ serve-post
|= [eyre-id=@ta rl=request-line:server body=(unit octs)]
|^
=/ p=(pole knot) site.rl
?+ p ~
[%reply ~] (handle-reply .n)
[%comment ~] (handle-reply .y)
[%new-thread ~] handle-thread
[%vote %ted uid=@t vote=@t ~] (handle-vote .y uid.p vote.p)
[%vote %com uid=@t vote=@t ~] (handle-vote .n uid.p vote.p)
==
++ handle-vote |= [is-ted=? uidt=@t vote=@t]
=/ vot=? .=(vote 'gud')
=/ uid (slaw:sr %uw uidt) ?~ uid ~
=/ cued (cue u.uid)
=/ pid %- (soft pid:tp) cued
?~ pid ~
(self-poke [%ui eyre-id %vote is-ted u.pid vot])
++ serve-post
|= rl=request-line:server ~
++ handle-thread
?~ body ~
=/ bod (frisk:rd q.u.body)
~& bod=bod
=/ md (~(get by bod) 'text')
?~ md ~
=/ title (~(get by bod) 'title')
?~ title ~
=/ url (~(get by bod) 'url')
?~ url ~
(self-poke [%ui eyre-id %submit-thread u.title u.url u.md])
++ handle-reply |= top=?
?~ body ~
=/ bod (frisk:rd q.u.body)
=/ pars (~(get by bod) 'parent')
?~ pars ~
=/ uid (slaw:sr %uw u.pars)
?~ uid ~
=/ cued (cue u.uid)
=/ pid %- (soft pid:tp) cued
?~ pid ~
=/ md (~(get by bod) 'text')
?~ md ~
?: top
=/ ted (get-thread:lib u.pid state)
?~ ted ~
(self-poke [%ui eyre-id %submit-comment u.ted u.md])
::
=/ com (get-comment:lib u.pid state)
?~ com ~
(self-poke [%ui eyre-id %submit-reply u.com u.md])
--
::
++ self-poke |= noun=*
=/ =card:agent:gall
[%pass /gib %agent [our.bowl dap.bowl] %poke %noun !>(noun)]
:~ card
==
--
--