mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-09-20 15:08:34 +03:00
hood: uncompiled first try at state as tuple
This commit is contained in:
Ted Blackman
parent
01eee03340
commit
ac77d0a3ec
@ -1,7 +1,5 @@
|
||||
/- *sole
|
||||
/+ sole, default-agent
|
||||
/+ default-agent
|
||||
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|
||||
::
|
||||
|%
|
||||
+$ state
|
||||
$: %7
|
||||
@ -9,39 +7,22 @@
|
||||
helm=state:helm
|
||||
kiln=state:kiln
|
||||
==
|
||||
+$ any-state
|
||||
$% state
|
||||
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
|
||||
==
|
||||
+$ any-state-tuple
|
||||
$: drum=any-state:drum
|
||||
helm=any-state:helm
|
||||
kiln=any-state:kiln
|
||||
==
|
||||
+$ fin-any-state
|
||||
$% [%drum any-state:drum]
|
||||
[%helm any-state:helm]
|
||||
[%kiln any-state:kiln]
|
||||
[%write *] :: gets deleted
|
||||
==
|
||||
--
|
||||
::
|
||||
=> |%
|
||||
+$ any-state $%(state hood-old)
|
||||
++ hood-old :: unified old-state
|
||||
{?($1 $2 $3 $4 $5 $6) lac/(map @tas hood-part-old)}
|
||||
++ hood-1 :: unified state
|
||||
{$6 lac/(map @tas hood-part)}
|
||||
++ hood-good :: extract specific
|
||||
=+ hed=$:hood-head
|
||||
|@ ++ $
|
||||
|: paw=$:hood-part
|
||||
?- hed
|
||||
$drum ?>(?=($drum -.paw) `part:hood-drum`paw)
|
||||
$helm ?>(?=($helm -.paw) `part:hood-helm`paw)
|
||||
$kiln ?>(?=($kiln -.paw) `part:hood-kiln`paw)
|
||||
$write ?>(?=($write -.paw) `part:hood-write`paw)
|
||||
==
|
||||
--
|
||||
++ hood-part-old
|
||||
$% [%drum part-old:drum]
|
||||
[%helm part-old:helm]
|
||||
[%kiln part-old:kiln]
|
||||
[%write part-old:write]
|
||||
==
|
||||
++ hood-part
|
||||
$% {$drum $2 pith-2:drum}
|
||||
{$helm $0 pith:helm}
|
||||
{$kiln $0 pith:kiln}
|
||||
{$write $0 pith:write}
|
||||
==
|
||||
--
|
||||
::
|
||||
^- agent:gall
|
||||
=| =state
|
||||
|_ =bowl:gall
|
||||
@ -52,53 +33,50 @@
|
||||
kiln-core (kiln bowl kiln.state)
|
||||
::
|
||||
++ on-fail on-fail:def
|
||||
++ on-init on-init:def
|
||||
++ on-init
|
||||
^- step:agent:gall
|
||||
=^ d drum.state on-init:drum-core
|
||||
[d this]
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
::
|
||||
++ on-save !>(state)
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= =old-state=vase
|
||||
=/ old-state !<(any-state old-state-vase)
|
||||
:: TODO rewrite
|
||||
[~ this]
|
||||
:: =^ cards lac
|
||||
:: =. lac lac.old-state
|
||||
:: ?- -.old-state
|
||||
:: %1 ((wrap on-load):from-drum:(help hid) %1)
|
||||
:: %2 ((wrap on-load):from-drum:(help hid) %2)
|
||||
:: %3 ((wrap on-load):from-drum:(help hid) %3)
|
||||
:: %4 ((wrap on-load):from-drum:(help hid) %4)
|
||||
:: %5
|
||||
:: =/ start ..$:(from-kiln)
|
||||
:: =/ old-kiln-part (~(got by lac.old-state) %kiln)
|
||||
:: ?> ?=(%kiln -.old-kiln-part)
|
||||
:: %- ably
|
||||
:: (on-load:(start hid *part:hood-kiln) old-kiln-part)
|
||||
:: ::
|
||||
:: %6 `lac
|
||||
:: ==
|
||||
:: [cards ..on-init]
|
||||
^- step:agent:gall
|
||||
=+ !<(old=any-state old-state-vase)
|
||||
=/ tup=any-state-tuple
|
||||
?+ -.old +.old
|
||||
?(%1 %2 %3 %4 %5 %6)
|
||||
:* =-(?>(?=(%drum -<) ->) (~(got by lac.old) %drum))
|
||||
=-(?>(?=(%helm -<) ->) (~(got by lac.old) %helm))
|
||||
=-(?>(?=(%kiln -<) ->) (~(got by lac.old) %kiln))
|
||||
==
|
||||
==
|
||||
=/ ver -:*state
|
||||
=^ d drum.state (on-load:drum-core ver drum.tup)
|
||||
=^ h helm.state (on-load:helm-core ver helm.tup)
|
||||
=^ k kiln.state (on-load:kiln-core ver kiln.tup)
|
||||
[(weld d h k) this]
|
||||
::
|
||||
++ on-poke
|
||||
|^
|
||||
|= [=mark =vase]
|
||||
^- step:agent:gall
|
||||
::
|
||||
|^
|
||||
=/ fin (end 3 4 mark)
|
||||
?: =(%drum fin) (poke-drum mark vase)
|
||||
?: =(%helm fin) (poke-helm mark vase)
|
||||
?: =(%kiln fin) (poke-kiln mark vase)
|
||||
?: =(%drum fin) poke-drum
|
||||
?: =(%helm fin) poke-helm
|
||||
?: =(%kiln fin) poke-kiln
|
||||
::
|
||||
?+ mark (on-poke:def mark vase)
|
||||
%atom (poke-helm %helm-atom vase)
|
||||
%dill-belt (poke-drum %drum-dill-belt vase)
|
||||
%dill-blit (poke-drum %drum-dill-blit vase)
|
||||
%hood-sync (poke-kiln %kiln-sync vase)
|
||||
%atom poke-helm(mark %helm-atom)
|
||||
%dill-belt poke-drum(mark %drum-dill-belt)
|
||||
%dill-blit poke-drum(mark %drum-dill-blit)
|
||||
%hood-sync poke-kiln(mark %kiln-sync)
|
||||
%write-sec-atom poke-helm(mark %helm-write-sec-atom)
|
||||
==
|
||||
++ poke-drum |=([mark vase] =^(c drum.state (poke:drum-core +<) [c this]))
|
||||
++ poke-helm |=([mark vase] =^(c helm.state (poke:helm-core +<) [c this]))
|
||||
++ poke-kiln |=([mark vase] =^(c kiln.state (poke:kiln-core +<) [c this]))
|
||||
++ poke-drum =^(c drum.state (poke:drum-core mark vase) [c this]))
|
||||
++ poke-helm =^(c helm.state (poke:helm-core mark vase) [c this]))
|
||||
++ poke-kiln =^(c kiln.state (poke:kiln-core mark vase) [c this]))
|
||||
--
|
||||
::
|
||||
++ on-watch
|
||||
@ -118,7 +96,7 @@
|
||||
==
|
||||
::
|
||||
++ on-arvo
|
||||
|= [=wire sign=sign-arvo]
|
||||
|= [=wire =sign-arvo]
|
||||
^- step:agent:gall
|
||||
?+ wire ~|([%hood-bad-wire wire] !!)
|
||||
[%drum *] =^(c drum.state (take-arvo:drum-core +<) [c this]))
|
||||
|
||||
@ -1,21 +1,10 @@
|
||||
:: :: ::
|
||||
:::: /hoon/drum/hood/lib :: ::
|
||||
:: :: ::
|
||||
/? 310 :: version
|
||||
/- *sole
|
||||
/+ sole
|
||||
:: :: ::
|
||||
:::: :: ::
|
||||
:: :: ::
|
||||
|% :: ::
|
||||
+$ state [%3 pith-2]
|
||||
+$ state-old ::
|
||||
$: %drum ::
|
||||
$% [%1 pith-1] ::
|
||||
[%2 pith-2] ::
|
||||
== == ::
|
||||
:: ::
|
||||
++ pith-1 :: pre-style
|
||||
/- *sole
|
||||
/+ sole
|
||||
|%
|
||||
+$ any-state $%(state [%1 pith-1])
|
||||
+$ state [%2 pith-2]
|
||||
::
|
||||
++ pith-1
|
||||
%+ cork pith-2 ::
|
||||
|:($:pith-2 +<(bin ((map bone source-1)))) ::
|
||||
:: ::
|
||||
@ -29,9 +18,7 @@
|
||||
fur/(map dude:gall (unit server)) :: servers
|
||||
bin/(map bone source) :: terminals
|
||||
== ::
|
||||
:: :: ::
|
||||
:::: :: ::
|
||||
:: :: ::
|
||||
:: ::
|
||||
++ server :: running server
|
||||
$: syd/desk :: app identity
|
||||
cas/case :: boot case
|
||||
@ -126,38 +113,28 @@
|
||||
==
|
||||
::
|
||||
++ deft-fish :: default connects
|
||||
|= our/ship
|
||||
|= our=ship
|
||||
%- ~(gas in *(set gill:gall))
|
||||
^- (list gill:gall)
|
||||
[[our %dojo] [our %chat-cli]~]
|
||||
::
|
||||
++ initial-state
|
||||
|= our/ship
|
||||
^- state
|
||||
:* %3
|
||||
eel=(deft-fish our)
|
||||
ray=~
|
||||
fur=~
|
||||
bin=~
|
||||
==
|
||||
::
|
||||
++ en-gill :: gill to wire
|
||||
|= gyl/gill:gall
|
||||
|= gyl=gill:gall
|
||||
^- wire
|
||||
[%drum %phat (scot %p p.gyl) q.gyl ~]
|
||||
::
|
||||
++ de-gill :: gill from wire
|
||||
|= way/wire ^- gill:gall
|
||||
?>(?=({@ @ ~} way) [(slav %p i.way) i.t.way])
|
||||
|= way=wire ^- gill:gall
|
||||
?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
|
||||
--
|
||||
:: TODO: remove .ost
|
||||
::
|
||||
|: [bowl=*bowl:gall state=initial-state]
|
||||
|= [hid=bowl:gall state]
|
||||
=/ ost 0
|
||||
=+ (~(gut by bin) ost *source)
|
||||
=* dev -
|
||||
|_ {moz/(list card:agent:gall) biz/(list dill-blit:dill)}
|
||||
+* this .
|
||||
++ on-init se-abet:se-view:this(eel (deft-fish our.hid))
|
||||
++ diff-sole-effect-phat :: app event
|
||||
|= {way/wire fec/sole-effect}
|
||||
=< se-abet =< se-view
|
||||
@ -194,7 +171,7 @@
|
||||
++ poke-start :: start app
|
||||
|= wel/well:gall
|
||||
=< se-abet =< se-view
|
||||
(se-born wel)
|
||||
(se-born & wel)
|
||||
::
|
||||
++ poke-link :: connect app
|
||||
|= gyl/gill:gall
|
||||
@ -228,25 +205,21 @@
|
||||
==
|
||||
::
|
||||
++ on-load
|
||||
|= ver=?(%1 %2 %3 %4)
|
||||
|= [hood-version=?(%7) old=any-state]
|
||||
=< se-abet =< se-view
|
||||
=? . (lte ver %3)
|
||||
=. ver %4
|
||||
=. ..on-load
|
||||
=< (se-emit %pass /kiln %arvo %g %sear ~wisrut-nocsub)
|
||||
=< (se-born %home %goad)
|
||||
=< (se-born %home %metadata-store)
|
||||
=< (se-born %home %metadata-hook)
|
||||
=< (se-born %home %contact-store)
|
||||
=< (se-born %home %contact-hook)
|
||||
=< (se-born %home %contact-view)
|
||||
=< (se-born %home %link-store)
|
||||
=< (se-born %home %link-proxy-hook)
|
||||
=< (se-born %home %link-listen-hook)
|
||||
=< (se-born %home %link-view)
|
||||
(se-born %home %s3-store)
|
||||
.
|
||||
?> ?=(%4 ver)
|
||||
=. ..on-load
|
||||
=< (se-born | %home %goad)
|
||||
=< (se-born | %home %metadata-store)
|
||||
=< (se-born | %home %metadata-hook)
|
||||
=< (se-born | %home %contact-store)
|
||||
=< (se-born | %home %contact-hook)
|
||||
=< (se-born | %home %contact-view)
|
||||
=< (se-born | %home %link-store)
|
||||
=< (se-born | %home %link-proxy-hook)
|
||||
=< (se-born | %home %link-listen-hook)
|
||||
=< (se-born | %home %link-view)
|
||||
(se-born | %home %s3-store)
|
||||
::
|
||||
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
|
||||
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
|
||||
::
|
||||
@ -466,9 +439,10 @@
|
||||
ta-abet:(ta-belt:(se-tame u.gul) bet)
|
||||
::
|
||||
++ se-born :: new server
|
||||
|= wel/well:gall
|
||||
|= [print-on-repeat=? wel=well:gall]
|
||||
^+ +>
|
||||
?: (~(has in ray) wel)
|
||||
?. print-on-repeat +>
|
||||
(se-text "[already running {<p.wel>}/{<q.wel>}]")
|
||||
%= +>
|
||||
ray (~(put in ray) wel)
|
||||
|
||||
@ -1,16 +1,23 @@
|
||||
/- sole
|
||||
/+ pill
|
||||
/+ pill
|
||||
=* card card:agent:gall
|
||||
::
|
||||
|%
|
||||
+$ any-state $%(state state-old)
|
||||
+$ state
|
||||
$: %3
|
||||
say/sole-share:sole :: console state
|
||||
mud/(unit (sole-dialog:sole @ud)) :: console dialog
|
||||
mass-timer/{way/wire nex/@da tim/@dr}
|
||||
$: %1
|
||||
mass-timer=[way=wire nex=@da tim=@dr]
|
||||
==
|
||||
+$ state-old
|
||||
$% %0
|
||||
say=*
|
||||
mud=*
|
||||
mass-timer=[way=wire nex=@da tim=@dr]
|
||||
==
|
||||
--
|
||||
::
|
||||
++ state-0-to-1
|
||||
|= s=state-0
|
||||
^- state
|
||||
[%1 mass-timer.s]
|
||||
--
|
||||
|= [=bowl:gall =state]
|
||||
=| moz=(list card)
|
||||
|%
|
||||
@ -25,6 +32,13 @@
|
||||
^+ this
|
||||
?~(caz this $(caz t.caz, this (emit i.caz)))
|
||||
::
|
||||
++ on-load
|
||||
|= [hood-version=?(%7) old=any-state]
|
||||
=< abet
|
||||
=? old ?=(%0 -.old) (state-0-to-1 old)
|
||||
?> ?=(%1 -.old)
|
||||
this(state old)
|
||||
::
|
||||
++ poke-rekey :: rotate private keys
|
||||
|= des=@t
|
||||
=/ sed=(unit seed:able:jael)
|
||||
@ -40,6 +54,22 @@
|
||||
this
|
||||
(emit %pass / %arvo %j %rekey lyf.u.sed key.u.sed)
|
||||
::
|
||||
++ ames-secret
|
||||
^- @t
|
||||
=; pax (crip +:<.^(@p %j pax)>)
|
||||
/(scot %p our.bowl)/code/(scot %da now.bowl)/(scot %p our.bowl)
|
||||
::
|
||||
++ poke-sec-atom
|
||||
|= [hot=host:eyre dat=@]
|
||||
?> ?=(%& -.hot)
|
||||
=. p.hot (scag 2 p.hot) :: ignore subdomain
|
||||
=. dat (scot %uw (en:crub:crypto ames-secret dat))
|
||||
=- abet:(emit %pass /write %arvo %c %info -)
|
||||
=/ byk=path (en-beam:format byk.bowl(r da+now.bowl) ~)
|
||||
=+ .^(=tube:clay cc+(welp byk /mime/atom))
|
||||
=/ =cage atom+(tube !>([/ (as-octs:mimes:html dat)]))
|
||||
(foal:space:userlib :(welp byk sec+p.hot /atom) cag)
|
||||
::
|
||||
++ poke-moon :: rotate moon keys
|
||||
|= sed=(unit [=ship =udiff:point:able:jael])
|
||||
=< abet
|
||||
@ -193,6 +223,7 @@
|
||||
%helm-send-hi =;(f (f !<(_+<.f vase)) poke-send-hi)
|
||||
%helm-serve =;(f (f !<(_+<.f vase)) poke-serve)
|
||||
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
|
||||
%helm-write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
|
||||
==
|
||||
::
|
||||
++ take-agent
|
||||
|
||||
@ -1,81 +1,64 @@
|
||||
:: :: ::
|
||||
:::: /hoon/kiln/hood/lib :: ::
|
||||
:: :: ::
|
||||
/? 310 :: version
|
||||
:: :: ::
|
||||
:::: :: ::
|
||||
:: :: ::
|
||||
=, clay
|
||||
=, space:userlib
|
||||
=, format
|
||||
|% :: ::
|
||||
+$ part [%kiln %1 pith] :: kiln state
|
||||
+$ part-old ::
|
||||
$: %kiln ::
|
||||
$% [%0 pith-0] ::
|
||||
[%1 pith-1] ::
|
||||
== == ::
|
||||
++ pith pith-1 :: ::
|
||||
++ pith-0 ::
|
||||
$: rem=(map desk per-desk) ::
|
||||
syn=(map kiln-sync let=@ud) ::
|
||||
autoload-on=? ::
|
||||
cur-hoon=@uvI ::
|
||||
cur-arvo=@uvI ::
|
||||
cur-zuse=@uvI ::
|
||||
cur-vanes=(map @tas @uvI) ::
|
||||
commit-timer=[way=wire nex=@da tim=@dr mon=term]
|
||||
== ::
|
||||
:: ::
|
||||
++ pith-1 ::
|
||||
$: rem=(map desk per-desk) ::
|
||||
syn=(map kiln-sync let/@ud) ::
|
||||
ota=(unit [=ship =desk =aeon]) ::
|
||||
commit-timer=[way=wire nex=@da tim=@dr mon=term]
|
||||
== ::
|
||||
::
|
||||
++ per-desk :: per-desk state
|
||||
$: auto/? :: escalate on failure
|
||||
gem/germ :: strategy
|
||||
her/@p :: from ship
|
||||
sud/@tas :: from desk
|
||||
cas/case :: at case
|
||||
== ::
|
||||
:: :: ::
|
||||
:::: :: ::
|
||||
:: :: ::
|
||||
++ kiln-commit term ::
|
||||
++ kiln-mount ::
|
||||
$: pax/path ::
|
||||
pot/term ::
|
||||
== ::
|
||||
++ kiln-unmount $@(term {knot path}) ::
|
||||
++ kiln-sync ::
|
||||
$: syd/desk ::
|
||||
her/ship ::
|
||||
sud/desk ::
|
||||
== ::
|
||||
++ kiln-unsync ::
|
||||
$: syd/desk ::
|
||||
her/ship ::
|
||||
sud/desk ::
|
||||
== ::
|
||||
++ kiln-merge ::
|
||||
$: syd/desk ::
|
||||
ali/ship ::
|
||||
sud/desk ::
|
||||
cas/case ::
|
||||
gim/?($auto germ) ::
|
||||
== ::
|
||||
-- ::
|
||||
:: :: ::
|
||||
:::: :: ::
|
||||
:: :: ::
|
||||
|= {bowl:gall part} :: main kiln work
|
||||
|%
|
||||
+$ state [%1 pith-1]
|
||||
+$ any-state
|
||||
$% state
|
||||
[%0 pith-0]
|
||||
==
|
||||
+$ pith-1 ::
|
||||
$: rem=(map desk per-desk) ::
|
||||
syn=(map kiln-sync let=@ud) ::
|
||||
ota=(unit [=ship =desk =aeon]) ::
|
||||
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
|
||||
== ::
|
||||
+$ pith-0 ::
|
||||
$: rem=(map desk per-desk) ::
|
||||
syn=(map kiln-sync let=@ud) ::
|
||||
autoload-on=? ::
|
||||
cur-hoon=@uvI ::
|
||||
cur-arvo=@uvI ::
|
||||
cur-zuse=@uvI ::
|
||||
cur-vanes=(map @tas @uvI) ::
|
||||
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
|
||||
==
|
||||
+$ per-desk :: per-desk state
|
||||
$: auto=? :: escalate on failure
|
||||
gem=germ :: strategy
|
||||
her=@p :: from ship
|
||||
sud=@tas :: from desk
|
||||
cas=case :: at case
|
||||
==
|
||||
+$ kiln-commit term ::
|
||||
+$ kiln-mount ::
|
||||
$: pax=path ::
|
||||
pot=term ::
|
||||
==
|
||||
+$ kiln-unmount $@(term [knot path]) ::
|
||||
+$ kiln-sync ::
|
||||
$: syd=desk ::
|
||||
her=ship ::
|
||||
sud=desk ::
|
||||
==
|
||||
+$ kiln-unsync ::
|
||||
$: syd=desk ::
|
||||
her=ship ::
|
||||
sud=desk ::
|
||||
==
|
||||
+$ kiln-merge ::
|
||||
$: syd=desk ::
|
||||
ali=ship ::
|
||||
sud=desk ::
|
||||
cas=case ::
|
||||
gim=?($auto germ) ::
|
||||
==
|
||||
--
|
||||
|= [bowl:gall state]
|
||||
?> =(src our)
|
||||
|_ moz/(list card:agent:gall)
|
||||
|_ moz=(list card:agent:gall)
|
||||
++ abet :: resolve
|
||||
[(flop moz) `part`+<+.$]
|
||||
[(flop moz) `state`+<+.$]
|
||||
::
|
||||
++ emit
|
||||
|= card:agent:gall
|
||||
@ -92,12 +75,12 @@
|
||||
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
|
||||
::
|
||||
++ on-load
|
||||
|= =part-old
|
||||
|= old=any-state
|
||||
=< abet
|
||||
=? . ?=(%0 +<.part-old)
|
||||
=? . ?=(%0 -.old)
|
||||
=/ recognized-ota=(unit [syd=desk her=ship sud=desk])
|
||||
=/ syncs=(list [[syd=desk her=ship sud=desk] =aeon])
|
||||
~(tap by syn.part-old)
|
||||
~(tap by syn.old)
|
||||
|- ^- (unit [syd=desk her=ship sud=desk])
|
||||
?~ syncs
|
||||
~
|
||||
@ -106,22 +89,17 @@
|
||||
$(syncs t.syncs)
|
||||
::
|
||||
=. +<+.$.abet
|
||||
%= part-old
|
||||
+< %1
|
||||
syn
|
||||
?~ recognized-ota
|
||||
syn
|
||||
(~(del by syn) [syd her sud]:u.recognized-ota)
|
||||
::
|
||||
|4 [~ commit-timer.part-old]
|
||||
==
|
||||
=- old(- %1, |3 [ota=~ commit-timer.old], syn -)
|
||||
?~ recognized-ota
|
||||
syn
|
||||
(~(del by syn) [syd her sud]:u.recognized-ota)
|
||||
::
|
||||
=? ..abet ?=(^ recognized-ota)
|
||||
(poke-internal:update `[her sud]:u.recognized-ota)
|
||||
+(part-old +<+.$.abet)
|
||||
+(old +<+.$.abet)
|
||||
::
|
||||
?> ?=(%1 +<.part-old)
|
||||
=. +<+.$.abet part-old
|
||||
?> ?=(%1 -.old)
|
||||
=. +<+.$.abet old
|
||||
..abet
|
||||
::
|
||||
++ poke-commit
|
||||
|
||||
@ -1,118 +0,0 @@
|
||||
:: File writer module
|
||||
::
|
||||
:::: /hoon/write/hood/lib
|
||||
::
|
||||
/? 310
|
||||
=, format
|
||||
=* as-octs as-octs:mimes:html
|
||||
=, space:userlib
|
||||
|%
|
||||
+$ part {$write $0 pith} :: no state
|
||||
+$ part-old part
|
||||
+$ pith ~
|
||||
--
|
||||
::
|
||||
::::
|
||||
::
|
||||
|%
|
||||
++ data $%({$json json} {$mime mime})
|
||||
--
|
||||
::
|
||||
::::
|
||||
::
|
||||
|= {bowl:gall part}
|
||||
=* par +<+
|
||||
|_ moz/(list card:agent:gall)
|
||||
++ abet [(flop moz) `part`par]
|
||||
++ emit
|
||||
|= =card:agent:gall
|
||||
%_(+> moz :_(moz card))
|
||||
::
|
||||
++ beak-now byk(r [%da now])
|
||||
++ poke-wipe
|
||||
|= sup/path ^+ abet :: XX determine extension, beak
|
||||
=+ ext=%md
|
||||
?~ (file (en-beam beak-now [ext sup]))
|
||||
~|(not-found+[ext `path`(flop sup)] !!)
|
||||
=- abet:(emit %pass /write %arvo %c %info -)
|
||||
(fray (en-beam beak-now [ext sup]))
|
||||
::
|
||||
++ poke-tree
|
||||
|= {sup/path mim/mime} ^+ abet :: XX determine extension, beak
|
||||
(poke--data [`%md (flop sup)] %mime mim)
|
||||
::
|
||||
++ poke-paste
|
||||
|= {typ/?($hoon $md $txt) txt/@t} ^+ abet
|
||||
(poke--data [`typ /web/paste/(scot %da now)] %mime / (as-octs txt))
|
||||
::
|
||||
++ poke-comment
|
||||
|= {sup/path him/ship txt/@t} ^+ abet
|
||||
=+ pax=(welp (flop sup) /comments/(scot %da now))
|
||||
=. txt
|
||||
%+ rap 3 :~
|
||||
'## `' (scot %p him) '`'
|
||||
'\0a' txt
|
||||
==
|
||||
(poke--data [`%md pax] %mime / (as-octs txt))
|
||||
::
|
||||
++ poke-fora-post
|
||||
|= {sup/path him/ship hed/@t txt/@t} ^+ abet
|
||||
=+ pax=(welp (flop sup) /posts/(cat 3 (scot %da now) '~'))
|
||||
=. txt
|
||||
%- crip
|
||||
"""
|
||||
---
|
||||
type: post
|
||||
date: {<now>}
|
||||
title: {(trip hed)}
|
||||
author: {<him>}
|
||||
navsort: bump
|
||||
navuptwo: true
|
||||
comments: reverse
|
||||
---
|
||||
|
||||
{(trip txt)}
|
||||
"""
|
||||
(poke--data [`%md pax] %mime / (as-octs txt))
|
||||
::
|
||||
++ ames-secret
|
||||
^- @t
|
||||
=- (crip +:<.^(@p %j pax)>)
|
||||
pax=/(scot %p our)/code/(scot %da now)/(scot %p our)
|
||||
::
|
||||
++ poke-sec-atom
|
||||
|= {hot/host:eyre dat/@}
|
||||
?> ?=(%& -.hot)
|
||||
=. p.hot (scag 2 p.hot) :: ignore subdomain
|
||||
=. dat (scot %uw (en:crub:crypto ames-secret dat))
|
||||
(poke--data [`%atom [%sec p.hot]] %mime / (as-octs dat))
|
||||
::
|
||||
++ poke--data
|
||||
|= {{ext/(unit @t) pax/path} dat/data} ^+ abet
|
||||
?~ ext $(ext [~ -.dat])
|
||||
=/ cay=cage ?-(-.dat $json [-.dat !>(+.dat)], $mime [-.dat !>(+.dat)])
|
||||
=/ =cage
|
||||
?: =(u.ext -.dat)
|
||||
cay
|
||||
=+ .^(=tube:clay %cc /(scot %p our)/home/(scot %da now)/[p.cay]/[u.ext])
|
||||
[u.ext (tube q.cay)]
|
||||
=- abet:(emit %pass /write %arvo %c %info -)
|
||||
(foal :(welp (en-beam beak-now ~) pax /[-.cage]) cage)
|
||||
::
|
||||
++ poke
|
||||
|= [=mark =vase]
|
||||
?+ mark ~|([%poke-write-bad-mark mark] !!)
|
||||
%write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
|
||||
%write-paste =;(f (f !<(_+<.f vase)) poke-paste)
|
||||
%write-tree =;(f (f !<(_+<.f vase)) poke-tree)
|
||||
%write-wipe =;(f (f !<(_+<.f vase)) poke-wipe)
|
||||
==
|
||||
::
|
||||
++ take
|
||||
|= [=wire =sign-arvo]
|
||||
!!
|
||||
::
|
||||
++ take-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
~|([%write-bad-take-agent wire -.sign] !!)
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user