(declaim (optimize (debug 3) (speed 0 ) (safety 3)) )
;;;; inangulis.lisp
(in-package #:inangulis)
(defparameter *submissions* nil)
(defparameter *by-distinct* (make-hash-table :test #'equalp))
(defparameter *users* (make-hash-table :test #'equalp))
(defparameter *persist* t)
(defmacro cdr-assoc (&whole lis item alist &key key test test-not)
`(cdr (assoc ,@(cdr lis))))
(defun str-assoc (param params &key (test #'equal) key)
(cdr-assoc param params :test test :key key))
;;; "inangulis" goes here. Hacks and glory await!
(defun current-date-string ()
"Returns current date as a string."
(local-time:format-timestring nil (local-time:now)
:format local-time:+rfc-1123-format+))
(defclass user ()
((uid :initarg :uid)
(email :initarg :email)
(name :initarg :name)
(moderator :initarg :moderator :initform nil)))
(defun user-alist (user)
(with-slots ((email inangulis.tables::email)
(name inangulis.tables::name)
(moderator inangulis.tables::moderator)) user
`(("name" . ,name)
("email" . ,email)
("moderator" . ,moderator))))
(defmethod print-object ((obj user) s)
(print-unreadable-object (obj s :type t :identity t)
(with-slots (uid email name moderator) obj
(format s "U: ~s E: ~s N: ~s M: ~s" uid email name moderator))))
(defun make-submission (headline url &key (approved ""))
(alet 'inangulis.tables:submission
(make-instance it :headline headline :url url :approved approved :date (current-date-string))))
(defun submission-alist (submission)
`(("headline". ,(s-headline submission))
("url" . ,(s-url submission))
("date" . ,(s-url submission))
("approved" . ,(s-approved submission))))
(defun get-by-key (headline url)
(car (postmodern:select-dao 'inangulis.tables::submission (:and (:= 'headline headline) (:= 'url url)))))
(defun alist-submission (alist &key nil-if-exists)
(let* ((headline (cdr-assoc :headline alist :test #'string-equal))
(url (cdr-assoc :url alist :test #'string-equal))
(approved (or (cdr-assoc :approved alist :test #'string-equal) ""))
(result (make-submission headline url :approved approved)))
(with-slots ((headline inangulis.tables:headline) (url inangulis.tables:url)) result
(aif (get-by-key headline url)
(unless nil-if-exists it)
result))))
(defun get-moderated (feeds)
(remove-if (lambda (x) (not (equal x "approved"))) feeds :key #'s-approved))
(defparameter *app* (make-instance 'ningle:<app>))
(defun rebind-headers (app)
(lambda (env)
(format t "~&~%------------------@!@#$@#!$!@#$-----------------~%")
(format t "~&~%~s" ningle.context:*request*)
(format t "~&~s~%" (alexandria:hash-table-alist (lack.request:request-headers ningle.context:*request*)))
(format t "~&~s~%~%" (gethash "x-real-ip" (lack.request:request-headers ningle.context:*request*)))
(awhen (gethash "x-real-ip" (lack.request:request-headers ningle.context:*request*))
(format t "~&~s" (lack.request:request-remote-addr ningle.context:*request*))
(setf (lack.request:request-remote-addr ningle:*request*) it)
(setf (getf env :remote-addr) it)
(format t "~&~s" (lack.request:request-remote-addr ningle.context:*request*)))
(funcall app env)))
(defmacro i-defun (name (&rest args) &body body)
`(defun ,name (,@args)
(declare (ignorable ,@(loop for x in args
if (not (char= (elt (symbol-name x) 0) #\&))
collect x)))
,@body))
(defmacro i-lambda ((&rest args) &body body)
`(lambda (,@args)
(declare (ignorable ,@args))
,@body))
(defmacro with-db (&body b)
`(postmodern:with-connection (ubiquitous:value 'db)
,@b))
(defmacro with-submissions (&body b)
`(with-db
(let ((*submissions* (postmodern:select-dao 'inangulis.tables::submission t "date desc")))
,@b)))
(defun submit (params)
(awhen (alist-submission params :nil-if-exists t)
(postmodern:insert-dao it)
(push it *submissions*)))
(defun get-feed-guid (item)
(with-slots (alimenta:title alimenta:link) item
(let ((hasher (ironclad:make-digest 'ironclad:sha256)))
(ironclad:update-digest hasher (babel:string-to-octets alimenta:title))
(ironclad:update-digest hasher (babel:string-to-octets alimenta:link))
(ironclad:byte-array-to-hex-string (ironclad:produce-digest hasher)))))
(defmethod run-route :around (name params &rest r)
(declare (ignore r))
(with-db
(pomo:with-transaction ()
(call-next-method))))
;; View Controllers
(define-controller murmur (params)
(sleep 0.01)
(submit params))
(define-view murmur (model)
'(302 (:location "/") ("Done")))
(define-controller curate (params)
(let ((*submissions* (postmodern:select-dao 'inangulis.tables::submission t "date desc")))
(cl-oid-connect.utils:require-login
(alet (alist-submission params)
(let ((approval (string-downcase (str-assoc "approved" params :test #'equalp))))
(setf (s-approved it)
(if (equal approval "+") "approved"
(if (equal approval "-") "rejected")))
(when *persist*
(postmodern:update-dao it)))))))
(define-view curate (params)
'(302 (:location "/") ("Done")))
(define-view login-page (model)
`(200
()
(,(cl-who:with-html-output-to-string (s)
(:html
(:head
(:title "Login")
(:link :rel "stylesheet" :href "/static/css/login.css"))
(:body
(:h1 "In Angulis")
(:div :class "login-buttons"
(:a :class "facebook" :href "/login/facebook" "Login With Facebook"))))))))
(define-controller logout (params)
(ningle:with-context-variables (session)
(setf (gethash :userinfo session) nil)))
(define-view logout (model)
'(302 (:location "/")))
(defmethod controller ((name (eql 'get-feed)) params &key moderated)
(let ((feed (alimenta::make-feed :title "In Angulis" :link "http://in-angulis.com/feed"
:description "Locus in quo sunt illi qui murmurant in angulis")))
(prog1 feed
(pomo:do-select-dao (('inangulis.tables::submission submission)
(:raw (if moderated (pomo:sql (:= 'approved "approved")) "'t'"))
(:desc 'date))
(alimenta::add-item-to-feed feed
:title (s-headline submission)
:link (s-url submission)
:date (s-date submission)
:next-id #'get-feed-guid
:content "")))))
(defparameter *tmp* nil)
(define-view get-feed (feed)
`(200 (:content-type "application/rss+xml") (,(plump:serialize (alimenta:generate-xml feed) nil))))
(mustache-view root (user . links) #p"static/index.mustache.html"
:links (mapcar #'submission-alist links)
:user (when user (user-alist user)))
(define-controller root (params)
(setf *tmp* ningle.context:*request*)
(with-submissions
(ningle:with-context-variables (session)
(handler-case
(cl-oid-connect.utils:ensure-logged-in
(cl-oid-connect.utils:redirect-if-necessary session
(cons (gethash :app-user session)
*submissions*)))
(cl-oid-connect.utils:user-not-logged-in (c) (cons nil *submissions*))))))
(defmethod controller :around ((name (eql 'headlines)) params &key (moderated t moderated-p))
(unless moderated-p
(awhen (str-assoc "moderated" params :test #'string-equal)
(setf moderated (and (> (length it) 0) (char= #\t (elt it 0)))
moderated-p t)))
(if moderated-p
(call-next-method name params :moderated moderated)
(call-next-method)))
(defmethod controller ((name (eql 'headlines)) params &key (moderated t moderated-p))
(let (result)
(ningle.context:with-context-variables (session)
(let* ((app-user (gethash :app-user session))
(moderator-p (and app-user (slot-value app-user 'inangulis.tables::moderator))))
(pomo:do-select-dao (('inangulis.tables::submission submission)
(:raw (cond
((and moderator-p (not moderated-p)) "'t'")
(moderated (pomo:sql (:= 'approved "approved")))
(t "'t'")))
(:desc 'date))
(push submission result))))
result))
(define-view headlines (columns) ;#p"static/headlines.mustache.html"
(let ((sub-len (length columns))
(columns (mapcar #'submission-alist columns)))
(render-mustache #p"static/headlines.mustache.html"
`((:columns . (((:rows . ,(subseq columns 0 (floor sub-len 3))))
((:rows . ,(subseq columns (floor sub-len 3) (* 2 (floor sub-len 3)) )))
((:rows . ,(subseq columns (* 2 (floor sub-len 3)) sub-len)))))))))
(defroutes *app*
(("/") (as-route 'root))
(("/curo" :method :POST) (as-route 'curate))
(("/feed") (as-route 'get-feed :moderated t))
(("/firehose") (as-route 'get-feed))
(("/headlines") (as-route 'headlines))
(("/login") (as-route 'login-page))
(("/logout") (as-route 'logout))
(("/murmuro" :method :POST) (as-route 'murmur)))
(cl-oid-connect::setup-oid-connect *app* (userinfo &rest args)
(declare (ignore args))
(let ((id (cdr (assoc :id userinfo))))
(with-db
(aif (car (postmodern:select-dao 'inangulis.tables::user (:= 'uid id)))
it
(alet (make-instance 'inangulis.tables::user)
(with-slots ((uid inangulis.tables::uid)
(name inangulis.tables::name)
(email inangulis.tables::email)) it
(prog1 it
(setf uid id
name (cdr (assoc :name userinfo))
email (cdr (assoc :email userinfo)))
(pomo:with-transaction ()
(postmodern:insert-dao it)))))))))
(let ((handler nil))
(ubiquitous:restore :inangulis)
(defun stop () (clack:stop (pop handler)))
(defun start (&optional tmp)
(cl-oid-connect:initialize-oid-connect
(ubiquitous:value 'facebook 'secrets)
(ubiquitous:value 'google 'secrets))
(let ((server (if (> (length tmp) 1)
(intern (string-upcase (elt tmp 1)) 'keyword)
:hunchentoot)))
(push (clack:clackup
(funcall clack-errors:*clack-error-middleware*
(lack.builder:builder
:accesslog
(:static :path "/static/" :root #p"./static/")
:backtrace
:session
*app*
)
:debug (ubiquitous:defaulted-value t 'debug))
:port 9090
:server server)
handler)))
(defun restart-clack ()
(do () ((null handler)) (stop))
(start)))