gazprom.lisp 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156
  1. (in-package :cl-user)
  2. (defpackage chatikbot.plugins.gazprom
  3. (:use :cl :chatikbot.common :alexandria))
  4. (in-package :chatikbot.plugins.gazprom)
  5. (defparameter +api-uri+ "https://api.gpnbonus.ru/ios/v2/")
  6. (defvar *api-os* "android")
  7. (defvar *api-ver* "1.7.4")
  8. ;; poller methods
  9. (defmethod poller-request ((module (eql :gazprom)) method &rest params)
  10. (json-request (concatenate 'string +api-uri+ method)
  11. :method (if (equal method "auth.php") :post :get)
  12. :parameters (filled (append `(("session" . ,*poller-token*)
  13. ("os" . ,*api-os*)
  14. ("ver" . ,*api-ver*))
  15. (rest-parameters params)))))
  16. (defmethod poller-validate ((module (eql :gazprom)) response)
  17. (not (equal (agets response "message") "Необходимо авторизоваться")))
  18. (defmethod poller-get-token ((module (eql :gazprom)) secret)
  19. (destructuring-bind (username password) secret
  20. (agets (poller-request :gazprom "auth.php"
  21. :login username
  22. :passw password
  23. :token (get-token username password))
  24. "session")))
  25. (defun get-token (login pass)
  26. (let ((date (format nil "~{~4,'0D~2,'0D~2,'0D~}"
  27. (subseq (reverse (multiple-value-list
  28. (decode-universal-time
  29. (get-universal-time) 0)))
  30. 3 6))))
  31. (crypto:byte-array-to-hex-string
  32. (crypto:digest-sequence
  33. :md5 (crypto:ascii-string-to-byte-array
  34. (concatenate 'string login pass date *api-ver*))))))
  35. ;; API
  36. (defun get-card-info ()
  37. (poller-call :gazprom "getCardInfo.php"))
  38. (defun get-order (&key (count 20) (offset 0))
  39. (poller-call :gazprom "getOrder.php" :count count :offset offset))
  40. ;; Formatting
  41. (defvar *account-fuel* "expenses:Transport:Car:Gas")
  42. (defvar *account-other* "expenses:Food:Snacks")
  43. (defvar *account-asset* "liabilities:Tinkoff:Credit:Platinum")
  44. (defvar *income-bonus* "income:bonus")
  45. (defvar *account-bonus* "assets:Gazprom:Bonus")
  46. (defvar *default-currency* "RUB")
  47. (defvar *entry-description* "ГазпромНефть")
  48. (defun is-fuel (name)
  49. (or (equal name "ДТ+")
  50. (equal name "Аи-92")
  51. (equal name "Аи-95")
  52. (equal name "Аи-98")
  53. (equal name "G-95")))
  54. (defun get-currency (name)
  55. (cond
  56. ((or (equal name "Аи-92")
  57. (equal name "Аи-95")
  58. (equal name "Аи-98")
  59. (equal name "G-95")) "BENZ")
  60. ((equal name "ДТ+") "DIZ")
  61. (t *default-currency*)))
  62. (defun get-account (name)
  63. (cond
  64. ((is-fuel name) *account-fuel*)
  65. (t *account-other*)))
  66. (defun get-expense-posting (order)
  67. (let* ((name (agets order "name"))
  68. (is-fuel (is-fuel name))
  69. (count (parse-float (agets order "count")))
  70. (sum (parse-float (agets order "sum")))
  71. (currency (get-currency name)))
  72. (pta-ledger:make-posting
  73. :account (get-account name)
  74. :comment name
  75. :amount (pta-ledger:make-amount
  76. :quantity (if is-fuel count sum)
  77. :commodity currency)
  78. :unit-price (when is-fuel
  79. (pta-ledger:make-amount
  80. :quantity (/ sum count)
  81. :commodity *default-currency*)))))
  82. (defun orders->entry (date orders)
  83. (pta-ledger:make-entry
  84. :date (local-time:timestamp-to-universal (local-time:unix-to-timestamp date))
  85. :description *entry-description*
  86. :postings (loop for (type . orders) in (group-by orders (agetter "type"))
  87. for total = 0 then 0
  88. for bonus = 0 then 0
  89. append (append
  90. (loop for order in orders
  91. do (incf total (parse-float (agets order "sum")))
  92. do (incf bonus (parse-float (agets order "bonus")))
  93. collect (get-expense-posting order))
  94. (list (pta-ledger:make-posting
  95. :account *account-bonus*
  96. :amount (pta-ledger:make-amount
  97. :quantity bonus :commodity *default-currency*)))
  98. (when (= type 1)
  99. (list (pta-ledger:make-posting
  100. :account *income-bonus*
  101. :amount (pta-ledger:make-amount
  102. :quantity (* -1 bonus) :commodity *default-currency*))
  103. (pta-ledger:make-posting
  104. :account *account-asset*
  105. :amount (pta-ledger:make-amount
  106. :quantity (* -1 total) :commodity *default-currency*))))))))
  107. (defun format-card (card)
  108. (format nil "Баланс: ~,2F баллов~%Статус: ~A~%Литров в месяце: ~D"
  109. (agets card "card_balance")
  110. (agets card "card_status")
  111. (agets card "amount_current_month_liter")))
  112. (defun format-entries (changes)
  113. (text-chunks (mapcar #'pta-ledger:render changes)))
  114. ;; Cron
  115. (defun prepare-entries (orders)
  116. (loop for (date . orders) in (group-by orders (agetter "date"))
  117. collect (orders->entry date orders)))
  118. (defun process-new (changes)
  119. (let ((ledger-package (find-package :chatikbot.plugins.ledger))
  120. (transactions (prepare-entries changes)))
  121. (if ledger-package
  122. (let ((new-chat-entry (symbol-function
  123. (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
  124. (dolist (entry transactions)
  125. (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry))))
  126. (bot-send-message (format-entries transactions) :parse-mode "markdown"))))
  127. (defcron process-gazprom (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
  128. (poller-poll-lists :gazprom
  129. #'get-order
  130. #'process-new
  131. :key (agetter "date")))
  132. (def-message-cmd-handler handler-gazprom (:gpn :gazprom)
  133. (let ((arg (car *args*)))
  134. (bot-send-message (if (string= arg "bal")
  135. (format-card (get-card-info))
  136. (format-entries (prepare-entries (get-order :count (if arg (parse-integer arg) 10)))))
  137. :parse-mode "markdown")))