Skip to content

Commit

Permalink
Register delegations evidence for outsourcing in AR
Browse files Browse the repository at this point in the history
  • Loading branch information
Remco van 't Veer committed Jun 14, 2024
1 parent 80d8996 commit 74e5de8
Show file tree
Hide file tree
Showing 5 changed files with 160 additions and 80 deletions.
22 changes: 12 additions & 10 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,19 +52,21 @@ WMS:

TMS 1:

- `TMS1_EORI`: EORI used by TMS 1
- `TMS1_KEY_FILE`: the file to read the TMS 1 private key from
- `TMS1_CHAIN_FILE`: the file to read the TMS 1 certificate chain from
- `TMS1_AR_ID`: EORI of the TMS 1 authorization register
- `TMS1_AR_ENDPOINT`: URL to the TMS 1 authorization register
- `TMS1_EORI`: EORI
- `TMS1_KEY_FILE`: the file to read the private key from
- `TMS1_CHAIN_FILE`: the file to read the certificate chain from
- `TMS1_AR_ID`: EORI of the authorization register
- `TMS1_AR_ENDPOINT`: URL to the authorization register
- `TMS1_AR_TYPE`: type of authorization register (ishare or poort8)

TMS 2:

- `TMS2_EORI`: EORI used by TMS 2
- `TMS2_KEY_FILE`: the file to read the TMS 2 private key from
- `TMS2_CHAIN_FILE`: the file to read the TMS 2 certificate chain from
- `TMS2_AR_ID`: EORI of the TMS 2 authorization register
- `TMS2_AR_ENDPOINT`: URL to the TMS 2 authorization register
- `TMS2_EORI`: EORI
- `TMS2_KEY_FILE`: the file to read the private key from
- `TMS2_CHAIN_FILE`: the file to read the certificate chain from
- `TMS2_AR_ID`: EORI of the authorization register
- `TMS2_AR_ENDPOINT`: URL to the authorization register
- `TMS1_AR_TYPE`: type of authorization register (ishare or poort8)

Run the web server with the following:

Expand Down
2 changes: 2 additions & 0 deletions src/dil_demo/core.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,7 @@
:satellite-endpoint satellite-endpoint
:ar-id (get-env "TMS1_AR_ID")
:ar-endpoint (get-env "TMS1_AR_ENDPOINT")
:ar-type (get-env "TMS1_AR_TYPE")
:key-file (get-env "TMS1_KEY_FILE" (str "credentials/" tms-1-eori ".pem"))
:chain-file (get-env "TMS1_CHAIN_FILE" (str "credentials/" tms-1-eori ".crt"))}
:tms-2 {:eori tms-2-eori
Expand All @@ -62,6 +63,7 @@
:satellite-endpoint satellite-endpoint
:ar-id (get-env "TMS2_AR_ID")
:ar-endpoint (get-env "TMS2_AR_ENDPOINT")
:ar-type (get-env "TMS2_AR_TYPE")
:key-file (get-env "TMS2_KEY_FILE" (str "credentials/" tms-2-eori ".pem"))
:chain-file (get-env "TMS2_CHAIN_FILE" (str "credentials/" tms-2-eori ".crt"))}}))

Expand Down
12 changes: 10 additions & 2 deletions src/dil_demo/ishare/client.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -353,15 +353,18 @@ When bearer token is not needed, provide a `nil` token"



