522 lines
25 KiB
Clojure
522 lines
25 KiB
Clojure
(ns auto-ap.square.core2
|
|
(:require
|
|
[auto-ap.datomic :refer [conn remove-nils]]
|
|
[auto-ap.time :as atime]
|
|
[clj-http.client :as client]
|
|
[clj-time.coerce :as coerce]
|
|
[clj-time.core :as time]
|
|
[clj-time.format :as f]
|
|
[clj-time.periodic :as periodic]
|
|
[clojure.core.async :as async]
|
|
[clojure.data.json :as json]
|
|
[clojure.set :as set]
|
|
[clojure.string :as str]
|
|
[clojure.tools.logging :as log]
|
|
[cemerick.url :as url]
|
|
[datomic.api :as d]
|
|
[slingshot.slingshot :refer [try+]]
|
|
[unilog.context :as lc]))
|
|
|
|
(defn client-base-headers [client]
|
|
{"Square-Version" "2021-08-18"
|
|
"Authorization" (str "Bearer " (:client/square-auth-token client))
|
|
"Content-Type" "application/json"})
|
|
|
|
(defn retry-4 [ex try-count _]
|
|
(log/warn "Retrying after failure " ex)
|
|
(if (> try-count 4) false true))
|
|
|
|
(defn lookup-dates []
|
|
(->> (periodic/periodic-seq (time/plus (time/now) (time/days -15))
|
|
(time/now)
|
|
(time/days 5))
|
|
(map (fn [d]
|
|
[(atime/unparse (time/plus d (time/days 1)) atime/iso-date)
|
|
|
|
(atime/unparse (time/plus d (time/days 5)) atime/iso-date)]))))
|
|
|
|
(defn client-locations [client]
|
|
(try
|
|
(->> (client/get "https://connect.squareup.com/v2/locations"
|
|
{:headers (client-base-headers client)
|
|
:as :json})
|
|
:body
|
|
:locations)
|
|
(catch Exception e
|
|
(log/warn e)
|
|
[])))
|
|
|
|
(defn fetch-catalog [client i]
|
|
(if i
|
|
(try
|
|
(log/trace "looking up catalog for" (str "https://connect.squareup.com/v2/catalog/object/" i))
|
|
(->> (client/get (str "https://connect.squareup.com/v2/catalog/object/" i)
|
|
{:headers (client-base-headers client)
|
|
:query-params {"include_related_items" "true"}
|
|
:as :json})
|
|
:body
|
|
:object)
|
|
(catch Exception e
|
|
(log/error e)
|
|
nil))
|
|
(log/warn "Trying to look up non existant ")))
|
|
|
|
(def fetch-catalog-fast (memoize fetch-catalog))
|
|
|
|
(defn item-id->category-name [client i]
|
|
(let [item (fetch-catalog-fast client i)]
|
|
(cond (:item_variation_data item)
|
|
(item-id->category-name client (:item_id (:item_variation_data item)))
|
|
|
|
(:category_id (:item_data item))
|
|
(:name (:category_data (fetch-catalog-fast client (:category_id (:item_data item)))))
|
|
|
|
(:item_data item)
|
|
"Uncategorized"
|
|
|
|
:else
|
|
(do
|
|
(log/warn "couldn't look up" i)
|
|
"Uncategorized"))))
|
|
|
|
(defn pc [start end]
|
|
{"query" {"filter" {"date_time_filter"
|
|
{
|
|
"created_at" {
|
|
"start_at" (f/unparse (f/formatter "YYYY-MM-dd'T'HH:mm:ssZZ") start)
|
|
"end_at" (f/unparse (f/formatter "YYYY-MM-dd'T'HH:mm:ssZZ") end)
|
|
}
|
|
|
|
|
|
|
|
}}
|
|
|
|
"sort" {
|
|
"sort_field" "CREATED_AT"
|
|
"sort_order" "DESC"
|
|
}}})
|
|
|
|
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
|
|
(defn get-order
|
|
([client location order-id]
|
|
(log/info "Searching for" (:square-location/client-location location))
|
|
(let [result (->> (client/get (str "https://connect.squareup.com/v2/orders/" order-id)
|
|
{:headers (client-base-headers client)
|
|
:as :json})
|
|
:body
|
|
)]
|
|
result)))
|
|
|
|
(defn continue-search [client location start end cursor]
|
|
(log/info "Continuing search for" cursor)
|
|
(let [result (->> (client/post "https://connect.squareup.com/v2/orders/search"
|
|
{:headers (client-base-headers client)
|
|
:body (json/write-str (cond-> {"location_ids" [(:square-location/square-id location)]
|
|
"limit" 10000
|
|
"cursor" cursor}
|
|
start (merge (pc start end))))
|
|
:as :json})
|
|
:body)]
|
|
(log/info "found " (count (:orders result)))
|
|
(if (not-empty (:cursor result))
|
|
(concat (:orders result) (continue-search client location start end (:cursor result)))
|
|
(:orders result))))
|
|
|
|
(defn search
|
|
([client location start end]
|
|
(log/info "Searching for" (:square-location/client-location location))
|
|
(let [result (->> (client/post "https://connect.squareup.com/v2/orders/search"
|
|
{:headers (client-base-headers client)
|
|
:body (json/write-str (cond-> {"location_ids" [(:square-location/square-id location)] "limit" 10000}
|
|
start (merge (pc start end))))
|
|
:as :json})
|
|
:body)]
|
|
(log/info "found " (count (:orders result)))
|
|
(if (not-empty (:cursor result))
|
|
(concat (:orders result) (continue-search client location start end (:cursor result)))
|
|
(:orders result)))))
|
|
|
|
|
|
|
|
(defn amount->money [amt]
|
|
(* 0.01 (or (:amount amt) 0.0)))
|
|
|
|
|
|
;; to get totals:
|
|
(comment
|
|
(reduce
|
|
(fn [total i]
|
|
(+ total (+ (- (:sales-order/total i)
|
|
(:sales-order/tax i)
|
|
(:sales-order/tip i)
|
|
(:sales-order/service-charge i))
|
|
(:sales-order/returns i)
|
|
|
|
(:sales-order/discount i)
|
|
)))
|
|
0.0
|
|
[]))
|
|
|
|
(defn tender->charge [order client location t]
|
|
(remove-nils
|
|
#:charge
|
|
{:type-name (:type t)
|
|
:date (coerce/to-date (time/to-time-zone (coerce/to-date-time (:created_at order)) (time/time-zone-for-id "America/Los_Angeles")))
|
|
:client (:db/id client)
|
|
:note (:note t)
|
|
:location (:square-location/client-location location)
|
|
:reference-link (str (url/url "https://squareup.com/receipt/preview" (:id t) ))
|
|
:external-id (when (:id t)
|
|
(str "square/charge/" (:id t)))
|
|
:processor (condp = (:type t)
|
|
"OTHER"
|
|
(condp = (some-> (:note t) str/lower-case)
|
|
"doordash" :ccp-processor/doordash
|
|
"dd" :ccp-processor/doordash
|
|
"ubereats" :ccp-processor/uber-eats
|
|
"ue" :ccp-processor/uber-eats
|
|
"grubhub" :ccp-processor/grubhub
|
|
"grub" :ccp-processor/grubhub
|
|
"gh" :ccp-processor/grubhub
|
|
(condp = (:name (:source order))
|
|
"GRUBHUB" :ccp-processor/grubhub
|
|
"UBEREATS" :ccp-processor/uber-eats
|
|
"DOORDASH" :ccp-processor/doordash
|
|
"Koala" :ccp-processor/koala
|
|
"koala-production" :ccp-processor/koala
|
|
:ccp-processor/na))
|
|
"CARD"
|
|
:ccp-processor/square
|
|
|
|
"SQUARE_GIFT_CARD"
|
|
:ccp-processor/square
|
|
|
|
"CASH"
|
|
:ccp-processor/na
|
|
|
|
:ccp-processor/na)
|
|
:total (amount->money (:amount_money t))
|
|
:tip (amount->money (:tip_money t))}))
|
|
|
|
(defn order->sales-order [client location order]
|
|
(let [is-order-only-for-charge?
|
|
(= ["CUSTOM_AMOUNT"]
|
|
(mapv :item_type (:line_items order )))]
|
|
(if is-order-only-for-charge?
|
|
(->> (:tenders order)
|
|
(map #(tender->charge order client location %)))
|
|
[(remove-nils
|
|
#:sales-order
|
|
{:date (coerce/to-date (time/to-time-zone (coerce/to-date-time (:created_at order)) (time/time-zone-for-id "America/Los_Angeles")))
|
|
:client (:db/id client)
|
|
:location (:square-location/client-location location)
|
|
:external-id (str "square/order/" (:client/code client) "-" (:square-location/client-location location) "-" (:id order))
|
|
:source (or (:name (:source order))
|
|
"Square")
|
|
:vendor :vendor/ccp-square
|
|
|
|
:reference-link (str (url/url "https://squareup.com/dashboard/sales/transactions" (:id order) "by-unit" (:square-location/square-id location)))
|
|
:total (-> order :net_amounts :total_money amount->money)
|
|
:tax (-> order :net_amounts :tax_money amount->money)
|
|
:tip (-> order :net_amounts :tip_money amount->money)
|
|
:discount (-> order :net_amounts :discount_money amount->money)
|
|
:service-charge (-> order :net_amounts :service_charge_money amount->money)
|
|
:returns (+ (- (-> order :return_amounts :total_money amount->money)
|
|
(-> order :return_amounts :tax_money amount->money)
|
|
(-> order :return_amounts :tip_money amount->money)
|
|
(-> order :return_amounts :service_charge_money amount->money))
|
|
(-> order :return_amounts :discount_money amount->money))
|
|
:charges (->> (:tenders order)
|
|
(map #(tender->charge order client location %)))
|
|
:line-items (->> (:line_items order)
|
|
(map-indexed (fn [i li]
|
|
(remove-nils
|
|
#:order-line-item
|
|
{:external-id (str "square/order/" (:client/code client) "-" (:square-location/client-location location) "-" (:id order) "-" i)
|
|
:item-name (:name li)
|
|
:category (if (= "GIFT_CARD" (:item_type li))
|
|
"Gift Card"
|
|
(item-id->category-name client (:catalog_object_id li)))
|
|
:total (amount->money (:total_money li))
|
|
:tax (amount->money (:total_tax_money li))
|
|
:discount (amount->money (:total_discount_money li))}))))})])))
|
|
|
|
(defn daily-results
|
|
([client location]
|
|
(daily-results client location (time/plus (time/now) (time/days -45)) (time/now)))
|
|
([client location start end]
|
|
(let [search-results (search client location start end)]
|
|
(->> search-results
|
|
(filter (fn [order]
|
|
;; sometimes orders stay open in square. At least one payment
|
|
;; is needed to import, in order to avoid importing orders in-progress.
|
|
(and
|
|
(or (> (count (:tenders order)) 0)
|
|
(seq (:returns order)))
|
|
(or (= #{} (set (map #(:status (:card_details %)) (:tenders order))))
|
|
(not= #{} (set/difference
|
|
(set (map #(:status (:card_details %)) (:tenders order)))
|
|
#{"FAILED" "VOIDED"}))))))
|
|
(mapcat #(order->sales-order client location %))))))
|
|
|
|
|
|
(defn retry
|
|
([f] (retry f 0))
|
|
([f i]
|
|
(if (< i 5)
|
|
(try
|
|
(f)
|
|
(catch Exception e
|
|
(log/warn "error pulling http " e)
|
|
(retry f (inc i))))
|
|
(log/warn "Too many failures"))))
|
|
|
|
(defn get-payment [client p]
|
|
(:payment (:body (retry #(client/get (str "https://connect.squareup.com/v2/payments/" p)
|
|
{:headers (client-base-headers client)
|
|
:as :json
|
|
:retry-handler retry-4})))))
|
|
(defn halt-if-error [x]
|
|
(if (instance? Throwable x)
|
|
(throw x)
|
|
x))
|
|
|
|
(defn get-settlement-details [client location settlements] ;; pairs of [location settlement]
|
|
(log/info "getting settlement details for " settlements)
|
|
(let [concurrent 4
|
|
output-chan (async/chan)]
|
|
(async/pipeline-blocking concurrent
|
|
output-chan
|
|
(map (fn [s]
|
|
(lc/with-context {:source "Square settlements loading "}
|
|
(log/info "Looking up settlement " s " for location " (:square-location/client-location location))
|
|
(:body (retry #(client/get (str "https://connect.squareup.com/v1/" (:square-location/square-id location) "/settlements/" (:id s))
|
|
{:headers (client-base-headers client)
|
|
:as :json
|
|
:retry-handler retry-4}))))))
|
|
(async/to-chan! settlements)
|
|
true
|
|
(fn [e]
|
|
(lc/with-context {:source "Square settlements loading "}
|
|
(log/warn "Error loading settlements details" e)
|
|
e)))
|
|
(->> (async/<!! (async/into [] output-chan))
|
|
(map halt-if-error))))
|
|
|
|
(defn settlements
|
|
([client location] (settlements client location (lookup-dates)))
|
|
([client location lookup-dates]
|
|
(log/info "Searching for" (:square-location/client-location location))
|
|
(->> lookup-dates
|
|
(mapcat (fn [[start-date end-date]]
|
|
(log/info "looking up settlements for " (:square-location/client-location location) " on dates " start-date " to " end-date)
|
|
(let [settlements (->> (retry #(client/get (str "https://connect.squareup.com/v1/" (:square-location/square-id location) "/settlements")
|
|
{:headers (client-base-headers client)
|
|
:query-params {"begin_time" start-date
|
|
"end_time" end-date}
|
|
:as :json
|
|
:retry-handler retry-4}))
|
|
:body)]
|
|
settlements)))
|
|
set
|
|
seq
|
|
(get-settlement-details client location))))
|
|
|
|
(defn daily-settlements
|
|
([client location]
|
|
(->> (for [settlement (settlements client location)
|
|
:let [best-sales-date (->> (d/q '[:find ?s4 (count ?s)
|
|
:in $ ?settlement-id
|
|
:where
|
|
[?settlement :expected-deposit/external-id ?settlement-id]
|
|
[?settlement :expected-deposit/charges ?c]
|
|
[?s :sales-order/charges ?c]
|
|
[?s :sales-order/date ?sales-date]
|
|
[(clj-time.coerce/to-date-time ?sales-date) ?s2]
|
|
[(auto-ap.time/localize ?s2) ?s3]
|
|
[(clj-time.coerce/to-local-date ?s3) ?s4]]
|
|
(d/db conn)
|
|
(str "square/settlement/" (:id settlement)))
|
|
(sort-by last)
|
|
last
|
|
first
|
|
coerce/to-date)]]
|
|
#:expected-deposit {:external-id (str "square/settlement/" (:id settlement))
|
|
:vendor :vendor/ccp-square
|
|
:status :expected-deposit-status/pending
|
|
:total (amount->money (:total_money settlement))
|
|
:client (:db/id client)
|
|
:location (:square-location/client-location location)
|
|
:fee (- (reduce + 0.0 (map (fn [entry]
|
|
(if (= (:type entry) "REFUND")
|
|
(- (amount->money (:fee_money entry)))
|
|
(amount->money (:fee_money entry))))
|
|
(:entries settlement))))
|
|
:date (-> (:initiated_at settlement)
|
|
(coerce/to-date))
|
|
:sales-date (or best-sales-date
|
|
(-> (:initiated_at settlement)
|
|
(coerce/to-date)))
|
|
:charges (->> (:entries settlement)
|
|
(filter :payment_id)
|
|
(map (fn [p] {:charge/external-id (str "square/charge/" (:payment_id p))})))})
|
|
|
|
(filter :expected-deposit/date))))
|
|
|
|
(defn refunds
|
|
([client l]
|
|
(let [refunds (:refunds (:body (client/get (str "https://connect.squareup.com/v2/refunds?location_id=" (:square-location/square-id l))
|
|
{:headers (client-base-headers client)
|
|
:as :json
|
|
:retry-handler retry-4})))]
|
|
(->> refunds
|
|
(filter (fn [r] (= "COMPLETED" (:status r))))
|
|
(map (fn [r]
|
|
#:sales-refund {:external-id (str "square/refund/" (:id r))
|
|
:vendor :vendor/ccp-square
|
|
:total (amount->money (:amount_money r))
|
|
:fee (transduce
|
|
(comp (filter #(= "ADJUSTMENT" (:type %)))
|
|
(map :amount_money)
|
|
(map amount->money))
|
|
+
|
|
0.0
|
|
(:processing_fee r))
|
|
:client (:db/id client)
|
|
:location (:square-location/client-location l)
|
|
:date (coerce/to-date (:created_at r))
|
|
:type (:source_type (get-payment client (:payment_id r)))}))))))
|
|
|
|
(defn upsert
|
|
([client ]
|
|
(doseq [square-location (:client/square-locations client)
|
|
:when (:square-location/client-location square-location)]
|
|
(upsert client square-location (time/plus (time/now) (time/days -45)) (time/now))))
|
|
([client location start end]
|
|
(lc/with-context {:source "Square loading"}
|
|
(doseq [x (partition-all 20 (daily-results client location start end))]
|
|
(log/info "Loading " (count x))
|
|
@(d/transact conn x)))))
|
|
|
|
(defn upsert-settlements
|
|
([client]
|
|
(doseq [square-location (:client/square-locations client)
|
|
:when (:square-location/client-location square-location)]
|
|
(upsert-settlements client square-location)))
|
|
([client location]
|
|
(lc/with-context {:source "Square settlements loading"
|
|
:client (:client/code client)}
|
|
(doseq [x (partition-all 20 (daily-settlements client location))]
|
|
(log/info "Loading expected deposit" (count x))
|
|
@(d/transact conn x))
|
|
(log/info "Done loading settlements"))))
|
|
|
|
(defn upsert-refunds
|
|
([client]
|
|
(doseq [square-location (:client/square-locations client)
|
|
:when (:square-location/client-location square-location)]
|
|
(upsert-refunds client square-location)))
|
|
([client location]
|
|
(lc/with-context {:source "Loading Square Settlements"
|
|
:client (:client/code client)
|
|
:location (:square-location/client-location client)}
|
|
(doseq [x (partition-all 20 (refunds client location))]
|
|
(log/info "Loading refund" (count x))
|
|
@(d/transact conn x))
|
|
(log/info "Done loading refunds"))))
|
|
|
|
(def square-read [:db/id
|
|
:client/code
|
|
:client/square-auth-token
|
|
{:client/square-locations [:db/id :square-location/name :square-location/square-id :square-location/client-location]}])
|
|
|
|
(defn get-square-clients
|
|
([]
|
|
(d/q '[:find [(pull ?c [:db/id
|
|
:client/square-integration-status
|
|
:client/code
|
|
:client/square-auth-token
|
|
{:client/square-locations [:db/id :square-location/name :square-location/square-id :square-location/client-location]}]) ...]
|
|
:in $
|
|
:where [?c :client/square-auth-token]
|
|
[?c :client/feature-flags "new-square"]]
|
|
(d/db conn)))
|
|
([ & codes]
|
|
(d/q '[:find [(pull ?c [:db/id
|
|
:client/code
|
|
:client/square-auth-token
|
|
{:client/square-locations [:db/id :square-location/name :square-location/square-id :square-location/client-location]}]) ...]
|
|
:in $ [?code ...]
|
|
:where [?c :client/square-auth-token]
|
|
[?c :client/feature-flags "new-square"]
|
|
[?c :client/code ?code]]
|
|
(d/db conn)
|
|
codes)))
|
|
|
|
(defn upsert-locations
|
|
([] (doseq [client (get-square-clients)]
|
|
(upsert-locations client)))
|
|
([client]
|
|
(let [square-id->id (into {}
|
|
(map
|
|
(fn [sl]
|
|
[(:square-location/square-id sl)
|
|
(:db/id sl)])
|
|
(:client/square-locations client)))]
|
|
(->> (for [square-location (client-locations client)]
|
|
{:db/id (or (square-id->id (:id square-location)) (d/tempid :db.part/user))
|
|
:client/_square-locations (:db/id client)
|
|
:square-location/name (:name square-location)
|
|
:square-location/square-id (:id square-location)})
|
|
(d/transact conn)
|
|
deref))))
|
|
|
|
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
|
|
(defn reset []
|
|
(->>
|
|
(d/query {:query {:find ['?e]
|
|
:in ['$]
|
|
:where ['(or [?e :sales-order/date]
|
|
[?e :expected-deposit/date])]}
|
|
:args [(d/db conn)]})
|
|
(map first)
|
|
(map (fn [x] [:db/retractEntity x]))))
|
|
|
|
(defn mark-integration-status [client integration-status]
|
|
@(d/transact conn
|
|
[{:db/id (:db/id client)
|
|
:client/square-integration-status (assoc integration-status
|
|
:db/id (or (-> client :client/square-integration-status :db/id)
|
|
#db/id [:db.part/user]))}]))
|
|
|
|
(defn upsert-all [ & clients]
|
|
(doseq [client (apply get-square-clients clients)
|
|
:when (seq (filter :square-location/client-location (:client/square-locations client)))]
|
|
(lc/with-context {:client (:client/code client)}
|
|
(log/info "Importing square2 " (:client/code client))
|
|
(mark-integration-status client {:integration-status/last-attempt (coerce/to-date (time/now))})
|
|
|
|
(try+
|
|
(upsert-locations client)
|
|
(upsert client)
|
|
(upsert-settlements client)
|
|
(upsert-refunds client)
|
|
(mark-integration-status client {:integration-status/state :integration-state/success
|
|
:integration-status/last-updated (coerce/to-date (time/now))})
|
|
|
|
(catch [:status 401] data
|
|
(mark-integration-status client {:integration-status/state :integration-state/unauthorized
|
|
:integration-status/message (-> data :body str)}))
|
|
|
|
(catch [:status 503] data
|
|
(mark-integration-status client {:integration-status/state :integration-state/failed
|
|
:integration-status/message (-> data :body str)}))
|
|
|
|
(catch Object _
|
|
(log/warn &throw-context)
|
|
(mark-integration-status client {:integration-status/state :integration-state/failed
|
|
:integration-status/message (or (some-> (:wrapper &throw-context) (.getMessage ))
|
|
(some-> (:object &throw-context) str)
|
|
"Unknown error")}))))))
|
|
|