286 lines
9.5 KiB
Plaintext
286 lines
9.5 KiB
Plaintext
|
:: 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] ~]
|
||
|
|
==
|
||
|
|
--
|