1 USING: tools.test http furnace.sessions furnace.actions
\r
2 http.server http.server.responses math namespaces make kernel
\r
3 accessors io.sockets io.servers prettyprint
\r
4 io.streams.string io.files io.files.temp io.directories
\r
5 splitting destructors sequences db db.tuples db.sqlite
\r
6 continuations urls math.parser furnace furnace.utilities ;
\r
7 IN: furnace.sessions.tests
\r
9 : with-session ( session quot -- )
\r
11 [ [ save-session-after ] [ session set ] bi ] dip call
\r
12 ] with-destructors ; inline
\r
18 M: foo init-session* drop 0 "x" sset ;
\r
20 M: foo call-responder*
\r
23 "x" sget number>string "text/html" <content> ;
\r
25 : url-responder-mock-test ( -- string )
\r
30 "id" get session-id-key set-query-param
\r
33 { } sessions get call-responder
\r
34 [ write-response-body drop ] with-string-writer
\r
35 ] with-destructors ;
\r
37 : sessions-mock-test ( -- string )
\r
41 "cookies" get >>cookies
\r
42 dup url>> "/" >>path drop
\r
44 { } sessions get call-responder
\r
45 [ write-response-body drop ] with-string-writer
\r
46 ] with-destructors ;
\r
48 : <exiting-action> ( -- action )
\r
50 [ [ ] "text/plain" <content> exit-with ] >>display ;
\r
52 [ "auth-test.db" temp-file delete-file ] ignore-errors
\r
54 "auth-test.db" temp-file <sqlite-db> [
\r
56 <request> "GET" >>method init-request
\r
57 session ensure-table
\r
59 "127.0.0.1" 1234 <inet4> remote-address set
\r
69 123 >>id session set
\r
72 [ ] [ 3 "x" sset ] unit-test
\r
74 [ 9 ] [ "x" sget sq ] unit-test
\r
76 [ ] [ "x" [ 1 - ] schange ] unit-test
\r
78 [ 4 ] [ "x" sget sq ] unit-test
\r
80 [ t ] [ session get changed?>> ] unit-test
\r
85 get-session session?
\r
91 dup [ 5 "a" sset ] with-session
\r
92 dup [ "a" sget , ] with-session
\r
93 dup [ "x" sget , ] with-session
\r
100 get-session [ "x" sget ] with-session
\r
106 dup get-session [ 5 "a" sset ] with-session
\r
107 dup get-session [ "a" sget , ] with-session
\r
108 dup get-session [ "x" sget , ] with-session
\r
121 dup url>> "/" >>path drop
\r
123 { "etc" } sessions get call-responder response set
\r
124 [ "1" ] [ [ response get write-response-body drop ] with-string-writer ] unit-test
\r
129 [ ] [ response get cookies>> "cookies" set ] unit-test
\r
131 [ "2" ] [ sessions-mock-test ] unit-test
\r
132 [ "3" ] [ sessions-mock-test ] unit-test
\r
133 [ "4" ] [ sessions-mock-test ] unit-test
\r
140 "id" get session-id-key set-query-param
\r
145 { } <exiting-action> <sessions>
\r
147 ] with-destructors response set
\r
150 [ "text/plain" ] [ response get content-type>> ] unit-test
\r
152 [ f ] [ response get cookies>> empty? ] unit-test
\r