mirror of
https://github.com/urbit/shrub.git
synced 2024-12-30 15:44:03 +03:00
34b9c445e3
Front-end work necessitates images being mounted, and the tile served on Landscape. This commit adds it to link-server-hook.
358 lines
9.3 KiB
Plaintext
358 lines
9.3 KiB
Plaintext
:: link-server: accessing link-store via eyre
|
|
::
|
|
:: only accepts requests authenticated as the host ship.
|
|
::
|
|
:: GET requests:
|
|
:: /~link/local-pages/[some-path].json?p=0
|
|
:: our submissions on path, with optional pagination
|
|
::
|
|
:: POST requests:
|
|
:: /~link/add/[some-path]
|
|
:: send {title url} json, will save link at path
|
|
::
|
|
/+ *link, *server, default-agent, verb
|
|
::
|
|
|%
|
|
+$ state-0
|
|
$: %0
|
|
~
|
|
::NOTE this means we could get away with just producing cards everywhere,
|
|
:: never producing new state outside of the agent interface core.
|
|
:: we opt to keep ^-(quip card _state) in place for most logic arms
|
|
:: because it doesn't cost much, results in unsurprising code, and
|
|
:: makes adding any state in the future easier.
|
|
==
|
|
::
|
|
+$ card card:agent:gall
|
|
--
|
|
::
|
|
=| state-0
|
|
=* state -
|
|
::
|
|
%+ verb |
|
|
^- agent:gall
|
|
=<
|
|
|_ =bowl:gall
|
|
+* this .
|
|
do ~(. +> bowl)
|
|
def ~(. (default-agent this %|) bowl)
|
|
::
|
|
++ on-init
|
|
^- (quip card _this)
|
|
:- [start-serving:do launch-tile:do ~]
|
|
this
|
|
::
|
|
++ on-save !>(state)
|
|
++ on-load
|
|
|= old=vase
|
|
^- (quip card _this)
|
|
[~ this(state !<(state-0 old))]
|
|
::
|
|
++ on-watch
|
|
|= =path
|
|
^- (quip card _this)
|
|
?: ?=([%http-response *] path)
|
|
[~ this]
|
|
?: =(/primary path)
|
|
[~ this]
|
|
(on-watch:def path)
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
?. ?=(%handle-http-request mark)
|
|
(on-poke:def mark vase)
|
|
:_ this
|
|
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
|
|
(handle-http-request:do eyre-id inbound-request)
|
|
::
|
|
++ on-arvo
|
|
|= [=wire =sign-arvo]
|
|
^- (quip card _this)
|
|
?. ?=(%bound +<.sign-arvo)
|
|
(on-arvo:def wire sign-arvo)
|
|
[~ this]
|
|
::
|
|
++ on-agent
|
|
|= [=wire =sign:agent:gall]
|
|
^- (quip card _this)
|
|
?. ?=(%poke-ack -.sign)
|
|
(on-agent:def wire sign)
|
|
?~ p.sign [~ this]
|
|
=/ =tank
|
|
leaf+"{(trip dap.bowl)} failed writing to %link-store"
|
|
%- (slog tank u.p.sign)
|
|
[~ this]
|
|
::
|
|
++ on-peek on-peek:def
|
|
++ on-leave on-leave:def
|
|
++ on-fail on-fail:def
|
|
--
|
|
::
|
|
|_ =bowl:gall
|
|
::
|
|
++ start-serving
|
|
^- card
|
|
[%pass / %arvo %e %connect [~ /'~link'] dap.bowl]
|
|
::
|
|
++ launch-tile
|
|
^- card
|
|
(launch-poke [%link-server-hook /primary '/~link/js/tile.js'])
|
|
::
|
|
::
|
|
++ launch-poke
|
|
|= act=[@tas path @t]
|
|
^- card
|
|
[%pass / %agent [our.bowl %launch] %poke %launch-action !>(act)]
|
|
::
|
|
++ do-action
|
|
|= =action
|
|
^- card
|
|
[%pass / %agent [our.bowl %link-store] %poke %link-action !>(action)]
|
|
::
|
|
++ do-save
|
|
|= [=path title=@t =url]
|
|
^- card
|
|
(do-action %save path title url)
|
|
::
|
|
++ do-note
|
|
|= [=path =url udon=@t]
|
|
^- card
|
|
(do-action %note path url udon)
|
|
::
|
|
++ handle-http-request
|
|
|= [eyre-id=@ta =inbound-request:eyre]
|
|
^- (list card)
|
|
::NOTE we don't use +require-authorization because it's too restrictive
|
|
:: on the flow we want here.
|
|
::
|
|
?. ?& authenticated.inbound-request
|
|
=(src.bowl our.bowl)
|
|
==
|
|
(give-simple-payload:app eyre-id [[403 ~] ~])
|
|
:: request-line: parsed url + params
|
|
::
|
|
=/ =request-line
|
|
%- parse-request-line
|
|
url.request.inbound-request
|
|
=* req-head header-list.request.inbound-request
|
|
=; [cards=(list card) =simple-payload:http]
|
|
%+ weld cards
|
|
(give-simple-payload:app eyre-id simple-payload)
|
|
?+ method.request.inbound-request [~ not-found:gen]
|
|
%'OPTIONS'
|
|
[~ (include-cors-headers req-head [[200 ~] ~])]
|
|
::
|
|
%'GET'
|
|
[~ (handle-get req-head request-line)]
|
|
::
|
|
%'POST'
|
|
(handle-post req-head request-line body.request.inbound-request)
|
|
==
|
|
::
|
|
++ handle-post
|
|
|= [request-headers=header-list:http =request-line body=(unit octs)]
|
|
^- [(list card) simple-payload:http]
|
|
=; [success=? cards=(list card)]
|
|
:- cards
|
|
%+ include-cors-headers
|
|
request-headers
|
|
::TODO it would be more correct to wait for the %poke-ack instead of
|
|
:: sending this response right away... but link-store pokes can't
|
|
:: actually fail right now, so it's fine.
|
|
[[?:(success 200 400) ~] `*octs]
|
|
?~ body [| ~]
|
|
=/ jon=(unit json) (de-json:html q.u.body)
|
|
?~ jon [| ~]
|
|
?+ request-line [| ~]
|
|
[[~ [%'~link' %save ~]] ~]
|
|
^- [? (list card)]
|
|
=/ page=(unit [=path title=@t =url])
|
|
%. u.jon
|
|
=, dejs-soft:format
|
|
=+ (su ;~(pfix net (more net urs:ab)))
|
|
(ot path+- title+so url+so ~)
|
|
?~ page [| ~]
|
|
[& [(do-save u.page) ~]]
|
|
::
|
|
[[~ [%'~link' %note ~]] ~]
|
|
^- [? (list card)]
|
|
=/ note=(unit [=path =url udon=@t])
|
|
%. u.jon
|
|
=, dejs-soft:format
|
|
=+ (su ;~(pfix net (more net urs:ab)))
|
|
(ot path+- url+so udon+so ~)
|
|
?~ note [| ~]
|
|
[& [(do-note u.note) ~]]
|
|
==
|
|
::
|
|
++ handle-get
|
|
|= [request-headers=header-list:http =request-line]
|
|
:: if we request base path, return index.html
|
|
::
|
|
?: ?=([[~ [%'~link' ~]] *] request-line)
|
|
$(request-line request-line(ext `%html, site [%'~link' /index]))
|
|
%+ include-cors-headers
|
|
request-headers
|
|
^- simple-payload:http
|
|
:: args: map of params
|
|
:: p: pagination index
|
|
::
|
|
=/ args
|
|
%- ~(gas by *(map @t @t))
|
|
args.request-line
|
|
=/ p=(unit @ud)
|
|
%+ biff (~(get by args) 'p')
|
|
(curr rush dim:ag)
|
|
?+ request-line
|
|
:: for the default case, try to load file from clay
|
|
::
|
|
?~ ext.request-line
|
|
:: for extension-less requests, always just serve the index.html.
|
|
:: that way the js can load and figure out how to deal with that route.
|
|
::
|
|
$(request-line [[`%html ~[%'~link' 'index']] args.request-line])
|
|
=/ file=(unit octs)
|
|
?. ?=([%'~link' *] site.request-line) ~
|
|
(get-file-at /app/link [t.site u.ext]:request-line)
|
|
?~ file not-found:gen
|
|
?+ u.ext.request-line not-found:gen
|
|
%html (html-response:gen u.file)
|
|
%js (js-response:gen u.file)
|
|
%css (css-response:gen u.file)
|
|
%png (png-response:gen u.file)
|
|
==
|
|
:: submissions by recency as json, including comment counts
|
|
::
|
|
[[[~ %json] [%'~link' %submissions ^]] *]
|
|
%- json-response:gen
|
|
%- json-to-octs ::TODO include in +json-response:gen
|
|
%+ page-to-json
|
|
(get-submissions t.t.site.request-line p)
|
|
|= [=submission comments=@ud]
|
|
^- json
|
|
=+ s=(submission:en-json submission)
|
|
?> ?=([%o *] s)
|
|
o+(~(put by p.s) 'commentCount' (numb:enjs:format comments))
|
|
:: local links by recency as json
|
|
::
|
|
[[[~ %json] [%'~link' %local-pages ^]] *]
|
|
%- json-response:gen
|
|
%- json-to-octs ::TODO include in +json-response:gen
|
|
%+ page-to-json
|
|
(get-local-pages t.t.site.request-line p)
|
|
page:en-json
|
|
:: comments by recency as json
|
|
::
|
|
[[[~ %json] [%'~link' %discussions @ ^]] *]
|
|
%- json-response:gen
|
|
%- json-to-octs ::TODO include in +json-response:gen
|
|
%+ page-to-json
|
|
(get-discussions t.t.site.request-line p)
|
|
comment:en-json
|
|
==
|
|
::
|
|
++ include-cors-headers
|
|
|= [request-headers=header-list:http =simple-payload:http]
|
|
^+ simple-payload
|
|
=* out-heads headers.response-header.simple-payload
|
|
=; =header-list:http
|
|
|-
|
|
?~ header-list simple-payload
|
|
=* new-head i.header-list
|
|
=. out-heads
|
|
(set-header:http key.new-head value.new-head out-heads)
|
|
$(header-list t.header-list)
|
|
=/ origin=@t
|
|
=/ headers=(map @t @t)
|
|
(~(gas by *(map @t @t)) request-headers)
|
|
(~(gut by headers) 'origin' '*')
|
|
:~ 'Access-Control-Allow-Origin'^origin
|
|
'Access-Control-Allow-Credentials'^'true'
|
|
'Access-Control-Request-Method'^'OPTIONS, GET, POST'
|
|
'Access-Control-Allow-Methods'^'OPTIONS, GET, POST'
|
|
'Access-Control-Allow-Headers'^'content-type'
|
|
==
|
|
::
|
|
++ page-size 25
|
|
++ get-paginated
|
|
|* [l=(list) p=(unit @ud)]
|
|
^- [total=@ud pages=@ud page=_l]
|
|
:+ (lent l)
|
|
+((div (lent l) page-size))
|
|
?~ p l
|
|
%+ scag page-size
|
|
%+ slag (mul u.p page-size)
|
|
l
|
|
::
|
|
++ page-to-json
|
|
=, enjs:format
|
|
|* $: [total-items=@ud total-pages=@ud page=(list)]
|
|
item-to-json=$-(* json)
|
|
==
|
|
^- json
|
|
%- pairs
|
|
:~ 'total-items'^(numb total-items)
|
|
'total-pages'^(numb total-pages)
|
|
'page'^a+(turn page item-to-json)
|
|
==
|
|
::
|
|
++ get-submissions
|
|
|= [=path p=(unit @ud)]
|
|
^- [@ud @ud (list [submission comments=@ud])]
|
|
=- (get-paginated - p)
|
|
%+ turn
|
|
%+ scry-for submissions
|
|
[%submissions path]
|
|
|= =submission
|
|
:- submission
|
|
%- lent
|
|
%+ scry-for comments
|
|
:- %discussions
|
|
%+ snoc path
|
|
%- crip
|
|
(en-base64:mimes:html url.submission)
|
|
::
|
|
++ get-local-pages
|
|
|= [=path p=(unit @ud)]
|
|
^- [@ud @ud pages]
|
|
=- (get-paginated - p)
|
|
%+ scry-for pages
|
|
[%local-pages path]
|
|
::
|
|
++ get-discussions
|
|
|= [=path p=(unit @ud)]
|
|
^- [@ud @ud comments]
|
|
=- (get-paginated - p)
|
|
%+ scry-for comments
|
|
[%discussions path]
|
|
::
|
|
++ get-file-at
|
|
|= [base=path file=path ext=@ta]
|
|
^- (unit octs)
|
|
:: only expose html, css and js files for now
|
|
::
|
|
?. ?=(?(%html %css %js %png) ext)
|
|
~
|
|
=/ =path
|
|
:* (scot %p our.bowl)
|
|
q.byk.bowl
|
|
(scot %da now.bowl)
|
|
(snoc (weld base file) ext)
|
|
==
|
|
?. .^(? %cu path)
|
|
~
|
|
%- some
|
|
%- as-octs:mimes:html
|
|
.^(@ %cx path)
|
|
::
|
|
++ scry-for
|
|
|* [=mold =path]
|
|
.^ mold
|
|
%gx
|
|
(scot %p our.bowl)
|
|
%link-store
|
|
(scot %da now.bowl)
|
|
(snoc `^path`path %noun)
|
|
==
|
|
-- |