WIP

Basic-Data-Infrastructure · Jun 12, 2024 · 96a5ff2 · 96a5ff2
1 parent 727282a
commit 96a5ff2
Show file tree

Hide file tree

Showing 4 changed files with 53 additions and 49 deletions.
diff --git a/src/dil_demo/erp.clj b/src/dil_demo/erp.clj
@@ -19,7 +19,7 @@
   {:pre [client-id effect ref load-date]}
   (policies/->delegation-evidence
    {:issuer  client-id
-    :subject (policies/ishare-delegation-access-subject m)
+    :subject (policies/outsource-pickup-access-subject m)
     :target  (policies/->delegation-target ref)
     :date    load-date
     :effect  effect}))
@@ -31,8 +31,8 @@
   (assoc client-data
          :ishare/message-type :ishare/policy
          :ishare/params (map->delegation-evidence client-id
-                                                  effect
-                                                  obj)))
+                                                    effect
+                                                    obj)))
 
 (defn- ishare-ar! [client-data effect obj]
   (binding [ishare-client/log-interceptor-atom (atom [])]

diff --git a/src/dil_demo/ishare/policies.clj b/src/dil_demo/ishare/policies.clj
@@ -159,14 +159,16 @@
       :finally
       (seq))))
 
-(defn ishare-delegation-access-subject
-  "Hack around short coming of iSHARE AR; uniqueness on accessSubject and policyIssuer."
+(defn outsource-pickup-access-subject
+  "Returns an \"accessSubject\" to denote a pickup is outsourced to some
+  party."
   [{:keys [carrier-eori ref]}]
   {:pre [carrier-eori ref]}
-  (str carrier-eori ":" ref))
+  (str carrier-eori "#ref=" ref))
 
-(defn poort8-delegation-access-subject
-  "Returns driver ID license-plate access subject."
-  [{:keys [driver-id-digits license-plate]}]
+(defn pickup-access-subject
+  "Returns an \"accessSubject\" to denote a pickup will be done by a
+  driver / vehicle."
+  [{:keys [carrier-eori driver-id-digits license-plate]}]
   {:pre [driver-id-digits license-plate]}
-  (str driver-id-digits "|" license-plate))
+  (str carrier-eori "#driver-id-digits=" driver-id-digits "&license-plate=" license-plate))
diff --git a/src/dil_demo/tms.clj b/src/dil_demo/tms.clj
@@ -74,7 +74,7 @@
   (fn delegation-wrapper [{:keys [client-data] :as req}]
     (let [response (app req)
           trip     (trip-stored response)]
-      (if-let [subject (and trip (policies/poort8-delegation-access-subject (otm/trip->map trip)))]
+      (if-let [subject (and trip (policies/pickup-access-subject (otm/trip->map trip)))]
         (let [response (ishare-exec-with-log response
                                              (-> client-data
                                                  (assoc :ishare/message-type :poort8/policy

diff --git a/src/dil_demo/wms/verify.clj b/src/dil_demo/wms/verify.clj
@@ -10,55 +10,57 @@
             [dil-demo.ishare.policies :as policies]
             [dil-demo.otm :as otm]))
 
-(defn verify-owner
-  "Ask AR of owner if carrier is allowed to pickup order."
-  [client-data transport-order params]
+(defn rejection-reasons [client-data {:keys [issuer target mask]}]
   (try
-
-    (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/ishare-delegation-access-subject params)
-                                              :target  target})]
-      (-> client-data
-          (assoc :ishare/message-type :delegation
-                 :ishare/policy-issuer issuer ;; ensures we target the right server (AR)
-                 :ishare/params mask)
-          ishare-client/exec
-          :ishare/result
-          :delegationEvidence
-          (policies/rejection-reasons target)))
+    (-> client-data
+        (assoc :ishare/policy-issuer issuer ;; ensures we target the right AR
+               :ishare/message-type :delegation
+               :ishare/params mask)
+        ishare-client/exec
+        :ishare/result
+        :delegationEvidence
+        (policies/rejection-reasons target))
     (catch Throwable ex
+      (prn ex)
       [(str "Technische fout opgetreden: " (.getMessage ex))])))
 
-(defn verify-carrier
-  "Ask AR of carrier if driver is allowed to pickup order."
-  [client-data transport-order {:keys [carrier-eori] :as params}]
+(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]}
 
-  (try
-    (let [target (policies/->delegation-target (otm/transport-order-ref transport-order))
-          mask   (policies/->delegation-mask {:subject (policies/poort8-delegation-access-subject params)
-                                              :target  target
-                                              ;; FEEDBACK: Kunnen we er vanuit gaan dat issuer
-                                              ;; en dataspace id samen de AR bepalen?
-                                              :issuer  carrier-eori})]
-      (-> client-data
-          (assoc :ishare/message-type :delegation
-                 :ishare/policy-issuer carrier-eori
-                 :ishare/params mask)
-          ishare-client/exec
-          :ishare/result
-          :delegationEvidence
-          (policies/rejection-reasons target)))
-    (catch Throwable ex
-      [(str "Technische fout opgetreden: " (.getMessage ex))])))
+  (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})]
+    (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]}
+
+  (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})))
 
 (defn verify! [client-data transport-order params]
   (binding [ishare-client/log-interceptor-atom (atom [])]
     (let [owner-rejections (verify-owner client-data transport-order params)]
       {:owner-rejections   owner-rejections
        :carrier-rejections (when-not owner-rejections
-                             (verify-carrier client-data transport-order params))
+                             (verify-carrier-pickup client-data transport-order params))
        :ishare-log         @ishare-client/log-interceptor-atom})))
 
 (defn permitted? [{:keys [owner-rejections carrier-rejections]}]