diff options
Diffstat (limited to 'backupdesk/lib')
| -rw-r--r-- | backupdesk/lib/dbug.hoon | 155 | ||||
| -rw-r--r-- | backupdesk/lib/docket.hoon | 223 | ||||
| -rw-r--r-- | backupdesk/lib/json/common.hoon | 29 | ||||
| -rw-r--r-- | backupdesk/lib/json/nostr.hoon | 176 | ||||
| -rw-r--r-- | backupdesk/lib/json/nostrill.hoon | 123 | ||||
| -rw-r--r-- | backupdesk/lib/json/trill.hoon | 191 | ||||
| -rw-r--r-- | backupdesk/lib/markdown.hoon | 1711 | ||||
| -rw-r--r-- | backupdesk/lib/nostr.hoon | 31 | ||||
| -rw-r--r-- | backupdesk/lib/nostrill.hoon | 54 | ||||
| -rw-r--r-- | backupdesk/lib/nostrill/mutations.hoon | 203 | ||||
| -rw-r--r-- | backupdesk/lib/server.hoon | 159 | ||||
| -rw-r--r-- | backupdesk/lib/shim.hoon | 88 | ||||
| -rw-r--r-- | backupdesk/lib/sortug.hoon | 145 | ||||
| -rw-r--r-- | backupdesk/lib/strand.hoon | 1 | ||||
| -rw-r--r-- | backupdesk/lib/strandio.hoon | 965 | ||||
| -rw-r--r-- | backupdesk/lib/trill/post.hoon | 377 |
16 files changed, 4631 insertions, 0 deletions
diff --git a/backupdesk/lib/dbug.hoon b/backupdesk/lib/dbug.hoon new file mode 100644 index 0000000..ce98619 --- /dev/null +++ b/backupdesk/lib/dbug.hoon @@ -0,0 +1,155 @@ +:: dbug: agent wrapper for generic debugging tools +:: +:: usage: %-(agent:dbug your-agent) +:: +|% ++$ poke + $% [%bowl ~] + [%state grab=cord] + [%incoming =about] + [%outgoing =about] + == +:: ++$ about + $@ ~ + $% [%ship =ship] + [%path =path] + [%wire =wire] + [%term =term] + == +:: +++ agent + |= =agent:gall + ^- agent:gall + !. + |_ =bowl:gall + +* this . + ag ~(. agent bowl) + :: + ++ on-poke + |= [=mark =vase] + ^- (quip card:agent:gall agent:gall) + ?. ?=(%dbug mark) + =^ cards agent (on-poke:ag mark vase) + [cards this] + =/ dbug + !<(poke vase) + =; =tang + ((%*(. slog pri 1) tang) [~ this]) + ?- -.dbug + %bowl [(sell !>(bowl))]~ + :: + %state + =? grab.dbug =('' grab.dbug) '-' + =; product=^vase + [(sell product)]~ + =/ state=^vase + :: if the underlying app has implemented a /dbug/state scry endpoint, + :: use that vase in place of +on-save's. + :: + =/ result=(each ^vase tang) + (mule |.(q:(need (need (on-peek:ag /x/dbug/state))))) + ?:(?=(%& -.result) p.result on-save:ag) + %+ slap + (slop state !>([bowl=bowl ..zuse])) + (ream grab.dbug) + :: + %incoming + =; =tang + ?^ tang tang + [%leaf "no matching subscriptions"]~ + %+ murn + %+ sort ~(tap by sup.bowl) + |= [[* a=[=ship =path]] [* b=[=ship =path]]] + (aor [path ship]:a [path ship]:b) + |= [=duct [=ship =path]] + ^- (unit tank) + =; relevant=? + ?. relevant ~ + `>[path=path from=ship duct=duct]< + ?: ?=(~ about.dbug) & + ?- -.about.dbug + %ship =(ship ship.about.dbug) + %path ?=(^ (find path.about.dbug path)) + %wire %+ lien duct + |=(=wire ?=(^ (find wire.about.dbug wire))) + %term !! + == + :: + %outgoing + =; =tang + ?^ tang tang + [%leaf "no matching subscriptions"]~ + %+ murn + %+ sort ~(tap by wex.bowl) + |= [[[a=wire *] *] [[b=wire *] *]] + (aor a b) + |= [[=wire =ship =term] [acked=? =path]] + ^- (unit tank) + =; relevant=? + ?. relevant ~ + `>[wire=wire agnt=[ship term] path=path ackd=acked]< + ?: ?=(~ about.dbug) & + ?- -.about.dbug + %ship =(ship ship.about.dbug) + %path ?=(^ (find path.about.dbug path)) + %wire ?=(^ (find wire.about.dbug wire)) + %term =(term term.about.dbug) + == + == + :: + ++ on-peek + |= =path + ^- (unit (unit cage)) + ?. ?=([@ %dbug *] path) + (on-peek:ag path) + ?+ path [~ ~] + [%u %dbug ~] ``noun+!>(&) + [%x %dbug %state ~] ``noun+!>(on-save:ag) + [%x %dbug %subscriptions ~] ``noun+!>([wex sup]:bowl) + == + :: + ++ on-init + ^- (quip card:agent:gall agent:gall) + =^ cards agent on-init:ag + [cards this] + :: + ++ on-save on-save:ag + :: + ++ on-load + |= old-state=vase + ^- (quip card:agent:gall agent:gall) + =^ cards agent (on-load:ag old-state) + [cards this] + :: + ++ on-watch + |= =path + ^- (quip card:agent:gall agent:gall) + =^ cards agent (on-watch:ag path) + [cards this] + :: + ++ on-leave + |= =path + ^- (quip card:agent:gall agent:gall) + =^ cards agent (on-leave:ag path) + [cards this] + :: + ++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card:agent:gall agent:gall) + =^ cards agent (on-agent:ag wire sign) + [cards this] + :: + ++ on-arvo + |= [=wire =sign-arvo] + ^- (quip card:agent:gall agent:gall) + =^ cards agent (on-arvo:ag wire sign-arvo) + [cards this] + :: + ++ on-fail + |= [=term =tang] + ^- (quip card:agent:gall agent:gall) + =^ cards agent (on-fail:ag term tang) + [cards this] + -- +-- diff --git a/backupdesk/lib/docket.hoon b/backupdesk/lib/docket.hoon new file mode 100644 index 0000000..ef39b7f --- /dev/null +++ b/backupdesk/lib/docket.hoon @@ -0,0 +1,223 @@ +/- *docket +|% +:: +++ mime + |% + +$ draft + $: title=(unit @t) + info=(unit @t) + color=(unit @ux) + glob-http=(unit [=url hash=@uvH]) + glob-ames=(unit [=ship hash=@uvH]) + base=(unit term) + site=(unit path) + image=(unit url) + version=(unit version) + website=(unit url) + license=(unit cord) + == + :: + ++ finalize + |= =draft + ^- (unit docket) + ?~ title.draft ~ + ?~ info.draft ~ + ?~ color.draft ~ + ?~ version.draft ~ + ?~ website.draft ~ + ?~ license.draft ~ + =/ href=(unit href) + ?^ site.draft `[%site u.site.draft] + ?~ base.draft ~ + ?^ glob-http.draft + `[%glob u.base hash.u.glob-http %http url.u.glob-http]:draft + ?~ glob-ames.draft + ~ + `[%glob u.base hash.u.glob-ames %ames ship.u.glob-ames]:draft + ?~ href ~ + =, draft + :- ~ + :* %1 + u.title + u.info + u.color + u.href + image + u.version + u.website + u.license + == + :: + ++ from-clauses + =| =draft + |= cls=(list clause) + ^- (unit docket) + =* loop $ + ?~ cls (finalize draft) + =* clause i.cls + =. draft + ?- -.clause + %title draft(title `title.clause) + %info draft(info `info.clause) + %color draft(color `color.clause) + %glob-http draft(glob-http `[url hash]:clause) + %glob-ames draft(glob-ames `[ship hash]:clause) + %base draft(base `base.clause) + %site draft(site `path.clause) + %image draft(image `url.clause) + %version draft(version `version.clause) + %website draft(website `website.clause) + %license draft(license `license.clause) + == + loop(cls t.cls) + :: + ++ to-clauses + |= d=docket + ^- (list clause) + %- zing + :~ :~ title+title.d + info+info.d + color+color.d + version+version.d + website+website.d + license+license.d + == + ?~ image.d ~ ~[image+u.image.d] + ?: ?=(%site -.href.d) ~[site+path.href.d] + =/ ref=glob-reference glob-reference.href.d + :~ base+base.href.d + ?- -.location.ref + %http [%glob-http url.location.ref hash.ref] + %ames [%glob-ames ship.location.ref hash.ref] + == == == + :: + ++ spit-clause + |= =clause + ^- tape + %+ weld " {(trip -.clause)}+" + ?+ -.clause "'{(trip +.clause)}'" + %color (scow %ux color.clause) + %site (spud path.clause) + :: + %glob-http + "['{(trip url.clause)}' {(scow %uv hash.clause)}]" + :: + %glob-ames + "[{(scow %p ship.clause)} {(scow %uv hash.clause)}]" + :: + %version + =, version.clause + "[{(scow %ud major)} {(scow %ud minor)} {(scow %ud patch)}]" + == + :: + ++ spit-docket + |= dock=docket + ^- tape + ;: welp + ":~\0a" + `tape`(zing (join "\0a" (turn (to-clauses dock) spit-clause))) + "\0a==" + == + -- +:: +++ enjs + =, enjs:format + |% + :: + ++ charge-update + |= u=^charge-update + ^- json + %+ frond -.u + ^- json + ?- -.u + %del-charge s+desk.u + :: + %initial + %- pairs + %+ turn ~(tap by initial.u) + |=([=desk c=^charge] [desk (charge c)]) + :: + %add-charge + %- pairs + :~ desk+s+desk.u + charge+(charge charge.u) + == + == + :: + ++ num + |= a=@u + ^- ^tape + =/ p=json (numb a) + ?> ?=(%n -.p) + (trip p.p) + :: + ++ version + |= v=^version + ^- json + :- %s + %- crip + "{(num major.v)}.{(num minor.v)}.{(num patch.v)}" + :: + ++ merge + |= [a=json b=json] + ^- json + ?> &(?=(%o -.a) ?=(%o -.b)) + [%o (~(uni by p.a) p.b)] + :: + ++ href + |= h=^href + %+ frond -.h + ?- -.h + %site s+(spat path.h) + %glob + %- pairs + :~ base+s+base.h + glob-reference+(glob-reference glob-reference.h) + == + == + :: + ++ glob-reference + |= ref=^glob-reference + %- pairs + :~ hash+s+(scot %uv hash.ref) + location+(glob-location location.ref) + == + :: + ++ glob-location + |= loc=^glob-location + ^- json + %+ frond -.loc + ?- -.loc + %http s+url.loc + %ames s+(scot %p ship.loc) + == + :: + ++ charge + |= c=^charge + %+ merge (docket docket.c) + %- pairs + :~ chad+(chad chad.c) + == + :: + ++ docket + |= d=^docket + ^- json + %- pairs + :~ title+s+title.d + info+s+info.d + color+s+(scot %ux color.d) + href+(href href.d) + image+?~(image.d ~ s+u.image.d) + version+(version version.d) + license+s+license.d + website+s+website.d + == + :: + ++ chad + |= c=^chad + %+ frond -.c + ?+ -.c ~ + %hung s+err.c + == + -- +-- diff --git a/backupdesk/lib/json/common.hoon b/backupdesk/lib/json/common.hoon new file mode 100644 index 0000000..64d4b03 --- /dev/null +++ b/backupdesk/lib/json/common.hoon @@ -0,0 +1,29 @@ +/+ sr=sortug +|% +++ en +=, enjs:format + |% + ++ cord |= s=@t ^- json s+s + ++ hex |= h=@ux ^- json + [%s (crip (scow:sr %ux h))] + ++ b64 |= h=@uv ^- json + [%s (crip (scow:sr %uv h))] + ++ ud |= n=@ ^- json + [%s (crip (scow:sr %ud n))] + ++ patp |= p=@p ^- json + [%s (scot %p p)] + -- +++ de +=, dejs-soft:format + |% + ++ hex |= jon=json ^- (unit @ux) + ?. ?=(%s -.jon) ~ + =/ atom=(unit @) (slaw:sr %ux p.jon) + ?~ atom ~ + atom + ++ se |= aur=@tas |= jon=json + ?. ?=(%s -.jon) ~ + (slaw aur p.jon) + -- + +-- diff --git a/backupdesk/lib/json/nostr.hoon b/backupdesk/lib/json/nostr.hoon new file mode 100644 index 0000000..defbe77 --- /dev/null +++ b/backupdesk/lib/json/nostr.hoon @@ -0,0 +1,176 @@ +/- sur=nostr +/+ common=json-common, sr=sortug +|% +++ en +=, enjs:format + |% + :: shim comms + ++ bulk-req |= [relays=(list @t) r=req:shim:sur] ^- json + %: pairs + relays+a+(turn relays cord:en:common) + req+(req r) + ~ + == + ++ req |= =req:shim:sur ^- json + :- %a :- s+(crip (cuss (trip -.req))) + ?- -.req + %req (enreq +.req) + %event :_ ~ (event +.req) + %auth :_ ~ (event +.req) + %close :_ ~ [%s +.req] + == +++ enreq + |= [sub-id=@t fs=(list filter:sur)] + ^- (list json) + :- [%s sub-id] + %+ turn fs filter + + :: + ++ raw-event |= raw-event:sur + :: WTF nostr doesn't want the prefix on the pubkey + =/ pubkeyt (scow:sr %ux pubkey) + ?~ pubkeyt !! + =/ pubkeyj [%s (crip t.pubkeyt)] + :- %a :~ + [%n '0'] + pubkeyj + (numb created-at) + (numb kind) + a+(turn tags tag) + s+content + == + ++ event + |= e=event:sur ^- json + =/ pubkeyt (scow:sr %ux pubkey.e) + ?~ pubkeyt !! + =/ pubkeyj [%s (crip t.pubkeyt)] + %: pairs + id+(hex:en:common id.e) + :: pubkey+(hex:en:common pubkey.e) + pubkey+pubkeyj + sig+(hex:en:common sig.e) + ['created_at' (numb created-at.e)] + kind+(numb kind.e) + content+s+content.e + tags+a+(turn tags.e tag) + ~ + == + ++ tag + |= t=tag:sur ^- json [%a (turn t cord:en:common)] + :: :- s+key.t + :: :- s+value.t + :: (turn rest.t |=(tt=@t s+tt)) + :: + ++ filter + |= f=filter:sur ^- json + =| l=(list [key=@t jon=json]) + =. l ?~ ids.f l :_ l ['ids' %a (turn ~(tap in u.ids.f) hex:en:common)] + =. l ?~ authors.f l :_ l ['authors' %a (turn ~(tap in u.authors.f) hex:en:common)] + =. l ?~ kinds.f l :_ l ['kinds' %a (turn ~(tap in u.kinds.f) numb)] + =. l ?~ tags.f l %+ weld l (tags u.tags.f) + + =. l ?~ since.f l :_ l ['since' (sect u.since.f)] + =. l ?~ until.f l :_ l ['until' (sect u.until.f)] + =. l ?~ limit.f l :_ l ['limit' (numb u.limit.f)] + :: + %- pairs l + + + ++ tags + |= tm=(map @t (set @t)) ^- (list [@t json]) :: entries to the filter obeject + %+ turn ~(tap by tm) |= [key=@t values=(set @t)] + =/ nkey (cat 3 '#' key) + [nkey %a (turn ~(tap in values) cord:en:common)] + + ++ user-meta + |= meta=user-meta:sur + %: pairs + name+s+name.meta + picture+s+picture.meta + about+s+about.meta + other+o+other.meta + ~ + == + -- +++ de +=, dejs-soft:format + |% + :: shim + ++ msg + %- ot :~ + relay+so + msg+relay-msg + == + ++ relay-msg + %- of :~ + event+event-sub + ok+relay-ok + eose+so + closed+closed + notice+so + error+so + == + + + :: | { event: { subscription_id: string; event: NostrEvent } } + :: | { ok: { event_id: string; accepted: boolean; message: string } } + :: | { eose: string } + :: | { closed: { subscription_id: string; message: string } } + :: | { notice: string } + :: // this is ours + :: | { error: string }; + ++ event-sub + %- ot :~ + ['subscription_id' so] + event+event + == + ++ relay-ok + %- ot :~ + ['event_id' hex:de:common] + accepted+bo + message+so + == + ++ closed + %- ot :~ + ['subscription_id' so] + message+so + == + ++ event + %- ot :~ + id+hex:de:common + pubkey+hex:de:common + ['created_at' ni] + kind+ni + tags+(ar (ar so)) + content+so + sig+hex:de:common + == + ++ user-meta |= jon=json + ^- (unit user-meta:sur) + ?. ?=(%o -.jon) ~ + =| um=user-meta:sur + =/ fields ~(tap by p.jon) + |- ?~ fields (some um) + =/ k -.i.fields + =/ jn=json +.i.fields + ?+ k + =/ ot (~(put by other.um) k jn) + =. um um(other ot) $(fields t.fields) + %'name' + =/ crd (so jn) + ?~ crd $(fields t.fields) $(fields t.fields, um um(name u.crd)) + %'display_name' + =/ crd (so jn) + ?~ crd $(fields t.fields) $(fields t.fields, um um(name u.crd)) + %'displayName' + =/ crd (so jn) + ?~ crd $(fields t.fields) $(fields t.fields, um um(name u.crd)) + %'about' + =/ crd (so jn) + ?~ crd $(fields t.fields) $(fields t.fields, um um(picture u.crd)) + %'picture' + =/ crd (so jn) + ?~ crd $(fields t.fields) $(fields t.fields, um um(picture u.crd)) + == + -- +-- diff --git a/backupdesk/lib/json/nostrill.hoon b/backupdesk/lib/json/nostrill.hoon new file mode 100644 index 0000000..43f7708 --- /dev/null +++ b/backupdesk/lib/json/nostrill.hoon @@ -0,0 +1,123 @@ +/- sur=nostrill, nsur=nostr, feed=trill-feed +/+ sr=sortug, common=json-common, trill=json-trill, nostr=json-nostr +|% +++ en +=, enjs:format +|% + :: UI comms + ++ state |= state-0:sur ^- json + %: pairs + relays+(en-relays relays) + key+(hex:en:common pub.i.keys) + profiles+(en-profiles profiles) + :: TODO proper cursors + feed+(feed-with-cursor:en:trill feed ~ ~) + nostr+(en-nostr-feed nostr-feed) + following+(enfollowing following) + ['followGraph' (engraph follow-graph)] + ~ + == + ++ en-nostr-feed + |= feed=nostr-feed:sur ^- json + :- %a %+ turn (tap:norm:sur feed) |= [id=@ud ev=event:nsur] + (event:en:nostr ev) + + ++ en-relays + |= r=(map @t relay-stats:nsur) ^- json + %- pairs %+ turn ~(tap by r) + |= [url=@t rs=relay-stats:nsur] + :- url %- pairs + :~ :- %connected ?~ connected.rs ~ (time u.connected.rs) + :- %reqs (relay-stats reqs.rs) + == + ++ relay-stats |= rm=(map @t event-stats:nsur) + %- pairs %+ turn ~(tap by rm) |= [sub-id=@t es=event-stats:nsur] + :: TODO do we even need this + :- sub-id (numb received.es) + + ++ en-profiles |= m=(map @ux user-meta:nsur) + %- pairs + %+ turn ~(tap by m) |= [key=@ux p=user-meta:nsur] + :- (crip (scow:sr %ux key)) (user-meta:en:nostr p) + + ++ enfollowing + |= m=(map @ux feed:feed) + ^- json + %- pairs %+ turn ~(tap by m) |= [key=@ux f=feed:feed] + :- (crip (scow:sr %ux key)) (feed:en:trill f) + + ++ engraph + |= m=(map @ux (set follow:sur)) + ^- json + %- pairs %+ turn ~(tap by m) |= [key=@ux s=(set follow:sur)] + :- (crip (scow:sr %ux key)) + :- %a %+ turn ~(tap in s) |= f=follow:sur + %- pairs + :~ pubkey+(hex:en:common pubkey.f) + name+s+name.f + :- %relay ?~ relay.f ~ s+u.relay.f + == + + + -- +++ de +=, dejs-soft:format +|% + :: ui +++ ui + %- of :~ + keys+ul + fols+ui-fols + prof+ui-prof + post+ui-post + rela+ui-relay + == +++ ui-fols + %- of :~ + add+hex:de:common + del+hex:de:common + == +++ ui-prof + %- of :~ + add+add-prof + del+hex:de:common + == +++ add-prof %- ot :~ + pubkey+hex:de:common + meta+user-meta:de:nostr +== +++ ui-post + %- of :~ + add+de-post + rt+de-rt + del+hex:de:common + == +++ de-post + %- ot :~ + pubkey+hex:de:common + content+so + == +++ de-rt + %- ot :~ + id+hex:de:common + pubkey+hex:de:common + relay+so + == +++ ui-relay + %- of :~ + send+de-relay + == +++ de-relay %- ot :~ + host+(se:de:common %p) + id+de-atom-id + relays+(ar so) + == +++ de-atom-id + |= jon=json + ?. ?=([%s @t] jon) ~ + (rush p.jon dem) + + -- + +-- + diff --git a/backupdesk/lib/json/trill.hoon b/backupdesk/lib/json/trill.hoon new file mode 100644 index 0000000..efa4ffc --- /dev/null +++ b/backupdesk/lib/json/trill.hoon @@ -0,0 +1,191 @@ +/- feed=trill-feed, post=trill-post +/+ common=json-common, sr=sortug +|% +++ en +=, enjs:format + |% + ++ feed-with-cursor + |= [f=feed:^feed start=(unit @da) end=(unit @da)] ^- json + %: pairs + feed+(feed f) + start+(cursor start) + end+(cursor end) + ~ + == + ++ cursor |= c=(unit @da) + ?~ c ~ (time u.c) + ++ feed + |= f=feed:^feed ^- json + %- pairs + %+ turn (tap:orm:^feed f) + |= [post-id=@da p=post:post] + ^- [@ta json] + :- (crip (scow:sr %ud `@ud`post-id)) + (poast p) + + ++ poast + |= p=post:post ^- json + %- pairs + :~ id+(ud:en:common id.p) + host+(patp:en:common host.p) + author+(patp:en:common author.p) + thread+(ud:en:common thread.p) + parent+?~(parent.p ~ (ud:en:common u.parent.p)) + contents+(content contents.p) + hash+(b64:en:common hash.p) + engagement+(engagement engagement.p) + children+a+(turn ~(tap in children.p) ud:en:common) + time+(time id.p) + == + + ++ content + |= cm=content-map:post ^- json + =/ last (pry:corm:post cm) + ?~ last ~ + =/ blocks=content-list:post +.u.last + :- %a %+ turn blocks en-block + ++ en-block + |= b=block:post ^- json + %+ frond -.b + ?- -.b + %paragraph a+(turn p.b inline) + %blockquote a+(turn p.b inline) + %table a+(turn rows.b table-row) + %heading (heading +.b) + %list (ilist +.b) + %media (media media.b) + %codeblock (codespan +.b) + %eval s+hoon.b + %ref (en-ref +.b) + %json (external +.b) + %poll ~ + == + ++ table-row + |= l=(list content-list:post) + :- %a %+ turn l + |= b=content-list:post + :- %a %+ turn b en-block + ++ heading + |= [p=cord q=@] + %- pairs + :~ text+s+p + num+(numb q) + == + ++ ilist + |= [p=(list inline:post) q=?] + %- pairs + :~ text+a+(turn p inline) + ordered+b+q + == + ++ media + |= =media:post + %+ frond -.media + ?- -.media + %images a+(turn p.media string) + %video s+p.media + %audio s+p.media + == + ++ string + |= c=cord s+c + ++ en-ref :: TODO should the backend fetch this shit + |= [type=term s=@p p=^path] + %- pairs + :~ type+s+type + ship+(patp:en:common s) + path+(path p) + == + ++ external + |= [p=term q=cord] + %- pairs + :~ origin+s+p + content+s+q + == + ++ inline + |= i=inline:post ^- json + %+ frond -.i + ?+ -.i s+p.i + %ship (patp:en:common p.i) + %link (link +.i) + %ruby (ruby +.i) + %break ~ + == + ++ ruby + |= [p=@t q=@t] + %- pairs + :~ text+s+p + ruby+s+q + == + ++ codespan + |= [code=cord lang=cord] + %- pairs + :~ code+s+code + lang+s+lang + == + ++ link + |= [href=cord show=cord] + %- pairs + :~ href+s+href + show+s+show + == + + ++ engagement + |= =engagement:post ^- json + %- pairs + :~ reacts+(reacts reacts.engagement) + quoted+a+(turn ~(tap in quoted.engagement) signed-pid) + shared+a+(turn ~(tap in shared.engagement) signed-pid) + == + ++ reacts + |= rs=(map @p [react:post signature:post]) + ^- json + %- pairs + %+ turn ~(val by rs) + |= [r=react:post s=signature:post] + ^- [@ta json] + :- (scot %p q.s) + s+r + ++ signed-pid + |= =signed-pid:post + ^- json + %- pairs + :~ ship+(patp:en:common q.signature.signed-pid) + pid+(pid pid.signed-pid) + == + ++ time-pid + |= [t=@da s=@p =id:post] + %- pairs + :~ id+(ud:en:common id) + ship+(patp:en:common s) + time+(time t) + == + ++ time-ship + |= [t=@da s=@p] ^- json + %- pairs + :~ ship+(patp:en:common s) + time+(time t) + == + ++ mention + |= [t=@da s=@p p=pid:post] ^- json + %- pairs + :~ pid+(pid p) + ship+(patp:en:common s) + time+(time t) + == + ++ react + |= [t=@da s=@p p=pid:post react=@t] ^- json + %- pairs + :~ pid+(pid p) + ship+(patp:en:common s) + react+s+react + time+(time t) + == + ++ pid + |= =pid:post + %- pairs + :~ ship+(patp:en:common ship.pid) + id+(ud:en:common id.pid) + == + :: + :: + -- +-- diff --git a/backupdesk/lib/markdown.hoon b/backupdesk/lib/markdown.hoon new file mode 100644 index 0000000..67ee3ad --- /dev/null +++ b/backupdesk/lib/markdown.hoon @@ -0,0 +1,1711 @@ +/- m=markdown +:: + +=> |% + :: Set label for collapsed / shortcut reference links + ++ backfill-ref-link + |= [a=link:inline:m] + ^- link:inline:m + =/ t target.a + ?+ -.t a :: only reference links + %ref + ?: =(%full type.t) a :: only collapsed / shortcut links + =/ node=element:inline.m (head contents.a) + ?+ -.node a :: ...and it's a %text node + %text + %_ a + target %_ t + label text.node + == + == + == + == + :: + ++ whitespace (mask " \09\0d\0a") :: whitespace: space, tab, or newline + :: + ++ all-link-ref-definitions :: Recursively get link ref definitions + =< process-nodes + |% + ++ process-nodes + |= [nodes=markdown:m] + ^- (map @t urlt:ln:m) + ?~ nodes ~ + %- %~(uni by (process-node (head nodes))) + $(nodes +.nodes) + :: + ++ process-nodeses + |= [nodeses=(list markdown:m)] + ^- (map @t urlt:ln:m) + ?~ nodeses ~ + %- %~(uni by (process-nodes (head nodeses))) + $(nodeses +.nodeses) + :: + ++ process-node + |= [node=node:markdown:m] + ^- (map @t urlt:ln:m) + =/ result *(map @t urlt:ln:m) + ?- -.node + %leaf :: Leaf node: check if it's a link ref def + =/ leaf=node:leaf:m +.node + ?+ -.leaf result + %link-ref-definition (~(put by result) label.leaf urlt.leaf) + == + :: + %container + =/ container=node:container:m +.node + ?- -.container + %block-quote (process-nodes markdown.container) + %ol (process-nodeses contents.container) + %ul (process-nodeses contents.container) + %tl (process-nodeses (turn contents.container |=([is-checked=? =markdown:m] markdown))) + == + == + -- + -- +|% + :: + :: Parse to and from Markdown text format + ++ md + |% + ++ de :: de:md Deserialize (parse) + |% + ++ escaped + |= [char=@t] + (cold char (jest (crip (snoc "\\" char)))) + :: + ++ newline + %+ cold '\0a' :: EOL, with or without carriage return '\0d' + ;~(pfix ;~(pose (just '\0d') (easy ~)) (just '\0a')) + ++ line-end :: Either EOL or EOF + %+ cold '\0a' + ;~(pose newline (full (easy ~))) + :: + ++ ln :: Links and urls + |% + ++ url + =< %+ cook |=(a=url:ln:m a) :: Cast + ;~(pose with-triangles without-triangles) + |% + ++ with-triangles + ;~ plug + %+ cook crip + %+ ifix [gal gar] + %- star + ;~ pose + (escaped '<') + (escaped '>') + ;~(less gal gar line-end prn) :: Anything except '<', '>' or newline + == + (easy %.y) :: "yes triangles" + == + ++ without-triangles + ;~ plug + %+ cook crip + ;~ less + gal :: Doesn't start with '<' + %- plus :: Non-empty + ;~ less + whitespace :: No whitespace allowed + ;~ pose + (escaped '(') + (escaped ')') + ;~(less pal par line-end prn) :: Anything except '(', ')' or newline + == + == + == + (easy %.n) :: "no triangles" + == + -- + :: + ++ urlt + %+ cook |=(a=urlt:ln:m a) :: Cast + ;~ plug + url + %- punt :: Optional title-text + ;~ pfix (plus whitespace) :: Separated by some whitespace + %+ cook crip ;~ pose :: Enclosed in single quote, double quote, or '(...)' + (ifix [soq soq] (star ;~(pose (escaped '\'') ;~(less soq prn)))) + (ifix [doq doq] (star ;~(pose (escaped '"') ;~(less doq prn)))) + (ifix [pal par] (star ;~(pose (escaped '(') (escaped ')') ;~(less pal par prn)))) + == + == + == + :: + :: Labels are used in inline link targets and in a block-level element (labeled link references) + ++ label + %+ cook crip + %+ ifix [sel ser] :: Enclosed in '[...]' + %+ ifix :- (star whitespace) :: Strip leading and trailing whitespapce + (star whitespace) + %- plus ;~ pose :: Non-empty + (escaped '[') + (escaped ']') + ;~(less sel ser prn) :: Anything except '[', ']' (must be escaped) + == + :: + ++ target :: Link target, either reference or direct + =< %+ cook |=(a=target:ln:m a) + ;~(pose target-direct target-ref) + |% + ++ target-direct + %+ cook |=(a=target:ln:m a) + %+ stag %direct + %+ ifix [pal par] :: Direct links are enclosed in '(...)' + %+ ifix :- (star whitespace) :: Strip leading and trailing whitespace + (star whitespace) + urlt :: Just the target + ++ target-ref + %+ cook |=(a=target:ln:m a) + %+ stag %ref + ;~ pose + %+ stag %full label + %+ stag %collapsed (cold '' (jest '[]')) + %+ stag %shortcut (easy '') + == + -- + -- + ++ inline :: Inline elements + |% + ++ contents (cook |=(a=contents:inline:m a) (star element)) :: Element sequence + ++ element :: Any element + %+ cook |=(a=element:inline:m a) + ;~ pose + escape + entity + strong + emphasis + code + link + image + autolink + text + softbrk + hardbrk + == + :: + ++ text + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + link + image + autolink + emphasis + strong + code + softbrk + hardbrk + :: ...etc + prn + == + :: + ++ escape + %+ cook |=(a=escape:inline:m a) + %+ stag %escape + ;~ pose + :: \!\"\#\$\%\&\'\(\)\*\+\,\-\.\/\:\;\<\=\>\?\@\[\\\]\^\_\`\{\|\}\~ + (escaped '[') (escaped ']') (escaped '(') (escaped ')') + (escaped '!') (escaped '*') (escaped '*') (escaped '_') + (escaped '&') (escaped '\\') + :: etc + == + ++ entity + %+ cook |=(a=entity:inline:m a) + %+ stag %entity + %+ ifix [pam mic] + %+ cook crip + ;~ pose + ;~(plug hax (stun [1 7] nud)) :: '#' and one to seven digits + (plus alf) :: Named entity + == + :: + ++ softbrk :: Newline + %+ cook |=(a=softbrk:inline:m a) + %+ stag %soft-line-break + (cold ~ newline) + :: + ++ hardbrk + %+ cook |=(a=hardbrk:inline:m a) + %+ stag %line-break + %+ cold ~ + ;~ pose + ;~(plug (jest ' ') (star ace) newline) :: Two or more spaces before a newline + ;~(plug (just '\\') newline) :: An escaped newline + == + ++ link + %+ knee *link:inline:m |. ~+ :: recurse + %+ cook backfill-ref-link + %+ stag %link + ;~ plug + %+ ifix [sel ser] :: Display text is wrapped in '[...]' + %- star ;~ pose :: Display text can contain various contents + escape + entity + emphasis + strong + code + image + :: Text: => + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + emphasis + strong + code + ser :: No closing ']' + prn + == + == + target:ln + == + :: + ++ image + %+ cook |=(a=image:inline:m a) + %+ stag %image + ;~ plug + %+ ifix [(jest '![') (just ']')] :: alt-text is wrapped in '![...]' + %+ cook crip + %- star ;~ pose + (escaped ']') + ;~(less ser prn) + == + target:ln + == + :: + ++ autolink + %+ cook |=(a=autolink:inline:m a) + %+ stag %autolink + %+ ifix [gal gar] :: Enclosed in '<...>' + %+ cook crip + %- star ;~ pose + ;~(less ace gar prn) :: Spaces are not allowed; neither are backslash-escapes + == + :: + ++ emphasis + %+ knee *emphasis:inline:m |. ~+ :: recurse + %+ cook |=(a=emphasis:inline:m a) + %+ stag %emphasis + ;~ pose + %+ ifix [tar tar] + ;~ plug + (easy '*') + %- plus ;~ pose :: Display text can contain various contents + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + :: + tar :: If a '*', then it's the end of the `emphasis` + :: + prn + == + == + == + %+ ifix [cab cab] + ;~ plug + (easy '_') + %- plus ;~ pose :: Display text can contain various contents + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + :: + cab :: If a '*', then it's the end of the `emphasis` + :: + prn + == + == + == + == + :: + ++ strong + %+ knee *strong:inline:m |. ~+ :: recurse + %+ cook |=(a=strong:inline:m a) + %+ stag %strong + ;~ pose + %+ ifix [(jest '**') (jest '**')] + ;~ plug + (easy '*') + %- plus ;~ pose :: Display text can contain various contents + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + :: ...etc + (jest '**') :: If a '**', then it's the end of the `emphasis` + prn + == + == + == + %+ ifix [(jest '__') (jest '__')] + ;~ plug (easy '_') + %- plus ;~ pose :: Display text can contain various contents + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + :: + (jest '__') :: If a '**', then it's the end of the `emphasis` + prn + == + == + == + == + :: + ++ code + =< %+ cook |=(a=code:inline:m a) + %+ stag %code-span + inner-parser + |% + ++ inner-parser + |= =nail + =/ vex ((plus tic) nail) :: Read the first backtick string + ?~ q.vex vex :: If no vex is found, fail + =/ tic-sequence ^- tape p:(need q.vex) + %. + q:(need q.vex) + %+ cook |= [a=tape] :: Attach the backtick length to it + [(lent tic-sequence) (crip a)] + ;~ sfix + %+ cook + |= [a=(list tape)] + ^- tape + (zing a) + %- star ;~ pose + %+ cook trip ;~(less tic prn) :: Any character other than a backtick + %+ sear :: A backtick string that doesn't match the opener + |= [a=tape] + ^- (unit tape) + ?: =((lent a) (lent tic-sequence)) + ~ + `a + (plus tic) + == + (jest (crip tic-sequence)) :: Followed by a closing backtick string + == + -- + -- + :: + ++ leaf + |% + ++ node + %+ cook |=(a=node:leaf:m a) + ;~ pose + blank-line + heading + break + codeblk-indent + codeblk-fenced + link-ref-def + :: ...etc + table + paragraph + == + ++ blank-line + %+ cook |=(a=blank-line:leaf:m a) + %+ stag %blank-line + (cold ~ newline) + ++ heading + =< %+ cook |=(a=heading:leaf:m a) + %+ stag %heading + ;~(pose atx setext) + |% + ++ atx + =/ atx-eol ;~ plug + (star ace) + (star hax) + (star ace) + line-end + == + + %+ stag %atx + %+ cook :: Parse heading inline content + |= [level=@ text=tape] + [level (scan text contents:inline)] + ;~ pfix + (stun [0 3] ace) :: Ignore up to 3 leading spaces + ;~ plug + (cook |=(a=tape (lent a)) (stun [1 6] hax)) :: Heading level + %+ ifix [(plus ace) atx-eol] :: One leading space is required; rest is ignored + %- star + ;~(less atx-eol prn) :: Trailing haxes/spaces are ignored + == + == + ++ setext + %+ stag %setext + %+ cook + |= [text=tape level=@] + [level (scan text contents:inline)] + ;~ plug :: Wow this is a mess + %+ ifix [(stun [0 3] ace) (star ace)] :: Strip up to 3 spaces, and trailing space + (star ;~(less ;~(pfix (star ace) newline) prn)) :: Any text... + ;~ pfix + newline :: ...followed by newline... + (stun [0 3] ace) :: ...up to 3 spaces (stripped)... + ;~ sfix + ;~ pose :: ...and an underline + (cold 1 (plus (just '-'))) :: Underlined by '-' means heading lvl 1 + (cold 2 (plus (just '='))) :: Underlined by '=' means heading lvl 2 + == + (star ace) + == + == + == + -- + ++ break + %+ cook |=(a=break:leaf:m a) + %+ stag %break + %+ cook + |= [first-2=@t trailing=tape] + [(head trailing) (add 2 (lent trailing))] + %+ ifix :- (stun [0 3] ace) :: Strip indent and trailing space + ;~ plug + (star (mask " \09")) + newline :: No other chars allowed on the line + == + ;~ pose + ;~(plug (jest '**') (plus tar)) :: At least 3, but can be more + ;~(plug (jest '--') (plus hep)) + ;~(plug (jest '__') (plus cab)) + == + :: + ++ codeblk-indent + %+ cook |=(a=codeblk-indent:leaf:m a) + %+ stag %indent-codeblock + %+ cook |=(a=(list tape) (crip (zing a))) + %- plus :: 1 or more lines + ;~ pfix + (jest ' ') :: 4 leading spaces + %+ cook snoc ;~ plug + (star ;~(less line-end prn)) + line-end + == + == + :: + ++ codeblk-fenced + =+ |% + :: Returns a 3-tuple: + :: - indent size + :: - char type + :: - fence length + ++ code-fence + ;~ plug + %+ cook |=(a=tape (lent a)) (stun [0 3] ace) + %+ cook |=(a=tape [(head a) (lent a)]) :: Get code fence char and length + ;~ pose + (stun [3 999.999.999] sig) + (stun [3 999.999.999] tic) + == + == + :: + ++ info-string + %+ cook crip + %+ ifix [(star ace) line-end] :: Strip leading whitespace + (star ;~(less line-end tic prn)) :: No backticks in a code fence + -- + |* =nail + :: Get the marker and indent size + =/ vex (code-fence nail) + ?~ q.vex vex :: If no match found, fail + =/ [indent=@ char=@t len=@] p:(need q.vex) + =/ closing-fence + ;~ plug + (star ace) + (stun [len 999.999.999] (just char)) :: Closing fence must be at least as long as opener + (star ace) :: ...and cannot have any following text except space + line-end + == + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook |=(a=codeblk-fenced:leaf:m a) + %+ stag %fenced-codeblock + ;~ plug + %+ cook |=(a=@t a) (easy char) + (easy len) + %+ cook |=(a=@t a) info-string + (easy indent) + %+ cook |=(a=(list tape) (crip (zing a))) + ;~ sfix + %- star :: Any amount of lines + ;~ less closing-fence :: ...until the closing code fence + ;~ pfix (stun [0 indent] ace) :: Strip indent up to that of the opening fence + %+ cook |=(a=tape a) + ;~ pose :: Avoid infinite loop at EOF + %+ cook trip newline :: A line is either a blank line... + %+ cook snoc + ;~ plug :: Or a non-blank line + (plus ;~(less line-end prn)) + line-end + == + == + == + == + ;~(pose closing-fence (full (easy ~))) + == + == + :: + ++ link-ref-def + %+ cook |=(a=link-ref-def:leaf:m a) + %+ stag %link-ref-definition + %+ ifix [(stun [0 3] ace) line-end] :: Strip leading space + ;~ plug + ;~(sfix label:ln col) :: Label (enclosed in "[...]"), followed by col ":" + ;~ pfix :: Optional whitespace, including up to 1 newline + (star ace) + (stun [0 1] newline) + (star ace) + urlt:ln + == + == + :: + ++ paragraph + %+ cook |=(a=paragraph:leaf:m a) + %+ stag %paragraph + %+ cook :: Reparse the paragraph text as elements + |= [a=(list tape)] + (scan (zing a) contents:inline) + %- plus :: Read lines until a non-paragraph object is found + ;~ less + heading + break + block-quote-line:container :: Block quotes can interrupt paragraphs + %+ cook snoc ;~ plug + %- plus ;~(less line-end prn) :: Lines must be non-empty + line-end + == + == + :: + ++ table + => |% + +$ cell-t [len=@ =contents:inline:m] + ++ row + ;~ pfix bar :: A bar in front... + %- star + %+ cook :: compute the length and parse inlines + |= [pfx=@ stuff=tape sfx=@] + [;:(add pfx (lent stuff) sfx) (scan stuff contents:inline)] :: inline elements... + ;~ plug + (cook lent (star ace)) + (star ;~(less newline ;~(plug (star ace) bar) prn)) + (cook lent ;~(sfix (star ace) bar)) + == + == + ++ delimiter-row + ;~ pfix bar :: A bar in front... + %- star + %+ cook + |= [pfx=@ lal=? heps=@ ral=? sfx=@] + :- ;:(add pfx ?:(ral 1 0) heps ?:(lal 1 0) sfx) + ?:(ral ?:(lal %c %r) ?:(lal %l %n)) + ;~ plug + (cook lent (star ace)) :: Delimiter: leading space... + (cook |=(a=tape .?(a)) (stun [0 1] col)) :: maybe a ':'... + (cook lent (plus hep)) :: a bunch of '-'... + (cook |=(a=tape .?(a)) (stun [0 1] col)) :: maybe another ':'... + (cook lent ;~(sfix (star ace) bar)) :: ..and a bar as a terminator + == + == + -- + |* =nail :: Make it a (redundant) gate so I can use `=>` to add a helper core + %. nail :: apply the following parser + %+ cook + |= [hdr=(list cell-t) del=(list [len=@ al=?(%c %r %l %n)]) bdy=(list (list cell-t))] + ^- table:leaf:m + =/ widths=(list @) (turn del |=([len=@ al=*] len)) + =/ rows=(list (list cell-t)) (snoc bdy hdr) :: since they're the same data type + =/ computed-widths + |- + ?~ rows widths + %= $ + rows (tail rows) + widths =/ row=(list cell-t) (head rows) + |- + ?~ row ~ + :- (max (head widths) len:(head row)) + %= $ + widths (tail widths) + row (tail row) + == + == + :* %table + computed-widths + (turn hdr |=(cell=cell-t contents.cell)) + (turn del |=([len=@ al=?(%c %r %l %n)] al)) + (turn bdy |=(row=(list cell-t) (turn row |=(cell=cell-t contents.cell)))) + == + ;~ plug + ;~(sfix row line-end) + ;~(sfix delimiter-row line-end) + (star ;~(sfix row line-end)) + == + -- + :: + ++ container + =+ |% + :: + ++ line :: Read a line of plain text + %+ cook |=([a=tape b=tape c=tape] ;:(weld a b c)) + ;~ plug + (star ;~(less line-end prn)) + (cook trip line-end) + (star newline) :: Can have blank lines in a list item + == + ++ block-quote-marker + ;~ plug :: Single char '>' + (stun [0 3] ace) :: Indented up to 3 spaces + gar + (stun [0 1] ace) :: Optionally followed by a space + == + ++ block-quote-line + %+ cook snoc + ;~ plug :: Single line... + ;~ pfix block-quote-marker :: ...starting with ">..." + (star ;~(less line-end prn)) :: can be empty + == + line-end + == + :: + +$ ul-marker-t [indent=@ char=@t len=@] + ++ ul-marker + %+ cook :: Compute the length of the whole thing + |= [prefix=tape bullet=@t suffix=tape] + ^- ul-marker-t + :* (lent prefix) + bullet + ;:(add 1 (lent prefix) (lent suffix)) + == + ;~ plug + (stun [0 3] ace) + ;~(pose hep lus tar) :: Bullet char + (stun [1 4] ace) + == + :: + :: Produces a 3-tuple: + :: - bullet char (*, +, or -) + :: - indent level (number of spaces before the bullet) + :: - item contents (markdown) + +$ ul-item-t [char=@t indent=@ =markdown:m] + ++ ul-item + |* =nail + :: Get the marker and indent size + =/ vex (ul-marker nail) + ?~ q.vex vex :: If no match found, fail + =/ mrkr=ul-marker-t p:(need q.vex) + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook + |= [a=(list tape)] + ^- ul-item-t + :* char.mrkr + indent.mrkr + (scan (zing a) markdown) + == + ;~ plug + line :: First line + %- star ;~ pfix :: Subsequent lines must have the same indent + (stun [len.mrkr len.mrkr] ace) :: the indent + line :: the line + == + == + :: + +$ ol-marker-t [indent=@ char=@t number=@ len=@] + ++ ol-marker + %+ cook :: Compute the length of the whole thing + |= [prefix=tape number=@ char=@t suffix=tape] + ^- ol-marker-t + :* (lent prefix) + char + number + ;:(add 1 (lent (a-co:co number)) (lent prefix) (lent suffix)) + == + ;~ plug + (stun [0 3] ace) + dem + ;~(pose dot par) :: Bullet char + (stun [1 4] ace) + == + :: + :: Produces a 4-tuple: + :: - delimiter char: either dot '.' or par ')' + :: - list item number + :: - indent level (number of spaces before the number) + :: - item contents (markdown) + +$ ol-item-t [char=@t number=@ indent=@ =markdown:m] + ++ ol-item + |* =nail + ::^- edge + :: Get the marker and indent size + =/ vex (ol-marker nail) + ?~ q.vex vex :: If no match found, fail + =/ mrkr=ol-marker-t p:(need q.vex) + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook + |= [a=(list tape)] + ^- ol-item-t + :* char.mrkr + number.mrkr + indent.mrkr + (scan (zing a) markdown) + == + ;~ plug + line :: First line + %- star ;~ pfix :: Subsequent lines must have the same indent + (stun [len.mrkr len.mrkr] ace) :: the indent + line :: the line + == + == + :: + ++ tl-checkbox + ;~ pose + %+ cold %.y (jest '[x]') + %+ cold %.n (jest '[ ]') + == + :: + :: Produces a 4-tuple: + :: - bullet char (*, +, or -) + :: - indent level (number of spaces before the bullet) + :: - is-checked + :: - item contents (markdown) + +$ tl-item-t [char=@t indent=@ is-checked=? =markdown:m] + ++ tl-item + |* =nail + :: Get the marker and indent size + =/ vex (;~(plug ul-marker ;~(sfix tl-checkbox ace)) nail) + ?~ q.vex vex :: If no match found, fail + =/ [mrkr=ul-marker-t is-checked=?] p:(need q.vex) + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook + |= [a=(list tape)] + ^- tl-item-t + :* char.mrkr + indent.mrkr + is-checked + (scan (zing a) markdown) + == + ;~ plug + line :: First line + %- star ;~ pfix :: Subsequent lines must have the same indent + (stun [len.mrkr len.mrkr] ace) :: the indent + line :: the line + == + == + -- + |% + ++ node + %+ cook |=(a=node:container:m a) + ;~ pose + block-quote + tl + ul + ol + == + :: + ++ block-quote + %+ cook |=(a=block-quote:container:m a) + %+ stag %block-quote + %+ cook |= [a=(list tape)] + (scan (zing a) markdown) + ;~ plug + block-quote-line + %- star :: At least one line + ;~ pose + block-quote-line + %+ cook zing %- plus :: Paragraph continuation (copied from `paragraph` above) + ;~ less :: ...basically just text that doesn't matchZ anything else + heading:leaf + break:leaf + :: ol + :: ul + block-quote-marker :: Can't start with ">" + line-end :: Can't be blank + %+ cook snoc ;~ plug + %- star ;~(less line-end prn) + line-end + == + == + == + == + :: + ++ ul + |* =nail + :: Start by finding the type of the first bullet (indent level and bullet char) + =/ vex (ul-item nail) + ?~ q.vex vex :: Fail if it doesn't match a list item + =/ first-item=ul-item-t p:(need q.vex) + :: Check for more list items + %. + q:(need q.vex) + %+ cook |=(a=ul:container:m a) + %+ stag %ul + ;~ plug :: Give the first item, first + (easy indent.first-item) + (easy char.first-item) + (easy markdown.first-item) + %- star + %+ sear :: Reject items that don't have the same bullet char + |= [item=ul-item-t] + ^- (unit markdown:m) + ?. =(char.item char.first-item) + ~ + `markdown.item + ul-item + == + :: + ++ ol + |* =nail + :: Start by finding the first number, char, and indent level + =/ vex (ol-item nail) + ?~ q.vex vex :: Fail if it doesn't match a list item + =/ first-item=ol-item-t p:(need q.vex) + :: Check for more list items + %. + q:(need q.vex) + %+ cook |=(a=ol:container:m a) + %+ stag %ol + ;~ plug :: Give the first item, first + (easy indent.first-item) + (easy char.first-item) + (easy number.first-item) + (easy markdown.first-item) + %- star + %+ sear :: Reject items that don't have the same delimiter + |= [item=ol-item-t] + ^- (unit markdown:m) + ?. =(char.item char.first-item) + ~ + `markdown.item + ol-item + == + :: + ++ tl + |* =nail + :: Start by finding the type of the first bullet (indent level and bullet char) + =/ vex (tl-item nail) + ?~ q.vex vex :: Fail if it doesn't match a list item + =/ first-item=tl-item-t p:(need q.vex) + :: Check for more list items + %. + q:(need q.vex) + %+ cook |=(a=tl:container:m a) + %+ stag %tl + ;~ plug :: Give the first item, first + (easy indent.first-item) + (easy char.first-item) + (easy [is-checked.first-item markdown.first-item]) + %- star + %+ sear :: Reject items that don't have the same bullet char + |= [item=tl-item-t] + ^- (unit [is-checked=? markdown:m]) + ?. =(char.item char.first-item) + ~ + `[is-checked.item markdown.item] + tl-item + == + -- + :: + ++ markdown + %+ cook |=(a=markdown:m a) + %- star ;~ pose + (stag %container node:container) + (stag %leaf node:leaf) + == + -- + :: + :: Enserialize (write out as text) + ++ en + |% + ++ escape-chars + |= [text=@t chars=(list @t)] + ^- tape + %+ rash text + %+ cook + |=(a=(list tape) `tape`(zing a)) + %- star ;~ pose + (cook |=(a=@t `tape`~['\\' a]) (mask chars)) + (cook trip prn) + == + :: + ++ ln + |% + ++ url + =< |= [u=url:ln:m] + ^- tape + ?: has-triangle-brackets.u + (with-triangles text.u) + (without-triangles text.u) + |% + ++ with-triangles + |= [text=@t] + ;: weld + "<" :: Put it inside triangle brackets + (escape-chars text "<>") :: Escape triangle brackets in the text + ">" + == + ++ without-triangles + |= [text=@t] + (escape-chars text "()") :: Escape all parentheses '(' and ')' + -- + ++ urlt + |= [u=urlt:ln:m] + ^- tape + ?~ title-text.u :: If there's no title text, then it's just an url + (url url.u) + ;:(weld (url url.u) " \"" (escape-chars (need title-text.u) "\"") "\"") + ++ label + |= [text=@t] + ^- tape + ;:(weld "[" (escape-chars text "[]") "]") + ++ target + |= [t=target:ln:m] + ^- tape + ?- -.t + %direct ;:(weld "(" (urlt urlt.t) ")") :: Wrap in parentheses + :: + %ref ?- type.t + %full (label label.t) + %collapsed "[]" + %shortcut "" + == + == + -- + :: + ++ inline + |% + ++ contents + |= [=contents:inline:m] + ^- tape + %- zing %+ turn contents element + ++ element + |= [e=element:inline:m] + ?+ -.e !! + %text (text e) + %link (link e) + %escape (escape e) + %entity (entity e) + %code-span (code e) + %strong (strong e) + %emphasis (emphasis e) + %soft-line-break (softbrk e) + %line-break (hardbrk e) + %image (image e) + %autolink (autolink e) + :: ...etc + == + ++ text + |= [t=text:inline:m] + ^- tape + (trip text.t) :: So easy! + :: + ++ entity + |= [e=entity:inline:m] + ^- tape + ;:(weld "&" (trip code.e) ";") + :: + ++ link + |= [l=link:inline:m] + ^- tape + ;: weld + "[" + (contents contents.l) + "]" + (target:ln target.l) + == + :: + ++ image + |= [i=image:inline:m] + ^- tape + ;: weld + "![" + (escape-chars alt-text.i "]") + "]" + (target:ln target.i) + == + :: + ++ autolink + |= [a=autolink:inline:m] + ^- tape + ;: weld + "<" + (trip text.a) + ">" + == + :: + ++ escape + |= [e=escape:inline:m] + ^- tape + (snoc "\\" char.e) :: Could use `escape-chars` but why bother-- this is shorter + :: + ++ softbrk + |= [s=softbrk:inline:m] + ^- tape + "\0a" + ++ hardbrk + |= [h=hardbrk:inline:m] + ^- tape + "\\\0a" + ++ code + |= [c=code:inline:m] + ^- tape + ;:(weld (reap num-backticks.c '`') (trip text.c) (reap num-backticks.c '`')) + :: + ++ strong + |= [s=strong:inline:m] + ^- tape + ;: weld + (reap 2 emphasis-char.s) + (contents contents.s) + (reap 2 emphasis-char.s) + == + :: + ++ emphasis + |= [e=emphasis:inline:m] + ^- tape + ;: weld + (trip emphasis-char.e) + (contents contents.e) + (trip emphasis-char.e) + == + -- + :: + ++ leaf + |% + ++ node + |= [n=node:leaf:m] + ?+ -.n !! + %blank-line (blank-line n) + %break (break n) + %heading (heading n) + %indent-codeblock (codeblk-indent n) + %fenced-codeblock (codeblk-fenced n) + %link-ref-definition (link-ref-def n) + %paragraph (paragraph n) + %table (table n) + :: ...etc + == + + ++ blank-line + |= [b=blank-line:leaf:m] + ^- tape + "\0a" + :: + ++ break + |= [b=break:leaf:m] + ^- tape + (weld (reap char-count.b char.b) "\0a") + :: + ++ heading + |= [h=heading:leaf:m] + ^- tape + ?- style.h + %atx + ;:(weld (reap level.h '#') " " (contents:inline contents.h) "\0a") + %setext + =/ line (contents:inline contents.h) + ;:(weld line "\0a" (reap (lent line) ?:(=(level.h 1) '-' '=')) "\0a") + == + :: + ++ codeblk-indent + |= [c=codeblk-indent:leaf:m] + ^- tape + %+ rash text.c + %+ cook + |= [a=(list tape)] + ^- tape + %- zing %+ turn a |=(t=tape (weld " " t)) + %- plus %+ cook snoc ;~(plug (star ;~(less (just '\0a') prn)) (just '\0a')) + :: + ++ codeblk-fenced + |= [c=codeblk-fenced:leaf:m] + ^- tape + ;: weld + (reap indent-level.c ' ') + (reap char-count.c char.c) + (trip info-string.c) + "\0a" + ^- tape %+ rash text.c + %+ cook zing %- star :: Many lines + %+ cook |= [a=tape newline=@t] :: Prepend each line with "> " + ^- tape + ;: weld + ?~(a "" (reap indent-level.c ' ')) :: If the line is blank, no indent + a + "\0a" + == + ;~ plug :: Break into lines + (star ;~(less (just '\0a') prn)) + (just '\0a') + == + (reap indent-level.c ' ') + (reap char-count.c char.c) + "\0a" + == + :: + ++ link-ref-def + |= [l=link-ref-def:leaf:m] + ^- tape + ;: weld + "[" + (trip label.l) + "]: " + (urlt:ln urlt.l) + "\0a" + == + :: + ++ table + => |% + ++ cell + |= [width=@ c=contents:inline:m] + ^- tape + =/ contents-txt (contents:inline c) + ;: weld + " " + contents-txt + (reap (sub width (add 1 (lent contents-txt))) ' ') + "|" + == + ++ row + |= [widths=(list @) cells=(list contents:inline:m)] + ^- tape + ;: weld + "|" + |- + ^- tape + ?~ widths ~ + %+ weld + (cell (head widths) (head cells)) + $(widths (tail widths), cells (tail cells)) + "\0a" + == + ++ delimiter-row + |= [widths=(list @) align=(list ?(%l %c %r %n))] + ^- tape + ;: weld + "|" + |- + ^- tape + ?~ align ~ + ;: weld + " " + ?- (head align) + %l (weld ":" (reap ;:(sub (head widths) 3) '-')) + %r (weld (reap ;:(sub (head widths) 3) '-') ":") + %c ;:(weld ":" (reap ;:(sub (head widths) 4) '-') ":") + %n (reap ;:(sub (head widths) 2) '-') + == + " |" + $(align (tail align), widths (tail widths)) + == + "\0a" + == + -- + |= [t=table:leaf:m] + ^- tape + ;: weld + (row widths.t head.t) + (delimiter-row widths.t align.t) + =/ rows rows.t + |- + ^- tape + ?~ rows ~ + %+ weld (row widths.t (head rows)) $(rows (tail rows)) + == + :: + ++ paragraph + |= [p=paragraph:leaf:m] + ^- tape + (contents:inline contents.p) + -- + :: + ++ container + => |% + ++ line + %+ cook snoc + ;~ plug + (star ;~(less (just '\0a') prn)) + (just '\0a') + == + -- + |% + ++ node + |= [n=node:container:m] + ?- -.n + %block-quote (block-quote n) + %ul (ul n) + %ol (ol n) + %tl (tl n) + == + :: + ++ block-quote + |= [b=block-quote:container:m] + ^- tape + %+ scan (markdown markdown.b) :: First, render the contents + %+ cook zing %- plus :: Many lines + %+ cook |= [a=tape newline=@t] :: Prepend each line with "> " + ^- tape + ;: weld + ">" + ?~(a "" " ") :: If the line is blank, no trailing space + a + "\0a" + == + ;~ plug :: Break into lines + (star ;~(less (just '\0a') prn)) + (just '\0a') + == + :: + ++ ul + |= [u=ul:container:m] + ^- tape + %- zing %+ turn contents.u :: Each bullet point... + |= [item=markdown:m] + ^- tape + %+ scan (markdown item) :: First, render bullet point contents + %+ cook zing + ;~ plug + %+ cook |= [a=tape] :: Prepend 1st line with indent + bullet char + ;: weld + (reap indent-level.u ' ') + (trip marker-char.u) + " " + a + == + line :: first line + %- star + %+ cook |= [a=tape] :: Subsequent lines just get indent + ?: ?|(=("" a) =("\0a" a)) a + ;: weld + (reap indent-level.u ' ') + " " :: 2 spaces, to make it even with the 1st line + a + == + line :: second and thereafter lines + == + ++ tl + |= [t=tl:container:m] + ^- tape + %- zing %+ turn contents.t :: Each bullet point... + |= [is-checked=? item=markdown:m] + ^- tape + %+ scan (markdown item) :: First, render bullet point contents + %+ cook zing + ;~ plug + %+ cook |= [a=tape] :: Prepend 1st line with indent, bullet char, checkbox + ;: weld + (reap indent-level.t ' ') + (trip marker-char.t) + " [" + ?:(is-checked "x" " ") + "] " + a + == + line :: first line + %- star + %+ cook |= [a=tape] :: Subsequent lines just get indent + ?: ?|(=("" a) =("\0a" a)) a + ;: weld + (reap indent-level.t ' ') + " " :: 2 spaces, to make it even with the 1st line + a + == + line :: second and thereafter lines + == + :: + ++ ol + |= [o=ol:container:m] + ^- tape + %- zing %+ turn contents.o :: Each item... + |= [item=markdown:m] + ^- tape + %+ scan (markdown item) :: First, render item contents + %+ cook zing + ;~ plug + %+ cook |= [a=tape] :: Prepend 1st line with indent + item number + ;: weld + (reap indent-level.o ' ') + (a-co:co start-num.o) + (trip marker-char.o) + " " + a + == + line :: first line + %- star + %+ cook |= [a=tape] :: Subsequent lines just get indent + ?: ?|(=("" a) =("\0a" a)) a + ;: weld + (reap indent-level.o ' ') + (reap (lent (a-co:co start-num.o)) ' ') + " " :: 2 spaces, to make it even with the 1st line + a + == + line :: second and thereafter lines + == + -- + :: + ++ markdown + |= [a=markdown:m] + ^- tape + %- zing %+ turn a |= [item=node:markdown:m] + ?- -.item + %leaf (node:leaf +.item) + %container (node:container +.item) + == + -- + -- + :: + :: Enserialize as Sail (manx and marl) + ++ sail-en + =< + |= [document=markdown:m] + =/ link-ref-defs (all-link-ref-definitions document) + ^- manx + ;div + ;* (~(markdown sail-en link-ref-defs) document) + == + :: + |_ [reference-links=(map @t urlt:ln:m)] + ++ inline + |% + ++ contents + |= [=contents:inline:m] + ^- marl + %+ turn contents element + ++ element + |= [e=element:inline:m] + ^- manx + ?+ -.e !! + %text (text e) + %link (link e) + %code-span (code e) + %escape (escape e) + %entity (entity e) + %strong (strong e) + %emphasis (emphasis e) + %soft-line-break (softbrk e) + %line-break (hardbrk e) + %image (image e) + %autolink (autolink e) + :: ...etc + == + ++ text + |= [t=text:inline:m] + ^- manx + [[%$ [%$ (trip text.t)] ~] ~] :: Magic; look up the structure of a `manx` if you want + ++ escape + |= [e=escape:inline:m] + ^- manx + [[%$ [%$ (trip char.e)] ~] ~] :: Magic; look up the structure of a `manx` if you want + ++ entity + |= [e=entity:inline:m] + ^- manx + =/ fulltext (crip ;:(weld "&" (trip code.e) ";")) + [[%$ [%$ `tape`[fulltext ~]] ~] ~] :: We do a little sneaky + ++ softbrk + |= [s=softbrk:inline:m] + ^- manx + (text [%text ' ']) + ++ hardbrk + |= [h=hardbrk:inline:m] + ^- manx + ;br; + ++ code + |= [c=code:inline:m] + ^- manx + ;code: {(trip text.c)} + ++ link + |= [l=link:inline:m] + ^- manx + =/ target target.l + =/ urlt ?- -.target + %direct urlt.target :: Direct link; use it + %ref :: Ref link; look it up + ~| "reflink not found: {<label.target>}" + (~(got by reference-links) label.target) + == + ;a(href (trip text.url.urlt), title (trip (fall title-text.urlt ''))) + ;* (contents contents.l) + == + ++ image + |= [i=image:inline:m] + ^- manx + =/ target target.i + =/ urlt ?- -.target + %direct urlt.target :: Direct link; use it + %ref :: Ref link; look it up + ~| "reflink not found: {<label.target>}" + (~(got by reference-links) label.target) + == + ;img(src (trip text.url.urlt), alt (trip alt-text.i)); + ++ autolink + |= [a=autolink:inline:m] + ^- manx + ;a(href (trip text.a)): {(trip text.a)} + ++ emphasis + |= [e=emphasis:inline:m] + ^- manx + ;em + ;* (contents contents.e) + == + ++ strong + |= [s=strong:inline:m] + ^- manx + ;strong + ;* (contents contents.s) + == + -- + ++ leaf + |% + ++ node + |= [n=node:leaf:m] + ^- manx + ?+ -.n !! + %blank-line (blank-line n) + %break (break n) + %heading (heading n) + %indent-codeblock (codeblk-indent n) + %fenced-codeblock (codeblk-fenced n) + %table (table n) + %paragraph (paragraph n) + %link-ref-definition (text:inline [%text ' ']) :: Link ref definitions don't render as anything + :: ...etc + == + ++ heading + |= [h=heading:leaf:m] + ^- manx + :- + :_ ~ ?+ level.h !! :: Tag and attributes; attrs are empty (~) + %1 %h1 + %2 %h2 + %3 %h3 + %4 %h4 + %5 %h5 + %6 %h6 + == + (contents:inline contents.h) + ++ blank-line + |= [b=blank-line:leaf:m] + ^- manx + (text:inline [%text ' ']) + ++ break + |= [b=break:leaf:m] + ^- manx + ;hr; + ++ codeblk-indent + |= [c=codeblk-indent:leaf:m] + ^- manx + ;pre + ;code: {(trip text.c)} + == + ++ codeblk-fenced + |= [c=codeblk-fenced:leaf:m] + ^- manx + ;pre + ;+ ?: =(info-string.c '') + ;code: {(trip text.c)} + ;code(class (weld "language-" (trip info-string.c))): {(trip text.c)} + == + ++ table + |= [t=table:leaf:m] + ^- manx + ;table + ;thead + ;tr + ;* =/ hdr head.t + =/ align align.t + |- + ?~ hdr ~ + :- ;th(align ?-((head align) %c "center", %r "right", %l "left", %n "")) + ;* (contents:inline (head hdr)) + == + $(hdr (tail hdr), align (tail align)) + + == + == + ;tbody + ;* %+ turn rows.t + |= [r=(list contents:inline:m)] + ^- manx + ;tr + ;* =/ row r + =/ align align.t + |- + ?~ row ~ + :- ;td(align ?-((head align) %c "center", %r "right", %l "left", %n "")) + ;* (contents:inline (head row)) + == + $(row (tail row), align (tail align)) + == + == + == + ++ paragraph + |= [p=paragraph:leaf:m] + ^- manx + ;p + ;* (contents:inline contents.p) + == + -- + :: + ++ container + |% + ++ node + |= [n=node:container:m] + ^- manx + ?- -.n + %block-quote (block-quote n) + %ul (ul n) + %ol (ol n) + %tl (tl n) + == + :: + ++ block-quote + |= [b=block-quote:container:m] + ^- manx + ;blockquote + ;* (~(. markdown reference-links) markdown.b) + == + :: + ++ ul + |= [u=ul:container:m] + ^- manx + ;ul + ;* %+ turn contents.u |= [a=markdown:m] + ^- manx + ;li + ;* (~(. markdown reference-links) a) + == + == + :: + ++ ol + |= [o=ol:container:m] + ^- manx + ;ol(start (a-co:co start-num.o)) + ;* %+ turn contents.o |= [a=markdown:m] + ^- manx + ;li + ;* (~(. markdown reference-links) a) + == + == + ++ tl + |= [t=tl:container:m] + ^- manx + ;ul.task-list + ;* %+ turn contents.t |= [is-checked=? a=markdown:m] + ^- manx + ;li + ;+ ?: is-checked + ;input(type "checkbox", checked "true"); + ;input(type "checkbox"); + ;* (~(. markdown reference-links) a) + == + == + -- + :: + ++ markdown + |= [a=markdown:m] + ^- marl + %+ turn a |= [item=node:markdown:m] + ?- -.item + %leaf (node:leaf +.item) + %container (node:container +.item) + == + -- +-- diff --git a/backupdesk/lib/nostr.hoon b/backupdesk/lib/nostr.hoon new file mode 100644 index 0000000..7cb719b --- /dev/null +++ b/backupdesk/lib/nostr.hoon @@ -0,0 +1,31 @@ +/- sur=nostr +/+ js=json-nostr, sr=sortug +|% +++ gen-sub-id |= eny=@ ^- @t + %- crip (scag 60 (scow:sr %uw eny)) +++ gen-keys |= eny=@ ^- keys:sur + =, secp256k1:secp:crypto + =/ privkey + |- + =/ k (~(rad og eny) (bex 256)) + ?. (lth k n.t) $ k + + =/ pubkey (priv-to-pub privkey) + =/ pub (compress-point pubkey) + :: =/ pub (serialize-point pubkey) + [pub=pub priv=privkey] +:: +++ hash-event |= raw=raw-event:sur ^- @ux + =/ jon (raw-event:en:js raw) + =/ jstring (en:json:html jon) + (swp 3 (shax jstring)) + +++ raws + |= [eny=@ bits=@] + ^- [@ @] + [- +>-]:(~(raws og eny) bits) + +++ sign-event |= [priv=@ux hash=@ux eny=@] + =^ sed eny (raws eny 256) + (sign:schnorr:secp256k1:secp:crypto priv hash sed) +-- diff --git a/backupdesk/lib/nostrill.hoon b/backupdesk/lib/nostrill.hoon new file mode 100644 index 0000000..c7283d4 --- /dev/null +++ b/backupdesk/lib/nostrill.hoon @@ -0,0 +1,54 @@ +/- post=trill-post, nsur=nostr, sur=nostrill +/+ trill=trill-post, nostr, sr=sortug +|% +:: +++ default-state |= =bowl:gall ^- state:sur + =/ s *state-0:sur + =/ l public-relays:nsur + :: =/ l ~['wss://relay.damus.io' 'wss://nos.lol'] + =/ rl %+ turn l |= t=@t [t *relay-stats:nsur] + :: =/ l ~[['wss://relay.damus.io' ~]] + =/ key (gen-keys:nostr eny.bowl) + =/ keyl [key ~] + s(relays (malt rl), keys keyl) + +++ print-relay-stats + |= rm=(map @t relay-stats:nsur) + =/ l ~(tap by rm) + |- ?~ l ~ + =/ [url=@t rs=relay-stats:nsur] i.l + ~& relay=url + ~& connected=connected.rs + ~& sub-count=~(wyt by reqs.rs) + =/ total-received + %+ roll ~(tap by reqs.rs) + |= [[* es=event-stats:nsur] acc=@ud] + %+ add acc received.es + ~& >> total=total-received + $(l t.l) + +:: +++ post-to-event |= [=keys:nsur eny=@ p=post:post] ^- event:nsur + =/ cl (latest-post-content:trill contents.p) + =/ string (crip (content-list-to-md:trill cl)) + =/ ts (to-unix-secs:jikan:sr id.p) + =/ raw=raw-event:nsur [pub.keys ts 1 ~ string] + =/ event-id (hash-event:nostr raw) + =/ signature (sign-event:nostr priv.keys event-id eny) + ~& hash-and-signed=[event-id signature] + =/ =event:nsur :* + event-id + pub.keys + created-at.raw + kind.raw + tags.raw + content.raw + signature + == + event +++ cards +|_ =bowl:gall + ++ shim-binding ^- card:agent:gall + [%pass /binding %arvo %e %connect [~ /nostr-shim] dap.bowl] + -- +-- diff --git a/backupdesk/lib/nostrill/mutations.hoon b/backupdesk/lib/nostrill/mutations.hoon new file mode 100644 index 0000000..6a27e4f --- /dev/null +++ b/backupdesk/lib/nostrill/mutations.hoon @@ -0,0 +1,203 @@ +/- sur=nostrill, nsur=nostr, + post=trill-post, gate=trill-gate, feed=trill-feed + +/+ appjs=json-nostrill, + njs=json-nostr, + postlib=trill-post, + shim, + sr=sortug + +|_ [=state:sur =bowl:gall] ++$ card card:agent:gall +++ debug-own-feed + =/ postlist (tap:orm:feed feed.state) + =/ lol + |- ?~ postlist ~ + ~& >> poast=+.i.postlist + $(postlist t.postlist) + ~ +:: TODO not a mutation but fuck it +++ get-poast |= [host=@p id=@] ^- (unit post:post) + =/ poast ?: .=(host our.bowl) + (get:orm:feed feed.state id) + ~ + poast + +:: state +++ add-to-feed |= p=post:post + =. feed.state (put:orm:feed feed.state id.p p) + state +:: events +++ process-events ^- (quip card _state) + :: =/ l events.state + :: =| cards=(list card:agent:gall) + :: |- ?~ l [cards state] + :: =/ n (event-parsing i.l) + :: $(cards -.n, state +.n, l t.l) + :: TODO + `state + +:: ++ parse-events +:: |= evs=(list event:nsur) +:: ^- (quip card _state) +:: =| cards=(list card) +:: =^ cards state +:: |- ?~ evs [cards state] +:: =^ cards state (handle-event i.evs) +:: $(evs t.evs) +:: [cards state] + +++ handle-shim-msg |= [relay=@t msg=relay-msg:nsur] + =/ rs (~(get by relays.state) relay) + ?~ rs `state + =^ cards state + ?- -.msg + %event (handle-event relay sub-id.msg event.msg) + %ok (handle-ok relay +.msg) + %eose =/ creq (~(get by reqs.u.rs) +.msg) + ?~ creq `state + =. reqs.u.rs (~(del by reqs.u.rs) +.msg) + =. relays.state (~(put by relays.state) relay u.rs) + `state + %closed =. reqs.u.rs (~(del by reqs.u.rs) sub-id.msg) + =. relays.state (~(put by relays.state) relay u.rs) + `state + %auth ~& >> auth=+.msg :: TODO handle auth challenges? + `state + %notice ~& >> notice=+.msg :: TODO pass to UI? + `state + %error ~& >>> relay-error=+.msg + =. relays.state (~(del by relays.state) relay) + `state + == + [cards state] + :: =. relays (update-relay-stats:mutat url.u.msg sub-id.u.msg) + :: =^ cards state (handle-event:mutat url.u.msg sub-id.u.msg event.u.msg) + :: :: TODO not just stash events + :: =/ relay (~(get by relays) url.u.msg) + :: =/ nevents=(list event:nsur) ?~ relay [event.u.msg ~] [event.u.msg u.relay] + :: =/ nevents2 (scag 100 nevents) + + :: =. relays (~(put by relays) url.u.msg nevents2) + :: :: TODO respond better + :: =/ response (ebail:rout id.order) + :: =/ ncards (weld cards response) + + :: [ncards this] + :: `state + +++ update-relay-stats + |= [relay=@t sub-id=@t] ^+ relays.state + =/ cur (~(get by relays.state) relay) + =/ curr ?~ cur *relay-stats:nsur u.cur + =? connected.curr ?=(%~ connected.curr) (some now.bowl) + =/ creq (~(get by reqs.curr) sub-id) + ?~ creq relays.state :: bail + =/ nreq u.creq(received +(received.u.creq)) + =. reqs.curr (~(put by reqs.curr) sub-id nreq) + (~(put by relays.state) relay curr) + +++ handle-ok |= [relay=@t event-id=@ux accepted=? msg=@t] + ^- (quip card _state) + :: TODO pass to UI + `state + + +++ handle-event + |= [relay=@t sub-id=@t =event:nsur] + ^- (quip card _state) + |^ + ~& parsing-nostr-event=kind.event +:: https://nostrdata.github.io/kinds/ + ?: .=(kind.event 666) :: one_off subs eose cf. 999 + parse-shim-oneose + ?: .=(kind.event 0) :: user metadata + parse-metadata + ?: .=(kind.event 1) :: apparently a poast + parse-poast + ?: .=(kind.event 3) :: follow list + parse-follow + :: ?: .=(kind.event 5) :: delete + ?: .=(kind.event 6) :: RT + parse-follow + ?: .=(kind.event 7) :: Reaction + parse-follow + + `state + + ++ parse-metadata + ^- (quip card _state) + =/ jstring content.event + =/ ujon (de:json:html jstring) + ?~ ujon ~& failed-parse-metadata=ujon `state + =/ umeta (user-meta:de:njs u.ujon) + ?~ umeta ~& >> failed-dejs-metadata=ujon `state + =. profiles.state (~(put by profiles.state) pubkey.event u.umeta) + `state + + + ++ parse-poast + ^- (quip card _state) + =. nostr-feed.state (put:norm:sur nostr-feed.state created-at.event event) + =/ uprof (~(get by profiles.state) pubkey.event) + ?~ uprof + =/ shimm ~(. shim [state bowl]) + =^ cards state (get-profiles:shimm (silt ~[pubkey.event])) + [cards state] + + + :: =/ fid (~(get by following.state) pubkey.event) + :: ?~ fid `state :: don't save post if we don't follow the fucker + + :: =/ cl (tokenize:postlib content.event) + + :: =/ ts (from-unix:jikan:sr created-at.event) + :: :: TODO wtf + :: =/ cm=content-map:post (init-content-map:postlib cl ts) + + :: =/ p=post:post :* + :: id=ts + :: host=`@p`pubkey.event + :: author=`@p`pubkey.event + :: thread=ts + :: parent=~ + :: children=~ + :: contents=cm + :: read=*lock:gate + :: write=*lock:gate + :: *engagement:post + :: 0v0 + :: *signature:post + :: tags=~ + :: == + :: =/ nfid (put:orm:feed u.fid ts p) + :: =. following.state (~(put by following.state) pubkey.event nfid) + `state + + + ++ parse-follow + ^- (quip card _state) + =/ following (~(get by follow-graph.state) pubkey.event) + =/ follow-set ?~ following *(set follow:sur) u.following + |- ?~ tags.event `state + =/ t=tag:nsur i.tags.event + :: ?. .=('p' key.t) $(tags.event t.tags.event) + :: =/ pubkeys value.t + :: =/ pubkey (slaw:sr %ux pubkeys) + :: ?~ pubkey ~& "parsing hex error" $(tags.event t.tags.event) + :: =/ relay (snag 0 rest.t) + :: =/ rel ?: .=(relay '') ~ (some relay) + :: =/ nickname (snag 1 rest.t) + :: =/ meta=follow:sur [u.pubkey nickname rel] + :: =. follow-set (~(put in follow-set) meta) + :: =. follow-graph.state (~(put by follow-graph.state) pubkey.event follow-set) + $(tags.event t.tags.event) + ++ parse-shim-oneose + ^- (quip card _state) + =/ rs (~(get by relays.state) relay) + ?~ rs `state + =. reqs.u.rs (~(del by reqs.u.rs) sub-id) + =. relays.state (~(put by relays.state) relay u.rs) + `state + -- +-- diff --git a/backupdesk/lib/server.hoon b/backupdesk/lib/server.hoon new file mode 100644 index 0000000..f5cf8f0 --- /dev/null +++ b/backupdesk/lib/server.hoon @@ -0,0 +1,159 @@ +=, eyre +|% ++$ request-line + $: [ext=(unit @ta) site=(list @t)] + args=(list [key=@t value=@t]) + == +:: +parse-request-line: take a cord and parse out a url +:: +++ parse-request-line + |= url=@t + ^- request-line + (fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~]) +:: +++ manx-to-octs + |= man=manx + ^- octs + (as-octt:mimes:html (en-xml:html man)) +:: +++ json-to-octs + |= jon=json + ^- octs + (as-octs:mimes:html (en:json:html jon)) +:: +++ app + |% + :: + :: +require-authorization: + :: redirect to the login page when unauthenticated + :: otherwise call handler on inbound request + :: + ++ require-authorization + |= $: =inbound-request:eyre + handler=$-(inbound-request:eyre simple-payload:http) + == + ^- simple-payload:http + :: + ?: authenticated.inbound-request + ~! this + ~! +:*handler + (handler inbound-request) + :: + =- [[307 ['location' -]~] ~] + %^ cat 3 + '/~/login?redirect=' + url.request.inbound-request + :: + :: +require-authorization-simple: + :: redirect to the login page when unauthenticated + :: otherwise pass through simple-paylod + :: + ++ require-authorization-simple + |= [=inbound-request:eyre =simple-payload:http] + ^- simple-payload:http + :: + ?: authenticated.inbound-request + ~! this + simple-payload + :: + =- [[307 ['location' -]~] ~] + %^ cat 3 + '/~/login?redirect=' + url.request.inbound-request + :: + ++ give-simple-payload + |= [eyre-id=@ta =simple-payload:http] + ^- (list card:agent:gall) + =/ header-cage + [%http-response-header !>(response-header.simple-payload)] + =/ data-cage + [%http-response-data !>(data.simple-payload)] + :~ [%give %fact ~[/http-response/[eyre-id]] header-cage] + [%give %fact ~[/http-response/[eyre-id]] data-cage] + [%give %kick ~[/http-response/[eyre-id]] ~] + == + -- +++ gen + |% + :: + ++ max-1-da ['cache-control' 'max-age=86400'] + ++ max-1-wk ['cache-control' 'max-age=604800'] + :: + ++ html-response + =| cache=? + |= =octs + ^- simple-payload:http + :_ `octs + [200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]] + :: + ++ css-response + =| cache=? + |= =octs + ^- simple-payload:http + :_ `octs + [200 [['content-type' 'text/css'] ?:(cache [max-1-wk ~] ~)]] + :: + ++ js-response + =| cache=? + |= =octs + ^- simple-payload:http + :_ `octs + [200 [['content-type' 'text/javascript'] ?:(cache [max-1-wk ~] ~)]] + :: + ++ png-response + =| cache=? + |= =octs + ^- simple-payload:http + :_ `octs + [200 [['content-type' 'image/png'] ?:(cache [max-1-wk ~] ~)]] + :: + ++ svg-response + =| cache=? + |= =octs + ^- simple-payload:http + :_ `octs + [200 [['content-type' 'image/svg+xml'] ?:(cache [max-1-wk ~] ~)]] + :: + ++ ico-response + |= =octs + ^- simple-payload:http + [[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs] + :: + ++ woff2-response + =| cache=? + |= =octs + ^- simple-payload:http + [[200 [['content-type' 'font/woff2'] max-1-wk ~]] `octs] + :: + ++ json-response + =| cache=_| + |= =json + ^- simple-payload:http + :_ `(json-to-octs json) + [200 [['content-type' 'application/json'] ?:(cache [max-1-da ~] ~)]] + :: + ++ manx-response + =| cache=_| + |= man=manx + ^- simple-payload:http + :_ `(manx-to-octs man) + [200 [['content-type' 'text/html'] ?:(cache [max-1-da ~] ~)]] + :: + ++ not-found + ^- simple-payload:http + [[404 ~] ~] + :: + ++ login-redirect + |= =request:http + ^- simple-payload:http + =- [[307 ['location' -]~] ~] + %^ cat 3 + '/~/login?redirect=' + url.request + :: + ++ redirect + |= redirect=cord + ^- simple-payload:http + [[307 ['location' redirect]~] ~] + -- +-- diff --git a/backupdesk/lib/shim.hoon b/backupdesk/lib/shim.hoon new file mode 100644 index 0000000..5cec0b0 --- /dev/null +++ b/backupdesk/lib/shim.hoon @@ -0,0 +1,88 @@ +/- sur=nostrill, nsur=nostr +/+ js=json-nostr, sr=sortug, nlib=nostr +/= web /web/router +|_ [=state:sur =bowl:gall] + ++$ card card:agent:gall +++ parse-msg + |= [eyre-id=@ta req=inbound-request:eyre] + ^- (unit [url=@ relay-msg:nsur]) + ?~ body.request.req ~ + =/ jstring q.u.body.request.req + =/ ures (de:json:html jstring) + ?~ ures ~ + (msg:de:js u.ures) +:: ++ get +:: |% +:: __ +++ get-req |= fs=(list filter:nsur) + ^- [bulk-req:shim:nsur _state] + =/ rls ~(tap by relays.state) + =| urls=(list @t) + =/ sub-id (gen-sub-id:nlib eny.bowl) + =/ =req:shim:nsur [%req sub-id fs] + |- ?~ rls [[urls req] state] + :: build http card + =/ [url=@t rs=relay-stats:nsur] i.rls + :: mutate relays stats + =/ es=event-stats:nsur [fs 0] + =/ nreqs (~(put by reqs.rs) sub-id es) + =/ nrs rs(reqs nreqs) + =. relays.state (~(put by relays.state) url nrs) + $(urls [url urls], rls t.rls) + +++ get-posts + ^- (quip card _state) + =/ kinds (silt ~[1]) + =/ last-week (sub now.bowl ~d7) + :: =/ since (to-unix-secs:jikan:sr last-week) + =/ =filter:nsur [~ ~ `kinds ~ `last-week ~ ~] + =^ req=bulk-req:shim:nsur state (get-req ~[filter]) + :- :~((send req)) state + +++ get-profiles + |= pubkeys=(set @ux) + ^- (quip card _state) + =/ kinds (silt ~[0]) + =/ =filter:nsur [~ `pubkeys `kinds ~ ~ ~ ~] + =^ req=bulk-req:shim:nsur state (get-req ~[filter]) + :- :~((send req)) state + +++ get-engagement + |= post-ids=(set @ux) + ^- (quip card _state) + =/ post-strings %- ~(run in post-ids) |= id=@ux (crip (scow:sr %ux id)) + =/ =filter:nsur + =/ kinds (silt ~[6 7]) + =/ tags (malt :~([%e post-strings])) + [~ ~ `kinds `tags ~ ~ ~] + =^ req state (get-req ~[filter]) + :- :~((send req)) state + +++ get-quotes + |= post-id=@ux + ^- (quip card _state) + =/ post-string (crip (scow:sr %ux post-id)) + =/ kinds (silt ~[1]) + =/ tags (malt :~([%q (silt ~[post-string])])) + =/ =filter:nsur [~ ~ `kinds `tags ~ ~ ~] + =^ req state (get-req ~[filter]) + :- :~((send req)) state + + +++ send + |= req=bulk-req:shim:nsur ^- card:agent:gall + =/ req-body (bulk-req:en:js req) + :: ~& shim-req-json=(en:json:html req-body) + =/ headers :~ + [key='content-type' value='application/json'] + == + =/ =request:http [%'POST' url:shim:nsur headers `(json-body:web req-body)] + =/ pat /shim + [%pass (weld /ws pat) %arvo %k %fard dap.bowl %fetch %noun !>(request)] +:: +:: +:: + + +-- diff --git a/backupdesk/lib/sortug.hoon b/backupdesk/lib/sortug.hoon new file mode 100644 index 0000000..e1006b1 --- /dev/null +++ b/backupdesk/lib/sortug.hoon @@ -0,0 +1,145 @@ +:: Painstakingly built utility functions by Sortug Development Ltd. +:: There's more where it came from +|% +++ jikan +|% +++ from-unix |= ts=@ ^- @da + (from-unix:chrono:userlib ts) +++ to-unix-ms |= da=@da ^- @ud + (unm:chrono:userlib da) +++ to-unix-secs |= da=@da ^- @ud + (unt:chrono:userlib da) +-- +++ 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 ~ + %ud (rush txt dem) + %ux (rush txt b16) + %uv (rush txt vum:ag) + %uw (rush txt b64) + == +++ csplit |* =rule + (more rule (cook crip (star ;~(less rule next)))) +:: List utils +++ foldi + |* [a=(list) b=* c=_|=(^ +<+)] + =| i=@ud + |- ^+ b + ?~ 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) + -- +++ string +|% +++ replace + |= [bit=tape bot=tape =tape] + ^- ^tape + |- + =/ off (find bit tape) + ?~ off tape + =/ clr (oust [(need off) (lent bit)] tape) + $(tape :(weld (scag (need off) clr) bot (slag (need off) clr))) + :: +++ split + |= [str=tape delim=tape] + ^- (list tape) + (split-rule str (jest (crip delim))) + ++ split-rule + |* [str=tape delim=rule] + ^- (list tape) + %+ fall + (rust str (more delim (star ;~(less delim next)))) + [str ~] +-- +-- diff --git a/backupdesk/lib/strand.hoon b/backupdesk/lib/strand.hoon new file mode 100644 index 0000000..b0db35b --- /dev/null +++ b/backupdesk/lib/strand.hoon @@ -0,0 +1 @@ +rand diff --git a/backupdesk/lib/strandio.hoon b/backupdesk/lib/strandio.hoon new file mode 100644 index 0000000..48f6e0d --- /dev/null +++ b/backupdesk/lib/strandio.hoon @@ -0,0 +1,965 @@ +/- 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-whey + |= =wire + =/ m (strand ,[spar:ames fragment-size=@ud num-fragments=@ud]) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + :: + [~ %sign * %ames %sage sage=*] + ?. =(wire wire.u.in.tin) + `[%skip ~] + =/ =sage:mess:ames sage.sign-arvo.u.in.tin + :^ ~ %done spar=p.sage + ?~ q.sage + [boq=13 tot=0] + =< [boq tot] + ;;([%whey boq=@ud tot=@ud] q.sage) + == +:: +++ take-sage + |= =wire + =/ m (strand ,sage:mess:ames) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + :: + [~ %sign * %ames %sage sage=*] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done sage.sign-arvo.u.in.tin] + == +:: +++ take-message + => |% +$ out $% [%sage sage:mess:ames] + [%tune spar:ames (unit roar:ames)] + [%page spar:ames (unit (unit page))] + == + -- + |= =wire + =/ m (strand ,out) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + :: + [~ %sign * %ames %sage sage=*] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done %sage sage.sign-arvo.u.in.tin] + :: + [~ %sign * %ames %tune ^ *] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done %tune +>.sign-arvo.u.in.tin] + :: + [~ %sign * %ames %near ^ *] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done %page +>.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) +:: +++ mass + =/ m (strand ,(list quac:dill)) + ^- form:m + =/ =card:agent:gall [%pass /mass %arvo %d %mass ~] + ;< ~ bind:m (send-raw-card card) + ;< quz=(list quac:dill) bind:m take-meme + (pure:m quz) +:: +++ take-meme + =/ m (strand ,(list quac:dill)) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %sign [%mass ~] %dill %meme *] + `[%done p.sign-arvo.u.in.tin] + == +:: +++ keen + |= [=wire =spar:ames sec=(unit [@ @])] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %arvo %a %keen sec spar) +:: +++ chum + |= [=wire =spar:ames] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %arvo %a %chum spar) +:: +++ keen-shut + |= [=wire =spar:ames] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %keen & spar) +:: +++ yawn + |= [=wire =spar:ames] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %arvo %a %yawn spar) +:: +++ whey + |= [=wire boq=@ud =spar:ames] + =/ m (strand ,~) + ^- form:m + :: encrypted using %chum namespace + :: + ;< our=@p bind:m get-our + =. path.spar + [%a %x '1' %$ %whey (scot %ud boq) (scot %p our) path.spar] + (chum wire spar) +:: +++ meta + |= [=wire =spar:ames] + =/ m (strand ,~) + ^- form:m + ?+ path.spar !! + $% [%ames bone=@ ?(%clos %cork %next %last %curr) ~] + [%flow bone=@ =dire:ames ~] + [%flow bone=@ =dire:ames ?(%clos %cork %line %lods %next %last) ~] + :: XX rewrite in terms of %whey namespace + :: + [%flow bone=@ =dire:ames %whey boq=@ ~] + [%flow bone=@ =dire:ames seq=@ %naxp ~] + == + :: encrypted using %chum namespace + :: + ;< our=@p bind:m get-our + %- send-raw-card + :* %pass wire %arvo %a %chum + spar(path [%a %x '1' %$ %meta (scot %p our) path.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)) +:: +++ list-desk + |= [[=ship =desk =case] =spur] + =* arg +< + =/ m (strand arch) + ;< =riot:clay bind:m (warp ship desk ~ %sing %y case spur) + ?~ riot + (strand-fail %list-desk >arg< ~) + (pure:m !<(arch 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.cage)) + == +-- diff --git a/backupdesk/lib/trill/post.hoon b/backupdesk/lib/trill/post.hoon new file mode 100644 index 0000000..5bed037 --- /dev/null +++ b/backupdesk/lib/trill/post.hoon @@ -0,0 +1,377 @@ +/- tp=trill-post, md=markdown +/+ sr=sortug, mdlib=markdown +|% +++ build-sp + |= [host=@p author=@p input=@t] + ^- sent-post:tp + =/ cl (tokenise input) + ~| "parsing error!!" + ?: ?=(%| -.cl) !! + =| sp=sent-post:tp + %= sp + host host + author author + contents +.cl + == +++ build-post + |= [now=@da pubkey=@ux sp=sent-post:tp] + ^- post:tp + =/ cm (init-content-map contents.sp now) + =/ thread ?~ thread.sp now u.thread.sp + =/ =post:tp + :* id=now + host.sp + author.sp + thread + parent.sp + ~ + cm + read.sp + write.sp + *engagement:tp + `@uvH`pubkey + *signature:tp + ~ + == + post +:: 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 [%link (de-target target.inl) (de-target target.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 [%paragraph ~] + == +++ de-list |= lmd=(list markdown:md) ^- (list inline:tp) +:: TODO +~ + :: =| res=(list li:tp) + :: |- ?~ lmd (flop res) + :: =/ nodelist i.lmd + :: =/ blocks=(list block:tp) + :: %+ 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) + +++ parse :: Markdown parser. Actually udon parser but it'll do + |= s=tape ^- (unit marl:hoot) :: finally + :: Annoying it requires a line break but then parses it as a space wtf + =, vast + (rust s cram:(sail .y)) +++ tokenize +|= s=@t ^- content-list:tp + =/ t (weld (trip s) "\0a") + =/ parsed (parse t) + :: =/ parsed2 (parse:md t) + :: ~& > diary-parser=parsed2 + :: \0a can't be followed by a space. ever. those are the rules + ?~ parsed ~& error-parsing-markdown=t ~ + (marl-to-cl u.parsed) +++ marl-to-cl +|= =marl:hoot ^- content-list:tp + %- flop + %+ roll marl + |= [=tuna:hoot acc=content-list:tp] + :: man this is an annoying type if I ever saw one + ?@ -.tuna acc + =/ blk (manx-to-block tuna) + ?~ blk acc :_ acc u.blk +++ manx-to-block + |= =manx:hoot ^- (unit block:tp) + ?+ n.g.manx ~ + :: TODO + :: heading %- some [%heading (phead n.g.manx c.manx)] + %p %- some [%paragraph (inline-list c.manx)] + %blockquote %- some [%blockquote (inline-list c.manx)] + %pre %- some [%codeblock (pre c.manx)] + %hr %- some [%paragraph ~[[%break ~]]] + %ul %- some [%list (inline-list c.manx) .n] + %ol %- some [%list (inline-list c.manx) .y] + :: %table %- some (table-rows c.manx) + == +:: ++ list-items +:: |= =marl:hoot ^- (list li:tp) +:: %- flop +:: %+ roll marl |= [=tuna:hoot acc=(list li:tp)] +:: ?@ -.tuna acc +:: ?. ?=(%li n.g.tuna) acc :_ acc (marl-to-cl c.tuna) +:: ++ phead +:: |= [h=heading c=marl:hoot] ^- [p=cord q=heading] +:: :- (get-tag-text c) h +++ inline-list + |= c=marl:hoot ^- (list inline:tp) + %- flop + %+ roll c + |= [=tuna:hoot acc=(list inline:tp)] + ?@ -.tuna acc :_ acc (inline tuna) + ++ inline + |= =manx:hoot ^- inline:tp + ?: ?=(%$ n.g.manx) [%text (get-attrs-text a.g.manx)] + =/ text=@t (get-tag-text c.manx) + ?+ n.g.manx [%text text] + %i [%italic text] + %b [%bold text] + %code [%codespan text] + %br [%break ~] + %a :+ %link (get-attrs-text a.g.manx) (get-tag-text c.manx) + %img :+ %link (get-attr-text a.g.manx %src) (get-attr-text a.g.manx %alt) + == +:: +++ reduce-block +|= c=marl:hoot ^- @t + %+ roll c + |= [=tuna:hoot acc=@t] + ?@ -.tuna acc + ?+ n.g.tuna acc + %p (get-tag-text c.tuna) + == +++ get-attr-text +|= [a=mart:hoot attr=@tas] ^- @t + %- crip %- flop + %+ roll a + |= [[n=mane v=(list beer:hoot)] acc=tape] + ?. .=(attr n) acc + %+ roll v + |= [b=beer:hoot acc=tape] + ?^ b acc [b acc] +++ get-attrs-text :: this assumes we don't care about which attr, which we usually don't +|= a=mart:hoot ^- @t + :: ?: (gte (lent a) 1) + %- crip %- flop + %+ roll a + |= [[n=mane v=(list beer:hoot)] acc=tape] + %+ roll v + |= [b=beer:hoot acc=tape] + ?^ b acc [b acc] +++ get-tag-text +|= c=marl:hoot ^- @t +:: there's only really one child in these things + %+ roll c + |= [=tuna:hoot acc=@t] + ?@ -.tuna acc + %- crip + %- flop + %+ roll a.g.tuna + |= [[n=mane v=(list beer:hoot)] acc=tape] + %+ roll v + |= [b=beer:hoot acc=tape] + ?^ b acc [b acc] + +++ pre + |= c=marl:hoot ^- [cord cord] + :_ '' :: lang not supported, duh + %+ roll c + |= [=tuna:hoot acc=@t] + ?@ -.tuna acc + (get-attrs-text a.g.tuna) + +++ parse-tags +|= t=@t ^- (unit (set @t)) + =/ lst (rush t (csplit:sr com)) + ?~ lst ~ (some (sy u.lst)) +:: post:trill -> (markdown) tape for display on sail +++ block-to-md +|= b=block:tp ^- tape + ?+ -.b "" +%paragraph + %^ foldi:sr p.b "" |= [in=@ud i=inline:tp acc=tape] + =/ il (inline-to-tape i) + ?: .=(+(in) (lent p.b)) + "{acc}{il}" + "{acc}{il} " +%blockquote + %+ weld "> " + %^ foldi:sr p.b "" |= [in=@ud i=inline:tp acc=tape] + =/ il (inline-to-tape i) + ?: .=(+(in) (lent p.b)) + "{acc}{il}" + "{acc}{il} " +%list + %^ foldi:sr p.b "" |= [in=@ud i=inline:tp acc=tape] + =/ li-tape (inline-to-tape i) + =/ line ?: ordered.b + "{<+(in)>}. {li-tape}" + "- {li-tape}" + ?: .=(+(in) (lent p.b)) + "{acc}{line}" + "{acc}{line}\0a" +%media + ?+ -.media.b "})" + :: TODO +%images + :: %^ foldi:sr p.media.b "" |= [i=@ud [url=@t caption=@t] acc=tape] + :: =/ line "})" + :: ?: .=(+(i) (lent p.media.b)) + :: "{acc}{line}" + :: "{acc}{line}\0a" + "" + == +%codeblock + """ + ``` + {(trip code.b)} + ``` + """ +%heading =/ dashes=tape ?- q.b + %h1 "# " + %h2 "## " + %h3 "### " + %h4 "#### " + %h5 "##### " + %h6 "###### " + == "{dashes}{(trip p.b)}" +:: %tasklist "" ::TODO + :: + :: %table acc + :: %eval acc + :: %ref acc + :: %json acc + == +++ latest-post-content +|= cm=content-map:tp ^- content-list:tp + =/ last (pry:corm:tp cm) + ?~ last ~ + +.u.last + +++ content-list-to-md +|= =content-list:tp ^- tape + %^ foldi:sr content-list "" |= [i=@ud b=block:tp acc=tape] + =/ block-tape (block-to-md b) + ?: .=(+(i) (lent content-list)) + "{acc}{block-tape}" + "{acc}{block-tape}\0a\0a" +++ inline-to-tape +|= i=inline:tp ^- tape + ?+ -.i "" + %text (trip p.i) + %italic "_{(trip p.i)}_" + %bold "*{(trip p.i)}*" + %strike "~~{(trip p.i)}~~" + %ship (scow %p p.i) + %codespan "`{(trip p.i)}`" + %link "[{(trip show.i)}]({(trip href.i)})" + :: %img "})" + %break "\0a" + == +++ tags-to-tape +|= t=(set @t) ^- tape + %^ foldi:sr ~(tap in t) "" |= [i=@ud c=@t acc=tape] + ?: .=(+(i) ~(wyt in t)) + "{acc}{(trip c)}" + "{acc}{(trip c)}," + +++ init-content-map |= [cl=content-list:tp date=@da] ^- content-map:tp + (put:corm:tp *content-map:tp date cl) + +-- |