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