main commit

LICENSE

@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) Dmitrii Kosenkov
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -0,0 +1,38 @@
+# FCM
+
+Common Lisp client for FCM - Firebase Cloud Messaging.
+
+## Installation
+
+This system can be installed from [UltraLisp](https://ultralisp.org/) like this:
+
+```common-lisp
+(ql-dist:install-dist "https://dist.ultralisp.org/"
+ :prompt nil)
+(ql:quickload "fcm")
+```
+
+## Usage
+
+```common-lisp
+(defvar *fcm* (fcm:make-client-with-service-account "config/firebase.json"))
+(defvar *token* "some-device-token")
+(defvar *message*
+ (list :|token| *token*
+ :|notification| (list :|title| "Message Title"
+ :|body| "Message body"
+ :|image| "https://example.org/logo.jpg")))
+
+(handler-case (fcm:send *fcm* *message*)
+ (fcm:fcm-error (err)
+ (case (intern (fcm:fcm-error-status err))
+ ('NOT_FOUND
+ (log:warn "unregistered FCM token: ~A" *token*))
+ (t
+ (log:error "FCM error: ~A: ~A; token: ~A" (type-of err) err *token*)))))
+
+```
+
+## Documentation
+
+- [FCM Message format](https://firebase.google.com/docs/reference/fcm/rest/v1/projects.messages)

fcm.asd

@@ -0,0 +1,18 @@
+(defsystem "fcm"
+ :version "0.1.0"
+ :author "Dmitrii Kosenkov"
+ :license "MIT"
+ :depends-on ("dexador"
+ "alexandria"
+ "jonathan"
+ "cl-base64"
+ "local-time"
+ "jose"
+ "ironclad"
+ "asn1"
+ "pem")
+ :description "Client for FCM - Firebase Cloud Messaging"
+ :homepage "https://github.com/Junker/fcm"
+ :source-control (:git "https://github.com/Junker/fcm.git")
+ :components ((:file "package")
+ (:file "fcm")))

fcm.lisp

@@ -0,0 +1,108 @@
+(in-package #:fcm)
+
+(defvar *scope* "https://www.googleapis.com/auth/firebase.messaging")
+(defvar *token-uri* "https://oauth2.googleapis.com/token")
+(defparameter *token-expiry-length* 3600)
+
+(define-condition fcm-error (error)
+ ((code :initarg :code
+ :reader fcm-error-code
+ :type integer)
+ (message :initarg :message
+ :reader fcm-error-message
+ :type string)
+ (status :initarg :status
+ :reader fcm-error-status
+ :type string)
+ (details :initarg :details
+ :reader fcm-error-details))
+ (:report (lambda (condition stream)
+ (with-slots (code message status details) condition
+ (format stream "FCM request failed with code ~D and status '~A': ~A~% Details:~%~A"
+ code status message (write-to-string details))))))
+
+(defclass client ()
+ ((project-id :initarg :project-id :accessor client-project-id :type string)
+ (private-key :initarg :private-key :accessor client-private-key :type ironclad:rsa-private-key)
+ (client-email :initarg :client-email :accessor client-client-email :type string)
+ (token-uri :initarg :token-uri :accessor client-token-uri :type string)
+ (access-token :initarg nil :accessor client-access-token)
+ (access-token-expires-at :initarg :access-token-expires-at :accessor client-access-token-expires-at :type integer))
+ (:default-initargs
+ :project-id (error "PROJECT-ID required.")
+ :private-key (error "PRIVATE-KEY required.")
+ :client-email (error "CLIENT-EMAIL required.")
+ :token-uri *token-uri*
+ :access-token-expires-at 0))
+
+
+;; PRIV
+(defun parse-service-account-file (path)
+ (jojo:parse (uiop:read-file-string path)))
+
+(defun read-pkcs8-private-key (pem)
+ (let* ((pkcs8-der (asn1:decode (base64:base64-string-to-usb8-array (cdar (pem:parse (make-string-input-stream pem))))))
+ (pkcs1-der (asn1:decode (cdr (fourth (car pkcs8-der))))))
+ (trivia:match pkcs1-der
+ ((asn1:rsa-private-key :private-exponent d :modulus n)
+ (ironclad:make-private-key :rsa :d d :n n)))))
+
+(defun %generate-jwt (private-key client-email token-uri &key (expiry-length *token-expiry-length*))
+ (jose:encode :rs256 private-key `(("iss" . ,client-email)
+ ("iat" . ,(timestamp-to-unix (now)))
+ ("exp" . ,(+ (timestamp-to-unix (now)) expiry-length))
+ ("scope" . ,*scope*)
+ ("aud" . ,token-uri))))
+
+
+(defun %send (message project-id access-token)
+ (handler-case (dex:post (format nil "https://fcm.googleapis.com/v1/projects/~A/messages:send" project-id)
+ :headers `(("Content-Type" . "application/json")
+ ("Authorization" . ,(format nil "Bearer ~A" access-token)))
+ :content (jojo:to-json (list :|message| message)))
+ (dex:http-request-failed (err)
+ (if (not (equal (gethash "content-type" (dex:response-headers err))
+ "application/json; charset=UTF-8"))
+ (error err)
+ (let* ((data (jojo:parse (dex:response-body err)))
+ (error-data (getf data :|error|)))
+ (if (not error-data)
+ (error err)
+ (error (make-condition 'fcm-error
+ :code (getf error-data :|code|)
+ :status (getf error-data :|status|)
+ :message (getf error-data :|message|)
+ :details (getf error-data :|details|)))))))))
+
+(defun %auth (token-url jwt)
+ (jojo:parse (dex:post token-url
+ :content (format nil "grant_type=urn:ietf:params:oauth:grant-type:jwt-bearer&assertion=~A" jwt)
+ :headers '(("Content-Type" . "application/x-www-form-urlencoded")))))
+
+;; PUBLIC
+
+(defun make-client-with-service-account (path)
+ (let ((acc (parse-service-account-file path)))
+ (make-instance 'client
+ :project-id (getf acc :|project_id|)
+ :private-key (read-pkcs8-private-key (getf acc :|private_key|))
+ :client-email (getf acc :|client_email|)
+ :token-uri (getf acc :|token_uri|))))
+
+(defmethod generate-jwt ((client client))
+ (with-slots (private-key client-email token-uri) client
+ (%generate-jwt private-key client-email token-uri)))
+
+
+(defmethod auth ((client client))
+ (let ((response (%auth (client-token-uri client) (generate-jwt client))))
+ (setf (client-access-token client) (getf response :|access_token|)
+ (client-access-token-expires-at client) (+ (get-universal-time)
+ (getf response :|expires_in|)))))
+
+
+(defmethod send ((client client) message)
+ (with-slots (project-id access-token access-token-expires-at) client
+ (when (> (get-universal-time) (- access-token-expires-at 10))
+ (auth client))
+ (%send message project-id access-token)))

package.lisp

@@ -0,0 +1,16 @@
+(defpackage fcm
+ (:use #:cl #:alexandria)
+ (:import-from #:local-time
+ #:timestamp-to-unix
+ #:now)
+ (:export #:*token-expiry-length*
+ #:client
+ #:send
+ #:auth
+ #:generate-jwt
+ #:make-client-with-service-account
+ #:fcm-error
+ #:fcm-error-code
+ #:fcm-error-message
+ #:fcm-error-status
+ #:fcm-error-details))