(defn ->client-data [{:keys [eori key-file chain-file dataspace-id
ar-id ar-endpoint
(defn ->client-data [{:keys [eori
dataspace-id
key-file chain-file
ar-id ar-endpoint ar-type
satellite-id satellite-endpoint]}]
{:ishare/client-id eori
:ishare/dataspace-id dataspace-id
:ishare/satellite-id satellite-id
:ishare/satellite-endpoint satellite-endpoint
:ishare/authentication-registry-id ar-id
:ishare/authentication-registry-endpoint ar-endpoint
:ishare/authentication-registry-type (keyword ar-type)
:ishare/private-key (private-key key-file)
:ishare/x5c (x5c chain-file)})

Expand All @@ -379,6 +382,11 @@ When bearer token is not needed, provide a `nil` token"
:ishare/x5c (x5c "credentials/EU.EORI.NLSMARTPHON.crt")
:ishare/private-key (private-key "credentials/EU.EORI.NLSMARTPHON.pem")})

(def client-data
{:ishare/client-id "EU.EORI.NLFLEXTRANS"
:ishare/x5c (x5c "credentials/EU.EORI.NLFLEXTRANS.crt")
:ishare/private-key (private-key "credentials/EU.EORI.NLFLEXTRANS.pem")})

(def ishare-ar-request
{:ishare/endpoint "https://ar.isharetest.net/"
:ishare/server-id "EU.EORI.NL000000004"
Expand Down
195 changes: 131 additions & 64 deletions src/dil_demo/tms.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,76 +20,143 @@
[m path coll]
(update-in m path (fnil into []) coll))

(defn- ishare-exec-with-log
"Execute ishare command and update response.
Inserts :ishare/result in response
http request log will be put in the [:flash :ishare-log]
if an exception occurs, it will be logged, and noted in [:flash :error]"
[response command]
(let [response (binding [ishare-client/log-interceptor-atom (atom [])]
(try
(let [result (:ishare/result (ishare-client/exec command))]
(-> response
(append-in [:flash :ishare-log] @ishare-client/log-interceptor-atom)
(assoc :ishare/result result)))
(catch Exception ex
(log/error ex)
(-> response
(append-in [:flash :ishare-log] @ishare-client/log-interceptor-atom)
(assoc-in [:flash :error] (str "Fout bij uitvoeren van iShare commando " (:ishare/message-type ex)))))))]
response))

(defn- trip-stored
"Returns the trip that will be stored from the response."
[{::store/keys [commands]}]
(when-let [cmd (first (filter #(= [:put! :trips] (take 2 %)) commands))]
(nth cmd 2)))

(defn- trip-deleted-id
"Returns the trip id that will be deleted from the response."
[{::store/keys [commands]}]
(when-let [cmd (first (filter #(= [:delete! :trips] (take 2 %)) commands))]
(nth cmd 2)))

(defn- wrap-policy-deletion
"When a trip is added or deleted, retract existing policies in the AR."
[app]
(fn policy-deletion-wrapper
[{:keys [client-data ::store/store] :as req}]
(let [response (app req)
trip (or (trip-stored response)
(get-in store [:trips (trip-deleted-id response)]))]
(if-let [policy-id (and trip (get-in store [:trip-policies (otm/trip-ref trip) :policy-id]))]
(ishare-exec-with-log response (-> client-data
(assoc :ishare/message-type :poort8/delete-policy
:ishare/params {:policyId policy-id}
:throw false ;; ignore HTTP errors
)))
response))))


(defn- ishare-exec! [{:keys [client-data] :as req} cmd]
(binding [ishare-client/log-interceptor-atom (atom [])]
(try
(let [result (:ishare/result (ishare-client/exec (merge client-data cmd)))]
(-> req
(append-in [:flash :ishare-log] @ishare-client/log-interceptor-atom)
(assoc :ishare/result result)))
(catch Exception ex
(log/error ex)
(-> req
(append-in [:flash :ishare-log] @ishare-client/log-interceptor-atom)
(assoc-in [:flash :error] (str "Fout bij uitvoeren van iShare commando " (:ishare/message-type ex))))))))



(defn- ->ar-type
[{{:ishare/keys [authentication-registry-type]} :client-data} & _]
authentication-registry-type)

(defn- ishare-create-policy-command
[{{:ishare/keys [client-id]} :client-data} subject trip effect]
{:pre [(#{"Deny" "Permit"} effect)]}
{:ishare/message-type :ishare/policy
:ishare/params (policies/->delegation-evidence
{:issuer client-id
:subject subject
:target (policies/->delegation-target (otm/trip-ref trip))
:date (otm/trip-load-date trip)
:effect effect})})

(defmulti delete-policy-for-trip! ->ar-type)

(defmethod delete-policy-for-trip! :poort8
[{:keys [::store/store] :as req} {:keys [id] :as _trip} _subject]
(if-let [policy-id (get-in store [:trip-policies id :policy-id])]
(-> req
(ishare-exec! {:throw false ;; ignore HTTP errors for when
;; policy already deleted

:ishare/message-type :poort8/delete-policy
:ishare/params {:policyId policy-id}})
(append-in [::store/commands]
[[:delete! :trip-policies id]]))
req))

(defmethod delete-policy-for-trip! :ishare
[req trip subject]
(ishare-exec! req
(ishare-create-policy-command req subject trip "Deny")))

(defmulti create-policy-for-trip! ->ar-type)

(defmethod create-policy-for-trip! :poort8
[req {:keys [id] :as trip} subject]
(let [cmd
{:ishare/message-type :poort8/policy
:ishare/params
(policies/->poort8-policy
{:consignment-ref (otm/trip-ref trip)
:date (otm/trip-load-date trip)
:subject subject})}
res (ishare-exec! req cmd)]

(if-let [policy-id (get-in res [:ishare/result "policyId"])]
(append-in res [::store/commands]
[[:put! :trip-policies {:id id, :policy-id policy-id}]])
res)))

(defmethod create-policy-for-trip! :ishare
[req trip subject]
(ishare-exec! req
(ishare-create-policy-command req subject trip "Permit")))

(defmulti delegation-effect!
"Apply delegation effects from store commands."
(fn [_req [cmd type & _args]] [cmd type]))

(defmethod delegation-effect! [:delete! :trips]
[{:keys [::store/store] :as req} [_ _ id]]
(if-let [trip (get-in store [:trips id])]
(cond-> req
(and (otm/trip-driver-id-digits trip) (otm/trip-license-plate trip))
(delete-policy-for-trip! trip
(policies/pickup-access-subject (otm/trip->map trip)))

:and
(delete-policy-for-trip! trip
(policies/outsource-pickup-access-subject (otm/trip->map trip))))
req))

(defmethod delegation-effect! [:put! :trips]
[{:keys [::store/store] :as req} [_ _ trip]]
(let [old-trip (get-in store [:trips (:id trip)])]

(cond-> req
;; delete pre existing driver/pickup policy
(and (otm/trip-driver-id-digits old-trip) (otm/trip-license-plate old-trip))
(delete-policy-for-trip! old-trip
(policies/pickup-access-subject (otm/trip->map old-trip)))

;; create driver/pickup policy
(and (otm/trip-driver-id-digits trip) (otm/trip-license-plate trip))
(create-policy-for-trip! trip
(policies/pickup-access-subject (otm/trip->map trip))))))

(defmethod delegation-effect! [:publish! :trips]
[req [_ _ other-eori trip]]
(let [sub (policies/outsource-pickup-access-subject
(-> trip
(otm/trip->map)
(assoc :carrier-eori other-eori)))

;; remove already existing policy
res (delete-policy-for-trip! req trip)]

;; create outsource policy
(create-policy-for-trip! res trip sub)))

;; do nothing for other store commands
(defmethod delegation-effect! :default [req & _] req)



(defn- wrap-delegation
"Create policies in AR when trip is stored."
[app]
(fn delegation-wrapper [{:keys [client-data] :as req}]
(let [response (app req)
trip (trip-stored response)]
(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
:ishare/params (policies/->poort8-policy {:consignment-ref (otm/trip-ref trip)
:date (otm/trip-load-date trip)
:subject subject}))))]
(if-let [policy-id (get-in response [:ishare/result "policyId"])]
(append-in response [::store/commands] [[:put! :trip-policies {:id (otm/trip-ref trip)
:policy-id policy-id}]])
response))
;; no valid driver ref, so don't create a policy
response))))
(fn delegation-wrapper [{:keys [client-data ::store/store] :as req}]
(let [{::store/keys [commands] :as res} (app req)]
(reduce delegation-effect!
(assoc res
:client-data client-data
::store/store store)
commands))))

(defn make-handler [config]
(-> (tms.web/make-handler config)
(wrap-policy-deletion)
(wrap-delegation)
(ishare-client/wrap-client-data config)))
9 changes: 5 additions & 4 deletions src/dil_demo/tms/web.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -305,10 +305,11 @@
(assoc ::store/commands [[:put! :trips (otm/trip-status! trip otm/status-outsourced)]
[:publish! :trips carrier-eori trip]])))))

(GET "/outsourced-:id" {:keys [flash master-data]
::store/keys [store]
{:keys [id]} :params}
(GET "/outsourced-:id" {:keys [flash]
::store/keys [store]
{:keys [id]} :params
{:keys [ishare-log]} :flash}
(when-let [trip (get-trip store id)]
(render "Transportopdracht uitbesteed"
(outsourced-trip trip master-data)
(outsourced-trip trip {:ishare-log ishare-log})
flash))))))

0 comments on commit 74e5de8

Please sign in to comment.