2024-06-01 08:45:45 +00:00
|
|
|
/- *forum
|
2024-06-27 04:44:31 +00:00
|
|
|
/+ dbug, sr=sortug, lib=forum, const=constants, seeds, cacher
|
2024-06-01 08:45:45 +00:00
|
|
|
/= router /web/router
|
|
|
|
|%
|
|
|
|
++ card card:agent:gall
|
|
|
|
+$ versioned-state
|
|
|
|
$% state-0
|
|
|
|
==
|
|
|
|
--
|
|
|
|
:: main agent core
|
|
|
|
%- agent:dbug
|
|
|
|
=| versioned-state
|
|
|
|
=* state -
|
|
|
|
^- agent:gall
|
|
|
|
=<
|
|
|
|
::
|
|
|
|
|_ =bowl:gall
|
|
|
|
+* this .
|
|
|
|
hd ~(. +> [state bowl])
|
2024-06-27 04:44:31 +00:00
|
|
|
rout ~(. router:router [state bowl])
|
|
|
|
cache ~(. cacher [state bowl])
|
2024-06-01 08:45:45 +00:00
|
|
|
++ on-fail |~(* `this)
|
|
|
|
++ on-leave |~(* `this)
|
|
|
|
++ on-save !>(state)
|
|
|
|
++ on-init
|
|
|
|
^- (quip card _this)
|
|
|
|
:_ this init-cards:hd
|
|
|
|
|
|
|
|
++ on-load |= old=vase
|
|
|
|
:_ this(state !<(versioned-state old)) ~
|
|
|
|
++ on-watch
|
|
|
|
|= =(pole knot)
|
|
|
|
?+ pole !!
|
|
|
|
[%http-response id=@ ~] `this
|
|
|
|
==
|
|
|
|
++ on-poke
|
|
|
|
|= [=mark =vase]
|
|
|
|
|^
|
|
|
|
?+ mark `this
|
|
|
|
%handle-http-request serve
|
|
|
|
%noun (on-poke-noun !<(* vase))
|
|
|
|
==
|
|
|
|
++ on-poke-noun
|
|
|
|
|= a=*
|
2024-06-27 04:44:31 +00:00
|
|
|
?: ?=([%ui *] a) (handle-ui a)
|
|
|
|
?: ?=([%cache *] a) (handle-cache +.a)
|
|
|
|
?: ?=(%test a) test
|
2024-06-01 08:45:45 +00:00
|
|
|
?: ?=(%print a) print
|
2024-06-27 04:44:31 +00:00
|
|
|
?: ?=(%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)
|
2024-06-01 08:45:45 +00:00
|
|
|
`this
|
|
|
|
++ print
|
|
|
|
~& > state=state
|
|
|
|
`this
|
|
|
|
++ seed
|
|
|
|
=/ rng ~(. og eny.bowl)
|
2024-06-27 04:44:31 +00:00
|
|
|
|%
|
|
|
|
++ 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)
|
2024-06-01 08:45:45 +00:00
|
|
|
$(titles t.titles)
|
2024-06-27 04:44:31 +00:00
|
|
|
:_ 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])
|
|
|
|
--
|
2024-06-01 08:45:45 +00:00
|
|
|
::
|
|
|
|
++ serve
|
|
|
|
^- (quip card _this)
|
|
|
|
~& eyre-poke=now.bowl
|
|
|
|
=/ order !<(order:router vase)
|
|
|
|
=/ address address.req.order
|
|
|
|
:: ?: (~(has in banned.admin) address) `this
|
|
|
|
:: ~& >>> malicious-request-alert=req.order `this
|
2024-06-27 04:44:31 +00:00
|
|
|
:_ this (eyre:rout order)
|
2024-06-01 08:45:45 +00:00
|
|
|
--
|
|
|
|
++ on-peek
|
|
|
|
|= =(pole knot) ~
|
|
|
|
++ on-agent
|
|
|
|
|= [=wire =sign:agent:gall] `this
|
|
|
|
++ on-arvo
|
|
|
|
|= [=(pole knot) =sign-arvo] `this
|
|
|
|
--
|
|
|
|
:: helper
|
|
|
|
|_ [s=versioned-state =bowl:gall]
|
2024-06-27 04:44:31 +00:00
|
|
|
:: ++ static-caches ^- (list card)
|
|
|
|
:: :~ (cache-card '/forum/new-thread' (render:rout '/new-thread'))
|
|
|
|
:: :: (cache-card '/forum/new-thread')
|
|
|
|
:: ==
|
2024-06-01 08:45:45 +00:00
|
|
|
++ root-path-card ^- card
|
|
|
|
[%pass /root %arvo %e %connect [~ /forum] dap.bowl]
|
|
|
|
++ init-cards ^- (list card)
|
|
|
|
:~ root-path-card
|
|
|
|
==
|
|
|
|
++ schedule-backup-card ^- card
|
|
|
|
[%pass /backup %arvo %b %wait (add now.bowl ~h6)]
|
|
|
|
--
|