git.fiddlerwoaroof.com
inangulis.lisp
c27cda0b
 (declaim (optimize (debug 3) (speed 0 ) (safety 3)) )
6ba527a5
 (in-package #:inangulis)
0760be3e
 
c27cda0b
 (defparameter *by-distinct* (make-hash-table :test #'equalp))
 (defparameter *users* (make-hash-table :test #'equalp))
 
 (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 get-moderated (feeds)
   (remove-if (lambda (x) (not (equal x "approved"))) feeds :key #'s-approved))
 
 (defparameter *app* (make-instance 'ningle:<app>))
8aeb7f31
 
 (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)))
c27cda0b
 
4d21fd6e
 (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))
 
c27cda0b
 (defmacro i-lambda ((&rest args) &body body)
   `(lambda (,@args)
      (declare (ignorable ,@args))
      ,@body))
 
b55a8fe2
 
c27cda0b
 
 
 (defun get-feed-guid (item)
   (with-slots (alimenta:title alimenta:link) item
     (let ((hasher (ironclad:make-digest 'ironclad:sha256)))
4b08ceb7
       (ironclad:update-digest hasher (babel:string-to-octets alimenta:title))
       (ironclad:update-digest hasher (babel:string-to-octets alimenta:link))
c27cda0b
       (ironclad:byte-array-to-hex-string (ironclad:produce-digest hasher)))))
 
b55a8fe2
 (defmethod run-route :around (name params &rest r)
   (declare (ignore r))
   (with-db
     (pomo:with-transaction ()
       (call-next-method))))
 
 (define-view login-page (model)
   `(200
     ()
4d21fd6e
     (,(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"))))))))
 
b55a8fe2
 (define-controller logout (params)
4d21fd6e
   (ningle:with-context-variables (session)
b55a8fe2
     (setf (gethash :userinfo session) nil)))
4d21fd6e
 
b55a8fe2
 (define-view logout (model)
   '(302 (:location "/")))
 
 (defmethod controller ((name (eql 'get-feed)) params &key moderated)
4d21fd6e
   (let ((feed (alimenta::make-feed :title "In Angulis" :link "http://in-angulis.com/feed"
                                    :description "Locus in quo sunt illi qui murmurant in angulis")))
b55a8fe2
     (prog1 feed
0760be3e
       (pomo:do-select-dao (('inangulis.links:submission submission)
4d21fd6e
                            (: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
b55a8fe2
                                     :content "")))))
 
 (defparameter *tmp* nil)
 
 (define-view get-feed (feed)
   `(200 (:content-type "application/rss+xml") (,(plump:serialize (alimenta:generate-xml feed) nil))))
 
 (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))
0760be3e
              (moderator-p (and app-user (slot-value app-user 'inangulis.user::moderator))))
         (pomo:do-select-dao (('inangulis.links:submission submission)
b55a8fe2
                              (: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)))
c27cda0b
 
 (cl-oid-connect::setup-oid-connect *app* (userinfo &rest args)
   (declare (ignore args))
   (let ((id (cdr (assoc :id userinfo))))
b55a8fe2
     (with-db
0760be3e
       (aif (car (postmodern:select-dao 'inangulis.user:user (:= 'uid id)))
b55a8fe2
         it
0760be3e
         (alet (make-instance 'inangulis.user:user)
           (with-slots ((uid inangulis.user::uid)
                        (name inangulis.user::name)
                        (email inangulis.user::email)) it
b55a8fe2
             (prog1 it
               (setf uid id
                     name (cdr (assoc :name userinfo))
                     email (cdr (assoc :email userinfo)))
               (pomo:with-transaction ()
                 (postmodern:insert-dao it)))))))))
 
 
 
c27cda0b
 
 (let ((handler nil))
5519ae07
   (ubiquitous:restore :inangulis)
c27cda0b
   (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
ea862013
               (funcall clack-errors:*clack-error-middleware*
                        (lack.builder:builder
4b08ceb7
                          :accesslog
ea862013
                          (:static :path "/static/" :root #p"./static/")
                          :backtrace
8aeb7f31
                          :session
ea862013
                          *app*
f6790fb4
                          )
b55a8fe2
                       :debug (ubiquitous:defaulted-value t 'debug))
c27cda0b
               :port 9090
               :server server)
             handler)))
 
   (defun restart-clack ()
     (do () ((null handler)) (stop))
     (start)))