Feat: pull & persist all Steam Games & Achievements

7 files changed, 170 insertions, 43 deletions

diff --git a/.gitignore b/.gitignore
index e02b6c0..0b7f373 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 *~
 /store/
+/config.lisp
diff --git a/arclade.asd b/arclade.asd
index c1e8829..dfcca50 100644
--- a/arclade.asd
+++ b/arclade.asd
@@ -7,7 +7,8 @@
   :version "0.0.1"
   :serial t
   :depends-on
-  (#:bknr.datastore
+  (#:alexandria
+   #:bknr.datastore
    #:date-calc
    #:defclass-std
    #:derrida
@@ -21,6 +22,7 @@
    #:testiere
    #:lazybones)
   :components ((:file "package")
+	       (:file "utilities")
                (:file "arclade")
 	       (:file "model")
 	       (:file "steam")))
diff --git a/arclade.lisp b/arclade.lisp
index e7ce65c..eb34688 100644
--- a/arclade.lisp
+++ b/arclade.lisp
@@ -44,8 +44,9 @@
  :content-type "text/html")
 
 (defun start ()
-  (setf *config* (make-instance 'config))
+  (setf *config* (config-from-file #P"config.lisp"))
   (init-db *config*)
-  (setf *server* (lzb:create-server))
-  (lzb:install-app *server* (lzb:app 'arclade))
-  (lzb:start-server *server*))
+  ;; (setf *server* (lzb:create-server))
+  ;; (lzb:install-app *server* (lzb:app 'arclade))
+  ;; (lzb:start-server *server*)
+  )
diff --git a/config.lisp.example b/config.lisp.example
new file mode 100644
index 0000000..a65b185
--- /dev/null
+++ b/config.lisp.example
@@ -0,0 +1,2 @@
+(:steam-user-id "xxxx"
+ :steam-key "XXXX")
diff --git a/model.lisp b/model.lisp
index ce537cf..3f0e4a1 100644
--- a/model.lisp
+++ b/model.lisp
@@ -1,31 +1,78 @@
 ;;;; model.lisp
 
+(in-package :arclade)
+
 (defclass player ()
   ((name :initarg :name :reader name)
    (games :accessor games)))
 
-(defclass game ()
-  ((name :initarg :name :reader name)
+(defclass game (db:store-object)
+  ((name :initarg :name :reader name
+	 :index-type idx:string-unique-index
+	 :index-reader game-with-name
+	 :index-values all-games)   
    (rating :accessor rating)
    (playtime :accessor playtime)
    (icon-url :accessor icon-url)
-   (last-played :accessor last-played)))
+   (last-played :accessor last-played))
+  (:metaclass db:persistent-class))
 
 (defclass steam-game (game)
-  ((appid :initarg :appid :reader appid)))
+  ((appid :initarg :appid :reader appid
+	  :index-type idx:unique-index
+	  :index-initargs (:test #'equal)
+	  :index-reader steam-game-with-appid))
+  (:metaclass db:persistent-class))
 
 (defmethod print-object ((object steam-game) stream)
   (format stream "#<STEAM GAME ~a>" (name object)))
 
-(defclass feat ()
-  ((game :initarg :game :reader game)
-   (player :initarg :player :reader player)
-   (date :accessor date
-	 :initform (multiple-value-list (date-calc:today-and-now)))
-   (description :accessor description :initform "")))
-
-(defclass achievement (feat)
-  ((name :initarg :name :reader name)))
+(defclass feat (db:store-object)
+  ((game
+    :reader game
+    :initarg :game
+    :initform (error "Feats must belong to a GAME.")
+    :type game
+    :index-type idx:hash-index
+    :index-reader feats-for-game
+    :documentation "Game object to which this feat belongs.")
+   (name
+    :initarg :name
+    :reader name
+    :type string
+    :initform ""
+    :documentation "Optional name of the feat.")
+   (fulfillment
+    :initarg :fulfillment
+    :initform nil
+    :accessor fulfillment
+    :documentation "Ideally a date and time when the feat was fulfilled.
+If nil, implies the feat is yet to be fulfilled.")
+   (description
+    :initarg :description
+    :accessor description
+    :initform ""
+    :type string
+    :documentation "Free text feat flattery."))
+  (:metaclass db:persistent-class)
+  (:documentation "Base class for a notable event performed in GAME.
+Example:
+  Castlevania - 2003-10-31 (guess)
+  Defeated Dracula and finished the game!"))
 
 (defclass score (feat)
-  ((points :initarg :points :accessor points)))
+  ((points :initarg :points :accessor points))
+  (:metaclass db:persistent-class)
+  (:documentation "Feat subclass specific to score based games."))
+
+(defclass steam-achievement (feat)
+  ((icongray :accessor icongray)
+   (icon :accessor icon)
+   (apiname :accessor apiname))
+  (:metaclass db:persistent-class)
+  (:documentation "Feat with Steam specific slots."))
+
+;;; "queries"
+
+(defun feats-fulfilled ()
+  (remove-if-not #'fulfillment (db:store-objects-with-class 'feat)))
diff --git a/steam.lisp b/steam.lisp
index 8d61514..5bc49a8 100644
--- a/steam.lisp
+++ b/steam.lisp
@@ -1,3 +1,5 @@
+(in-package :arclade)
+
 (defvar steam-host "api.steampowered.com")
 
 (defun set-steam-key (key)
@@ -14,60 +16,119 @@
 ;;  an array named "item" containing several objects following the "item" structure).
 ;; * Null is represented as JSON's null.
 
-
 (defun steam-games-uri ()
+  "Builds the uri & query params to get owned games for the configured steam id."
   (quri:render-uri
    (quri:make-uri-http
     :host steam-host
     :path "IPlayerService/GetOwnedGames/v0001/"
     :query (quri:url-encode-params `(("key" . ,(steam-key *config*))
-				     ("steamid" . ,(steam-user-id *config*))
-				     ("include_appinfo" . "true"))))))
+                                     ("steamid" . ,(steam-user-id *config*))
+                                     ("include_appinfo" . "true"))))))
 
 (defun fetch-steam-games ()
+  "Fetch configured user's steam games and return parsed JSON."
   (derrida:with-keypaths ((games :|response| :|games|))
       (json:parse
        (flexi-streams:octets-to-string
-	(drakma:http-request (steam-games-uri))))
+        (drakma:http-request (steam-games-uri))))
     games))
 
-(defun make-steam-game (json)
+(defun make-steam-game (data)
+  "Make a STEAM-GAME instance from DATA, a parsed JSON form from Steam's API."
   (with-plist ((id :|appid|) (playtime :|playtime_forever|) (name :|name|)
-	       (icon-url :|img_icon_url|) (last-played :|rtime_last_played|))
-      json
+               (icon-url :|img_icon_url|) (last-played :|rtime_last_played|))
+      data
     (let ((game (make-instance 'steam-game :name name :appid id)))
       (setf (playtime game) playtime
-	    (icon-url game) icon-url
-	    (last-played game) last-played)
+            (icon-url game) icon-url
+            (last-played game) last-played)
       game)))
 
+(defun steam-game-schema-uri (game)
+  "Returns URI and query params to get detailed info about a game.
+
+RESULT DATA
+game
+  gameName (string)
+    Steam internal (non-localized) name of game.
+  gameVersion (int)
+    Steam release version number currently live on Steam.
+  availableGameStats
+    achievements (Optional) (array)
+      name (string)
+        API Name of achievement.
+      defaultvalue (int)
+        Always 0 (player's default state is unachieved).
+      displayName (string)
+        Display title string of achievement.
+      hidden (int)
+        If achievement is hidden to the user before earning
+        achievement, value is 1. 0 if public.
+      description (string)
+        Display description string of achievement.
+      icon (string)
+        Absolute URL of earned achievement icon art.
+      icongray (string)
+        Absolute URL of un-earned achievement icon art."
+  (quri:render-uri
+   (quri:make-uri-http
+    :host steam-host
+    :path "ISteamUserStats/GetSchemaForGame/v2/"
+    :query (quri:url-encode-params `(("key" . ,(steam-key *config*))
+                                     ("appid" . ,(appid game))
+                                     ("l" . "en"))))))
+
+(defun fetch-steam-game-schema (game)
+  (derrida:with-keypaths ((achievements :|game| :|availableGameStats| :|achievements|))
+      (json:parse
+       (flexi-streams:octets-to-string
+        (drakma:http-request (steam-game-schema-uri game))))
+    achievements))
+
 (defun steam-achievements-uri (game)
+  "Builds uri & query params for configured steam id's achievements for GAME."
   (quri:render-uri
    (quri:make-uri-http
     :host steam-host
     :path "ISteamUserStats/GetPlayerAchievements/v0001/"
     :query (quri:url-encode-params `(("key" . ,(steam-key *config*))
-				     ("steamid" . ,(steam-user-id *config*))
-				     ("appid" . ,(appid game))
-				     ("l" . "en"))))))
+                                     ("steamid" . ,(steam-user-id *config*))
+                                     ("appid" . ,(appid game))
+                                     ("l" . "en"))))))
 
 (defun fetch-steam-achievements (steam-game)
   (derrida:with-keypaths ((success :|playerstats| :|success|)
-			  (achievements :|playerstats| :|achievements|))
+                          (achievements :|playerstats| :|achievements|))
       (json:parse
        (flexi-streams:octets-to-string
-	(drakma:http-request (steam-achievements-uri steam-game))))
+        (drakma:http-request (steam-achievements-uri steam-game))))
     (when success achievements)))
 
-(defun steam-game-schema-uri (game)
-  "Returns URI and query params to get detailed info about a game. This is where
-the image links for achievements can be found."
-  (quri:render-uri
-   (quri:make-uri-http
-    :host steam-host
-    :path "ISteamUserStats/GetSchemaForGame/v2/"
-    :query (quri:url-encode-params `(("key" . ,(steam-key *config*))
-				     ("appid" . ,(appid game))
-				     ("l" . "en"))))))
+(defun make-steam-achievement (game schema stats)
+  (with-plist ((icon :|icon|) (icongray :|icongray|))
+      schema
+    (with-plist ((name :|name|) (desc :|description|) (time :|unlocktime|)
+		 (achieved :|achieved|) (apiname :|apiname|))
+	stats
+      (db:with-transaction ()
+	(let ((rec (make-instance 'steam-achievement
+				  :game game :name name :description desc)))
+	  (setf (icon rec) icon
+		(icongray rec) icongray
+		(apiname rec) apiname)
+	  (unless (zerop achieved)
+	    (setf (fulfillment rec) (epoch-time time)))
+	  rec)))))
 
+(defun load-steam-games ()
+  "Fetch and wrap STEAM-GAMES as persistent objects.
+WARNING! Not idempotent!"
+  (db:with-transaction ()
+    (loop for data in (fetch-steam-games)
+	  do (make-steam-game data))))
 
+(defun load-achievement-data (game)
+  (loop for schema in (fetch-steam-game-schema game)
+	for achievements in (fetch-steam-achievements game)
+	do (make-steam-achievement game schema achievements)))
diff --git a/utilities.lisp b/utilities.lisp
new file mode 100644
index 0000000..d58eb47
--- /dev/null
+++ b/utilities.lisp
@@ -0,0 +1,13 @@
+;;; utilities.lisp
+
+(in-package :arclade)
+
+(defun read-from-file (path)
+  (read-from-string
+   (alexandria:read-file-into-string path)))
+
+(defvar *epoch* (encode-universal-time 0 0 0 1 1 1970)
+  "Jan 1 1970 Unix Epoch time in CL universal time.")
+
+(defun epoch-time (time)
+  (multiple-value-list (decode-universal-time (+ *epoch* time))))