Skip to content

Commit

Permalink
Verify outsourced transport order
Browse files Browse the repository at this point in the history
  • Loading branch information
Remco van 't Veer committed Jun 17, 2024
1 parent d6aab6e commit c15e9d2
Show file tree
Hide file tree
Showing 2 changed files with 50 additions and 33 deletions.
66 changes: 42 additions & 24 deletions src/dil_demo/wms/verify.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@
;;; SPDX-License-Identifier: AGPL-3.0-or-later

(ns dil-demo.wms.verify
(:require [dil-demo.ishare.client :as ishare-client]
(:require [clojure.string :as string]
[dil-demo.ishare.client :as ishare-client]
[dil-demo.ishare.policies :as policies]
[dil-demo.otm :as otm]))

Expand All @@ -27,40 +28,57 @@
(defn verify-owner
"Ask AR of owner if carrier is allowed to pickup order. Return list of
rejection reasons or nil well access is allowed."
[client-data transport-order
{:keys [carrier-eori ref] :as params}]
{:pre [carrier-eori ref]}
[client-data transport-order {:keys [carrier-eoris]}]
{:pre [(seq carrier-eoris)]}

(let [issuer (otm/transport-order-owner-eori transport-order)
target (policies/->delegation-target (otm/transport-order-ref transport-order))
mask (policies/->delegation-mask {:issuer issuer
:subject (policies/outsource-pickup-access-subject params)
:target target})]
(let [issuer (otm/transport-order-owner-eori transport-order)
ref (otm/transport-order-ref transport-order)
target (policies/->delegation-target ref)
subject (policies/outsource-pickup-access-subject {:ref ref
:carrier-eori (first carrier-eoris)})
mask (policies/->delegation-mask {:issuer issuer
:subject subject
:target target})]
(rejection-reasons client-data {:issuer issuer
:target target
:mask mask})))

(defn verify-carrier-pickup
"Ask AR of carrier if driver is allowed to pickup order. Return list
of rejection reasons or nil well access is allowed."
[client-data transport-order
{:keys [carrier-eori driver-id-digits license-plate] :as params}]
{:pre [carrier-eori driver-id-digits license-plate]}
(defn verify-carriers
"Ask AR of carriers if sourced to next or, if last, driver is allowed
to pickup order. Return list of rejection reasons or nil well access
is allowed."
[client-data transport-order {:keys [carrier-eoris driver-id-digits license-plate]}]
{:pre [(seq carrier-eoris) driver-id-digits license-plate]}

(let [target (policies/->delegation-target (otm/transport-order-ref transport-order))
mask (policies/->delegation-mask {:issuer carrier-eori
:subject (policies/pickup-access-subject params)
:target target})]
(rejection-reasons client-data {:issuer carrier-eori
:target target
:mask mask})))
(let [ref (otm/transport-order-ref transport-order)
target (policies/->delegation-target ref)]
(loop [carrier-eoris carrier-eoris
result []]
(if (seq carrier-eoris)
(let [carrier-eori (first carrier-eoris)
subject (if (= 1 (count carrier-eoris))
(policies/pickup-access-subject {:driver-id-digits driver-id-digits
:license-plate license-plate
:carrier-eori carrier-eori})
(policies/outsource-pickup-access-subject {:ref ref
:carrier-eori (second carrier-eoris)}))
mask (policies/->delegation-mask {:issuer carrier-eori
:subject subject
:target target})]
(recur (next carrier-eoris)
(concat result
(rejection-reasons client-data
{:issuer carrier-eori
:target target
:mask mask}))))
(seq result)))))

(defn verify! [client-data transport-order params]
(binding [ishare-client/log-interceptor-atom (atom [])]
(let [owner-rejections (verify-owner client-data transport-order params)]
(let [owner-rejections (verify-owner client-data transport-order (pk params))]
{:owner-rejections owner-rejections
:carrier-rejections (when-not owner-rejections
(verify-carrier-pickup client-data transport-order params))
(verify-carriers client-data transport-order params))
:ishare-log @ishare-client/log-interceptor-atom})))

(defn permitted? [{:keys [owner-rejections carrier-rejections]}]
Expand Down
17 changes: 8 additions & 9 deletions src/dil_demo/wms/web.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,10 +75,10 @@


[:div.actions
(qr-code-scan-button "carrier-eori" "driver-id-digits" "license-plate")]
(qr-code-scan-button "carrier-eoris" "driver-id-digits" "license-plate")]

(w/field {:id "carrier-eori"
:name "carrier-eori", :label "Vervoerder EORI"
(w/field {:id "carrier-eoris"
:name "carrier-eoris", :label "Vervoerder EORI"
:required true})
(w/field {:id "driver-id-digits"
:name "driver-id-digits", :label "Rijbewijs",
Expand All @@ -96,7 +96,7 @@
[:a.button {:href "."} "Annuleren"]]]))

(defn accepted-transport-order [transport-order
{:keys [carrier-eori driver-id-digits license-plate]}
{:keys [carrier-eoris driver-id-digits license-plate]}
{:keys [ishare-log]}]
[:div
[:section
Expand All @@ -105,7 +105,7 @@
"Transportopdracht "
[:q (otm/transport-order-ref transport-order)]
" goedgekeurd voor vervoerder met EORI "
[:q carrier-eori]
[:q carrier-eoris]
", chauffeur met rijbewijs eindigend op "
[:q driver-id-digits]
" en kenteken "
Expand All @@ -118,7 +118,7 @@
[:ol (w/ishare-log-intercept-to-hiccup ishare-log)]]])

(defn rejected-transport-order [transport-order
{:keys [carrier-eori driver-id-digits license-plate]}
{:keys [carrier-eoris driver-id-digits license-plate]}
{:keys [ishare-log
owner-rejections
carrier-rejections]}]
Expand All @@ -131,7 +131,7 @@
"Transportopdracht "
[:q (otm/transport-order-ref transport-order)]
" is AFGEKEURD voor vervoerder met EORI "
[:q carrier-eori]
[:q carrier-eoris]
"."]
[:ul.rejections
(for [rejection owner-rejections]
Expand Down Expand Up @@ -202,8 +202,7 @@
::store/keys [store]
{:keys [id] :as params} :params}
(when-let [transport-order (get-transport-order store id)]
(let [params (merge (otm/transport-order->map transport-order)
(select-keys params [:carrier-eori :driver-id-digits :license-plate]))
(let [params (update params :carrier-eoris string/split #",")
result (verify/verify! client-data transport-order params)]
(if (verify/permitted? result)
(render "Transportopdracht geaccepteerd"
Expand Down

0 comments on commit c15e9d2

Please sign in to comment.