diff options
Diffstat (limited to 'desk/web/oldrouter.hoon')
| -rw-r--r-- | desk/web/oldrouter.hoon | 130 |
1 files changed, 130 insertions, 0 deletions
diff --git a/desk/web/oldrouter.hoon b/desk/web/oldrouter.hoon new file mode 100644 index 0000000..424b44e --- /dev/null +++ b/desk/web/oldrouter.hoon @@ -0,0 +1,130 @@ +/- tp=trill-post +/+ *server, sortug, lib=boke, ui=trill-ui +/= index /web/index +/= post-header /web/components/post-header +/= post-content /web/components/post-text +/= welcome /web/components/welcome +/= post-list /web/components/post-list +|_ =bowl:gall ++$ state +$: %0 + =feed:tp + paths=(map path post:tp) +== ++$ ret [(list card:agent:gall) state] ++$ order [eyre-id=@ta req=inbound-request:eyre] ++$ payloads [p=(list card:agent:gall) q=simple-payload:http] ++$ comment-req [text=@t thread=@da parent=@da author=@p] ++$ new-post [title=@t text=@t author=@p] +++ r +|= [=order =state] ^- ret +~& >> http-req=order +=/ met method.request.req.order +=/ req-line (parse-request-line url.request.req.order) +=/ pth=path :- met site.req-line +~& >>> path=`(list @tas)`pth +=/ pl=[payloads _state] +?+ pth :_ state (serve-404 req-line) + [%'GET' ~ ~] :_ state (serve-index req-line) :: "/" + [%'GET' @ @ @ @ *] :_ state (serve-post site.req-line) + [%'POST' *] (handle-post req-line body.request.req.order state) + :: [%get %blog *] serve-blog + :: [%get 'chat' *] serve-chat + :: [%get 'forum' *] serve-forum + :: [%get 'about' *] serve-about +== +:_ +.pl +%+ weld p.-.pl +%+ give-simple-payload:app eyre-id.order q.-.pl + + +:: TODO send the whole request instead of the req-line +++ serve-index +|= rl=request-line ^- payloads +=/ poasts ;; (list full-node:tp) (retrieve:sortug /index bowl) +:- ~ +%- html-response:gen +(index (welcome src.bowl) (post-list poasts) bowl) +++ serve-post +|= =path ^- payloads +=/ pst ;; full-node:tp (retrieve:sortug (weld /post path) bowl) +=/ post-show ~(. post-content pst src.bowl) +:- ~ +%- html-response:gen +(index (post-header pst) html:post-show bowl) +++ handle-post +|= [rl=request-line body=(unit octs) =state] ^- [payloads _state] +?+ site.rl :_ state (serve-error 404) + [%poast ~] :_ state (serve-error 404) + [%comment ~] (handle-comment body state) +== +++ handle-comment +|= [body=(unit octs) =state] ^- [payloads _state] +=/ cr=(unit comment-req) (parse-comment body) +?~ cr :_ state (serve-error 500) :: TODO not quite but anyway +~& > cr=cr +=/ blog-post (get:orm:tp feed.state thread.u.cr) +?~ blog-post :_ state (serve-error 404) +=/ parent (get:orm:tp feed.state parent.u.cr) +?~ parent :_ state (serve-error 404) +=/ new-post *post:tp +=/ comment-id now.bowl +=/ content-list (tokenize:ui text.u.cr) +?~ content-list [(serve-error 505) state] +=/ contents (gas:corm:tp *content-map:tp ~[[now.bowl content-list]]) +=/ p %= new-post +id comment-id +host our.bowl +author ship+author.u.cr +thread thread.u.cr +parent `parent.u.cr +contents contents +== +~& > p=p +=/ nc (~(put in children.u.parent) comment-id) +=/ npar u.parent(children nc) +=/ nf (put:orm:tp feed.state comment-id p) +=/ nff (put:orm:tp nf id.npar npar) +=/ ns state(feed nff) +=/ url %- crip "{(trip (spat path.u.blog-post))}#comment{<`@`comment-id>}" +~& >>> redirect-url=url :: redirect:gen doesn't change the method wtf +:_ ns `(redirect url) +++ redirect + |= redirect=cord + ^- simple-payload:http + [[303 ['location' redirect]~] ~] +++ parse-comment +|= body=(unit octs) +=/ kvm (handle-html-form:sortug body) +=/ comment (~(get by kvm) 'comment') +?~ comment ~ +=/ thread (~(get by kvm) 'thread') +?~ thread ~ +=/ parent (~(get by kvm) 'parent') +?~ parent ~ +=/ author (~(get by kvm) 'author') +?~ author ~ +=/ t (slaw %ud u.thread) +?~ t ~ +=/ p (slaw %ud u.parent) +?~ p ~ +=/ a (slaw %p u.author) +?~ a ~ +`:*(u.comment u.t u.p u.a) +++ serve-404 +|= =request-line +(serve-error 404) +++ serve-error +|= code=@ud +^- payloads +:- ~ +%- html-response:gen +%- as-octs:mimes:html +%- crip +%- en-xml:html +;html + ;body + ;p:"Error {<code>}" + == +== +-- |