From 21b58059a35527cb59a02f2748bb71341443274e Mon Sep 17 00:00:00 2001 From: shoshin Date: Fri, 14 Apr 2023 21:50:14 -0500 Subject: Feat: pull & persist all Steam Games & Achievements --- .gitignore | 1 + arclade.asd | 4 +- arclade.lisp | 9 +++-- config.lisp.example | 2 + model.lisp | 75 +++++++++++++++++++++++++++++------- steam.lisp | 109 ++++++++++++++++++++++++++++++++++++++++------------ utilities.lisp | 13 +++++++ 7 files changed, 170 insertions(+), 43 deletions(-) create mode 100644 config.lisp.example create mode 100644 utilities.lisp 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 "#" (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)))) -- cgit v1.2.3