chatikbot/crypto.lisp

(in-package :cl-user)
(defpackage chatikbot.crypto
  (:use :cl)
  (:import-from :chatikbot.telegram
                :*telegram-token*
                :+telegram-max-callback-data-length+)
  (:export :token-hmac
           :encode-callback-data
           :decode-callback-data
           :encode-oauth-state
           :decode-oauth-state))
(in-package #:chatikbot.crypto)

(defun token-hmac (message &optional (hmac-length 12))
  (let ((hmac (crypto:make-hmac (crypto:ascii-string-to-byte-array *telegram-token*) :sha256)))
    (crypto:update-hmac hmac (crypto:ascii-string-to-byte-array message))
    (base64:usb8-array-to-base64-string
     (subseq (crypto:hmac-digest hmac) 0 hmac-length) :uri t)))

(defun encode-callback-data (chat-id section data &optional (ttl 600) (hmac-length 12))
  (unless (stringp data)
    (setf data (format nil "~A" data)))
  (when (find #\: data)
    (error "Bad data."))
  (let* ((message (format nil "~A:~A:~A:~A"
                          chat-id
                          (base64:integer-to-base64-string
                           (+ ttl (local-time:timestamp-to-universal (local-time:now))))
                          section data))
         (encoded (format nil "~A$~A" message (token-hmac message hmac-length))))
    (when (> (length encoded) +telegram-max-callback-data-length+)
      (error "Max callback length exceeded"))
    encoded))

(defun decode-callback-data (chat-id raw-data &optional (hmac-length 12))
  (destructuring-bind (message hmac)
      (split-sequence:split-sequence #\$ raw-data :from-end t :count 2)
    (destructuring-bind (cid expire section data)
        (split-sequence:split-sequence #\: message :count 4)
      (unless (= chat-id (parse-integer cid))
        (error "Wrong chat id."))
      (unless (>= (base64:base64-string-to-integer expire)
                  (local-time:timestamp-to-universal (local-time:now)))
        (error "Expired."))
      (unless (equal hmac (token-hmac message hmac-length))
        (error "Bad data."))
      (values data (intern (string-upcase section) "KEYWORD")))))

(defun encode-oauth-state (section state)
  (format nil "~A$~A" section state))

(defun decode-oauth-state (raw-state)
  (destructuring-bind (section data)
      (split-sequence:split-sequence #\$ raw-state :count 2)
    (values data (intern (string-upcase section) "KEYWORD"))))