diff --git a/README.md b/README.md index cc3bd5b..d4998d0 100644 --- a/README.md +++ b/README.md @@ -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: diff --git a/src/dil_demo/core.clj b/src/dil_demo/core.clj index 72e94be..d1def5b 100644 --- a/src/dil_demo/core.clj +++ b/src/dil_demo/core.clj @@ -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 @@ -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"))}})) diff --git a/src/dil_demo/ishare/client.clj b/src/dil_demo/ishare/client.clj index 2855604..79c12eb 100644 --- a/src/dil_demo/ishare/client.clj +++ b/src/dil_demo/ishare/client.clj @@ -353,8 +353,10 @@ 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 @@ -362,6 +364,7 @@ When bearer token is not needed, provide a `nil` token" :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)}) @@ -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" diff --git a/src/dil_demo/tms.clj b/src/dil_demo/tms.clj index 03716c6..35dba2d 100644 --- a/src/dil_demo/tms.clj +++ b/src/dil_demo/tms.clj @@ -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))) diff --git a/src/dil_demo/tms/web.clj b/src/dil_demo/tms/web.clj index ce48870..b42a2f9 100644 --- a/src/dil_demo/tms/web.clj +++ b/src/dil_demo/tms/web.clj @@ -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))))))