blob: 424b44ef63a12ed16d91f394089cc3c66b639807 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
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>}"
==
==
--
|
