factor/extra/http/server/sessions/sessions-tests.factor

153 lines
4.1 KiB
Factor
Executable File

IN: http.server.sessions.tests
USING: tools.test http http.server.sessions
http.server.sessions.storage http.server.sessions.storage.db
http.server.actions http.server math namespaces kernel accessors
prettyprint io.streams.string io.files splitting destructors
sequences db db.sqlite continuations ;
: with-session
[
>r [ save-session-after ] [ \ session set ] bi r> call
] with-destructors ; inline
TUPLE: foo ;
C: <foo> foo
M: foo init-session* drop 0 "x" sset ;
M: foo call-responder*
2drop
"x" [ 1+ ] schange
"text/html" <content> [ "x" sget pprint ] >>body ;
: url-responder-mock-test
[
<request>
"GET" >>method
"id" get session-id-key set-query-param
"/" >>path
request set
{ } session-manager get call-responder
[ write-response-body drop ] with-string-writer
] with-destructors ;
: session-manager-mock-test
[
<request>
"GET" >>method
"cookies" get >>cookies
"/" >>path
request set
{ } session-manager get call-responder
[ write-response-body drop ] with-string-writer
] with-destructors ;
: <exiting-action>
<action>
[
"text/plain" <content> exit-with
] >>display ;
[ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors
"auth-test.db" temp-file sqlite-db [
init-request
init-sessions-table
[ ] [
<foo> <session-manager>
sessions-in-db >>sessions
session-manager set
] unit-test
[
empty-session
123 >>id session set
[ ] [ 3 "x" sset ] unit-test
[ 9 ] [ "x" sget sq ] unit-test
[ ] [ "x" [ 1- ] schange ] unit-test
[ 4 ] [ "x" sget sq ] unit-test
[ t ] [ session get changed?>> ] unit-test
] with-scope
[ t ] [
session-manager get begin-session id>>
session-manager get sessions>> get-session session?
] unit-test
[ { 5 0 } ] [
[
session-manager get begin-session
dup [ 5 "a" sset ] with-session
dup [ "a" sget , ] with-session
dup [ "x" sget , ] with-session
id>> session-manager get sessions>> delete-session
] { } make
] unit-test
[ 0 ] [
session-manager get begin-session id>>
session-manager get sessions>> get-session [ "x" sget ] with-session
] unit-test
[ { 5 0 } ] [
[
session-manager get begin-session id>>
dup session-manager get sessions>> get-session [ 5 "a" sset ] with-session
dup session-manager get sessions>> get-session [ "a" sget , ] with-session
dup session-manager get sessions>> get-session [ "x" sget , ] with-session
session-manager get sessions>> delete-session
] { } make
] unit-test
[ ] [
<foo> <session-manager>
sessions-in-db >>sessions
session-manager set
] unit-test
[
<request>
"GET" >>method
"/" >>path
request set
{ "etc" } session-manager get call-responder response set
[ "1" ] [ [ response get write-response-body drop ] with-string-writer ] unit-test
response get
] with-destructors
response set
[ ] [ response get cookies>> "cookies" set ] unit-test
[ "2" ] [ session-manager-mock-test ] unit-test
[ "3" ] [ session-manager-mock-test ] unit-test
[ "4" ] [ session-manager-mock-test ] unit-test
[
[ ] [
<request>
"GET" >>method
"id" get session-id-key set-query-param
"/" >>path
request set
[
{ } <exiting-action> <session-manager>
sessions-in-db >>sessions
call-responder
] with-destructors response set
] unit-test
[ "text/plain" ] [ response get "content-type" header ] unit-test
[ f ] [ response get cookies>> empty? ] unit-test
] with-scope
] with-db