blob: cf6accc9d29f3c60bb056a68a36db9c5688f193d (
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
131
132
133
134
135
|
;;;; vampire.lisp
(in-package #:vampire)
;;; SYSTEM CONFIG COMPONENT
(defvar *config* nil)
(defclass/std config ()
((datastore-directory :ir :std #P"/srv/parasite/store/")
(static-directory :ir :std #P"/srv/parasite/static/")
(port :ir :std 4919)
(downloader-threads :ir :std 5)))
(defun config-from-file (path)
"PATH should be a path to a file containing a PLIST suitable for
passing as the keyword arguments to (MAKE-INSTANCE 'CONFIG ...)"
(apply #'make-instance 'config (read-from-file path)))
;;; RESOURCE MODEL
(defclass/bknr user (keyed)
((name :with :std "")
(playlists :with :std (list))
(pw pwhash :with)))
;;; TRANSACTIONS
(defun new-user (&key name)
(with-transaction ()
(make-instance 'user :name name)))
;;; CLIENT
(defparameter +user-key+ "vampire.userkey")
(defun user-key (window)
(jonathan:parse (storage-element window :local +user-key+)))
(defun (setf user-key) (val window)
(setf (storage-element window :local +user-key+) (jonathan:to-json val)))
(defun session-user (clog-obj)
(object-with-key (user-key (window (connection-body clog-obj)))))
(defun create-new-playlist-form (parent &rest args)
(declare (ignorable args))
(with-clog-create parent
(div ()
(section (:h2 :content "Create New Playlist"))
(label (:content "Playlist Title:"))
(form-element (:text :bind pl-title))
(button (:content "Create" :bind btn)))
(set-on-click
btn
(alambda
(new-playlist (session-user parent) :title (value pl-title))
(reload (location (connection-body parent)))))))
(defun url-to-playlist (pl location)
(format nil "~a//~a/playlist/~a"
(protocol location)
(host location)
(key pl)))
(defun create-playlist-listing (parent &rest args)
(declare (ignorable args))
(dolist (pl (user-playlists (session-user parent)))
(let ((url
(url-to-playlist pl (location (connection-body parent)))))
(with-clog-create parent
(div ()
(section (:h4)
(a (:link url :content (playlist-title pl) :bind pl-link))))
(set-on-click
pl-link
(alambda
(setf (url (location (connection-body parent)))
url)))))))
(defun user-page (body)
(if-let (user (session-user body))
(with-clog-create body
(div ()
(p (:content (format nil "Welcome ~a" (user-name user))))
(new-playlist-form ())
(playlist-listing ())))
(setf (url (location body)) "/")))
(defun login-page (body)
(with-clog-create body
(div ()
(p (:content "LOGIN"))
(form-element (:text :bind name))
(button (:bind btn :content "Click here to log in")))
(set-on-click
btn
(lambda (obj)
(declare (ignore obj))
(let ((u (new-user :name (value name))))
(setf (user-key (window body)) (key u))
(setf (url (location body)) "/"))))))
(defun main (body)
(if (session-user body)
(setf (url (location body)) "/user")
(setf (url (location body)) "/login")))
;;; STARTUP
(defun initialize-database (config)
(ensure-directories-exist (datastore-directory config))
(make-instance
'bknr.datastore:mp-store
:directory (datastore-directory config)
:subsystems (list (make-instance 'bknr.datastore:store-object-subsystem))))
(defun start (config)
(setf *config* config)
(initialize-database config )
(start-downloader-service config)
(initialize 'main
:extended-routing t
:static-root (static-directory config))
(set-on-new-window 'user-page :path "/user")
(set-on-new-window 'login-page :path "/login")
(set-on-new-window 'playlist-page :path "/playlist")
(open-browser))
(defun hacking-start ()
(start (make-instance
'config
:static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname))
:datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname)))))
|
