blob: 4bbc4f78a365a28d901a6498c95f23d94c5611cc (
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
|
;;;; endpoints.lisp -- http endpoints for dnd
(in-package :dnd)
(lzb:provision-app ()
:title "Dungeons & Deadlines"
:version "0.1.0"
:content-type "text/html")
(defparameter +session-cookie-name+ "dnd-session")
;;; UTILITIES
(defun redirect-to (location)
"Set the lazybones response header and response code for redirecting to LOCATION.
This procedure will error if lazybones:*request* is not currently bound."
(setf (lzb:response-header :location) location
(lzb:response-code) "303"))
(defun current-session ()
"Get the session associated with the current request. Will throw an
error if lazybones:*request* is not currently bound. It will return
NIL if there is no session for the current request.
I.e. It should be called within the scope of a request handler."
(session-with-id (lzb:request-cookie +session-cookie-name+ )))
(defmacro with-session ((player &key session (redirect "/tavern-door")) &body body)
(let ((session (or session (gensym "SESSION"))))
`(a:if-let (,session (current-session))
(let ((,player (session-player ,session)))
,@body)
(redirect-to ,redirect))))
;;; OPEN ENDPOINTS
(defendpoint* :get "/" () ()
(redirect-to "/tavern-door"))
(defendpoint* :get "/tavern-door" () ()
"Tavern door is where the player logs into the system."
(a:if-let (name (flashed-value :tavern-door))
(doorkeeper :message (format nil "Ne'er 'erd of ye ~a" name))
(doorkeeper)))
(defendpoint* :post "/tavern-door" () ()
(with-plist ((nick :nick)) (lzb:request-body)
(a:if-let ((player (player-with-nick (string-trim " " nick))))
(a:when-let ((sesh (new-sesh player)))
(lzb:set-response-cookie +session-cookie-name+ (session-id sesh)
:path "/" :domain "localhost") ; TODO: generalize domain
(redirect-to "/tavern"))
(progn
(flash :tavern-door nick)
(redirect-to "/tavern-door")))) )
(defendpoint* :get "/register" () ()
(register))
(defun check-valid-nick (name)
"Errors with 400 if the name is not a valid hero name."
(unless (valid-nick-p name)
(lzb:http-err 400 (format nil "Player Nick Invalid"))))
(defendpoint* :post "/register" () ()
(with-plist ((nick :nick)) (lzb:request-body)
(check-valid-nick nick)
(register-player nick)
(redirect-to "/tavern-door")))
(defendpoint* :get "/godess-shrine" () ()
(godess-shrine))
(defendpoint* :post "/godess-shrine" () ()
(with-plist ((name :name)) (lzb:request-body)
(birth-from-the-goddess-loins name)
(redirect-to "/tavern-door")))
;;; SESSION ENDPOINTS
(defendpoint* :get "/tavern" () ()
(with-session (player)
(tavern player)))
|
