WIP

Makefile

@@ -15,9 +15,9 @@ all: clean check target/dil-demo.jar
 %.pem: %.p12
 	openssl pkcs12 -in $< -nocerts -nodes -legacy -out $@
 
-pems: credentials/EU.EORI.NLPRECIOUSG.pem credentials/EU.EORI.NLSECURESTO.pem credentials/EU.EORI.NLSMARTPHON.pem
+pems: credentials/EU.EORI.NLPRECIOUSG.pem credentials/EU.EORI.NLSECURESTO.pem credentials/EU.EORI.NLSMARTPHON.pem credentials/EU.EORI.NLFLEXTRANS.pem
 
-certs: credentials/EU.EORI.NLPRECIOUSG.crt credentials/EU.EORI.NLSECURESTO.crt credentials/EU.EORI.NLSMARTPHON.crt
+certs: credentials/EU.EORI.NLPRECIOUSG.crt credentials/EU.EORI.NLSECURESTO.crt credentials/EU.EORI.NLSMARTPHON.crt credentials/EU.EORI.NLFLEXTRANS.crt
 
 classes/dil_demo/core.class: src/dil_demo/core.clj
 	mkdir -p classes

README.md

@@ -12,8 +12,10 @@ SPDX-License-Identifier: AGPL-3.0-or-later
 This code simulates the following environments:
 
 - [erp](http://localhost:8080/erp/)
-- [tms](http://localhost:8080/tms/)
 - [wms](http://localhost:8080/wms/)
+- [tms-1](http://localhost:8080/tms-1/)
+- [tms-2](http://localhost:8080/tms-2/)
+
 
 ## Run
 
@@ -42,20 +44,28 @@ ERP:
 - `ERP_AR_ID`: EORI of the ERP authorization register
 - `ERP_AR_ENDPOINT`: URL to the ERP authorization register
 
-TMS:
-
-- `TMS_EORI`: EORI used by TMS
-- `TMS_KEY_FILE`: the file to read the TMS private key from
-- `TMS_CHAIN_FILE`: the file to read the TMS certificate chain from
-- `TMS_AR_ID`: EORI of the TMS authorization register
-- `TMS_AR_ENDPOINT`: URL to the TMS authorization register
-
 WMS:
 
 - `WMS_EORI`: EORI used by WMS
 - `WMS_KEY_FILE`: the file to read the WMS private key from
 - `WMS_CHAIN_FILE`: the file to read the WMS certificate chain from
 
+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
+
+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
+
 Run the web server with the following:
 
 ```sh

resources/public/assets/tms-1-chauffeur.css

@@ -0,0 +1 @@
+tms-1.css

resources/public/assets/tms-2-chauffeur.css

@@ -0,0 +1 @@
+tms-2.css

resources/public/assets/tms.css → resources/public/assets/tms-2.css

@@ -8,7 +8,7 @@
  */
 
 :root {
-    --color-bg: #eeb45f;
+    --color-bg: #b4ee5f;
     --color-button-primary: #f4f9c0;
     --color-button-primary-border: #bbbf93;
     --color-button-secondary: #f9c6c0;

src/dil_demo/core.clj

@@ -20,7 +20,8 @@
 (defn ->config []
   (let [erp-eori           (get-env "ERP_EORI")
         wms-eori           (get-env "WMS_EORI")
-        tms-eori           (get-env "TMS_EORI")
+        tms-1-eori         (get-env "TMS1_EORI")
+        tms-2-eori         (get-env "TMS2_EORI")
         dataspace-id       (get-env "DATASPACE_ID")
         satellite-id       (get-env "SATELLITE_ID")
         satellite-endpoint (get-env "SATELLITE_ENDPOINT")]
@@ -37,20 +38,28 @@
              :satellite-endpoint satellite-endpoint
              :key-file           (get-env "ERP_KEY_FILE" (str "credentials/" erp-eori ".pem"))
              :chain-file         (get-env "ERP_CHAIN_FILE" (str "credentials/" erp-eori ".crt"))}
-     :tms   {:eori               tms-eori
+     :wms   {:eori               wms-eori
              :dataspace-id       dataspace-id
              :satellite-id       satellite-id
              :satellite-endpoint satellite-endpoint
-             :ar-id              (get-env "TMS_AR_ID")
-             :ar-endpoint        (get-env "TMS_AR_ENDPOINT")
-             :key-file           (get-env "TMS_KEY_FILE" (str "credentials/" tms-eori ".pem"))
-             :chain-file         (get-env "TMS_CHAIN_FILE" (str "credentials/" tms-eori ".crt"))}
-     :wms   {:eori               wms-eori
+             :key-file           (get-env "WMS_KEY_FILE" (str "credentials/" wms-eori ".pem"))
+             :chain-file         (get-env "WMS_CHAIN_FILE" (str "credentials/" wms-eori ".crt"))}
+     :tms-1 {:eori               tms-1-eori
              :dataspace-id       dataspace-id
              :satellite-id       satellite-id
              :satellite-endpoint satellite-endpoint
-             :key-file           (get-env "WMS_KEY_FILE" (str "credentials/" wms-eori ".pem"))
-             :chain-file         (get-env "WMS_CHAIN_FILE" (str "credentials/" wms-eori ".crt"))}}))
+             :ar-id              (get-env "TMS1_AR_ID")
+             :ar-endpoint        (get-env "TMS1_AR_ENDPOINT")
+             :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
+             :dataspace-id       dataspace-id
+             :satellite-id       satellite-id
+             :satellite-endpoint satellite-endpoint
+             :ar-id              (get-env "TMS2_AR_ID")
+             :ar-endpoint        (get-env "TMS2_AR_ENDPOINT")
+             :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"))}}))
 
 (defonce server-atom (atom nil))
 

src/dil_demo/erp/web.clj

@@ -276,9 +276,12 @@
       (-> (str "published-" id)
           (redirect :see-other)
           (assoc :flash {:success "Transportopdracht aangemaakt"})
-          (assoc ::store/commands [[:put! :consignments (assoc consignment :status "requested")]
-                                   [:put! :transport-orders (otm/consignment->transport-order consignment)]
-                                   [:put! :trips (otm/consignment->trip consignment)]]))))
+          (assoc ::store/commands [[:put! :consignments ;; ERP
+                                    (assoc consignment :status "requested")]
+                                   [:put! :transport-orders ;; WMS
+                                    (otm/consignment->transport-order consignment)]
+                                   [:put! :trips ;; TMS
+                                    (otm/consignment->trip consignment)]]))))
 
   (GET "/published-:id" {:keys                [carriers flash ::store/store]
                          {:keys [id]}         :params

src/dil_demo/sites.clj

@@ -9,6 +9,8 @@
 
 (def sites
   [{:slug "erp", :path "/erp/", :title "ERP"}
-   {:slug "tms", :path "/tms/", :title "TMS"}
-   {:slug "tms-chauffeur", :path "/tms/chauffeur/", :title "TMS (chauffeur)"}
-   {:slug "wms", :path "/wms/", :title "WMS"}])
+   {:slug "wms", :path "/wms/", :title "WMS"}
+   {:slug "tms-1", :path "/tms-1/", :title "TMS-1"}
+   {:slug "tms-1-chauffeur", :path "/tms-1/chauffeur/", :title "TMS-1 (chauffeur)"}
+   {:slug "tms-2", :path "/tms-2/", :title "TMS-2"}
+   {:slug "tms-2-chauffeur", :path "/tms-2/chauffeur/", :title "TMS-2 (chauffeur)"}])

src/dil_demo/tms.clj

@@ -40,7 +40,7 @@
                            (assoc-in [:flash :error] (str "Fout bij uitvoeren van iShare commando " (:ishare/message-type ex)))))))]
     response))
 
-(defn- trip-added
+(defn- trip-stored
   "Returns the trip that will stored from the response"
   [{::store/keys [commands]}]
   (when-let [cmd (first (filter #(= [:put! :trips] (take 2 %)) commands))]
@@ -58,7 +58,7 @@
   (fn policy-deletion-wrapper
     [{:keys [client-data ::store/store] :as req}]
     (let [response (app req)
-          trip     (or (trip-added response)
+          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
@@ -69,11 +69,11 @@
         response))))
 
 (defn- wrap-delegation
-  "Create policies in AR when trips is created."
+  "Create policies in AR when trips is stored."
   [app]
   (fn delegation-wrapper [{:keys [client-data] :as req}]
     (let [response (app req)
-          trip     (trip-added response)]
+          trip     (trip-stored response)]
       (if-let [subject (and trip (policies/poort8-delegation-access-subject (otm/trip->map trip)))]
         (let [response (ishare-exec-with-log response
                                              (-> client-data
@@ -88,8 +88,8 @@
         ;; no valid driver ref, so don't create a policy
         response))))
 
-(defn make-handler [config]
-  (-> web/handler
+(defn make-handler [config slug]
+  (-> (web/make-handler slug)
       (wrap-policy-deletion)
       (wrap-delegation)
       (ishare-client/wrap-client-data config)))

src/dil_demo/tms/web.clj

@@ -7,7 +7,7 @@
 
 (ns dil-demo.tms.web
   (:require [clojure.string :as string]
-            [compojure.core :refer [defroutes DELETE GET POST]]
+            [compojure.core :refer [routes DELETE GET POST]]
             [dil-demo.data :as d]
             [dil-demo.otm :as otm]
             [dil-demo.store :as store]
@@ -162,71 +162,73 @@
 
 
 
-(defn render [title main flash & {:keys [site]}]
-  (w/render-body (or site "tms")
-                 main
-                 :flash flash
-                 :title title
-                 :site-name d/tms-name))
-
-(defroutes handler
-  (GET "/" {:keys [flash ::store/store]}
-    (render "Transportopdrachten"
-            (list-trips (get-trips store))
-            flash))
-
-  (GET "/chauffeur/" {:keys [flash ::store/store]}
-    (render "Transportopdrachten"
-            (chauffeur-list-trips (get-trips store))
-            flash
-            :site "tms-chauffeur"))
-
-  (GET "/chauffeur/trip-:id" {:keys [flash ::store/store]
-                              {:keys [id]} :params}
-    (when-let [trip (get-trip store id)]
-      (render (otm/trip-ref trip)
-              (chauffeur-trip trip)
-              flash
-              :site "tms-chauffeur")))
-
-  (DELETE "/trip-:id" {::store/keys [store]
-                       {:keys [id]} :params}
-    (when (get-trip store id)
-      (-> "deleted"
-          (redirect :see-other)
-          (assoc :flash {:success "Transportopdracht verwijderd"})
-          (assoc ::store/commands [[:delete! :trips id]]))))
-
-  (GET "/deleted" {{:keys [ishare-log] :as flash} :flash}
-    (render "Transportopdracht verwijderd"
-            (deleted-trip {:ishare-log ishare-log})
-            flash))
-
-  (GET "/assign-:id" {:keys        [flash]
-                      ::store/keys [store]
-                      {:keys [id]} :params}
-    (when-let [trip (get-trip store id)]
-      (render (str "Transportopdracht: " (otm/trip-ref trip))
-              (assign-trip trip)
-              flash)))
-
-  (POST "/assign-:id" {::store/keys            [store]
-                       {:keys [driver-id-digits
-                               id
-                               license-plate]} :params}
-    (when-let [trip (get-trip store id)]
-      (-> (str "assigned-" id)
-          (redirect :see-other)
-          (assoc :flash {:success "Chauffeur en kenteken toegewezen"})
-          (assoc ::store/commands [[:put! :trips (-> trip
-                                                     (otm/trip-driver-id-digits! driver-id-digits)
-                                                     (otm/trip-license-plate! license-plate))]]))))
-
-  (GET "/assigned-:id" {:keys                [flash]
-                        ::store/keys         [store]
-                        {:keys [id]}         :params
-                        {:keys [ishare-log]} :flash}
-    (when-let [trip (get-trip store id)]
-      (render (str "Transportopdracht toegewezen")
-              (assigned-trip trip {:ishare-log ishare-log})
-              flash))))
+(def ^:dynamic *slug* nil)
+
+(defn make-handler [slug]
+  (let [render (fn render [title main flash & {:keys [slug-postfix]}]
+                 (w/render-body (str slug slug-postfix)
+                                main
+                                :flash flash
+                                :title title
+                                :site-name d/tms-name))]
+    (routes
+     (GET "/" {:keys [flash ::store/store]}
+       (render "Transportopdrachten"
+               (list-trips (get-trips store))
+               flash))
+
+     (GET "/chauffeur/" {:keys [flash ::store/store]}
+       (render "Transportopdrachten"
+               (chauffeur-list-trips (get-trips store))
+               flash
+               :slug-postfix "-chauffeur"))
+
+     (GET "/chauffeur/trip-:id" {:keys [flash ::store/store]
+                                 {:keys [id]} :params}
+       (when-let [trip (get-trip store id)]
+         (render (otm/trip-ref trip)
+                 (chauffeur-trip trip)
+                 flash
+                 :slug-postfix "-chauffeur")))
+
+     (DELETE "/trip-:id" {::store/keys [store]
+                          {:keys [id]} :params}
+       (when (get-trip store id)
+         (-> "deleted"
+             (redirect :see-other)
+             (assoc :flash {:success "Transportopdracht verwijderd"})
+             (assoc ::store/commands [[:delete! :trips id]]))))
+
+     (GET "/deleted" {{:keys [ishare-log] :as flash} :flash}
+       (render "Transportopdracht verwijderd"
+               (deleted-trip {:ishare-log ishare-log})
+               flash))
+
+     (GET "/assign-:id" {:keys        [flash]
+                         ::store/keys [store]
+                         {:keys [id]} :params}
+       (when-let [trip (get-trip store id)]
+         (render (str "Transportopdracht: " (otm/trip-ref trip))
+                 (assign-trip trip)
+                 flash)))
+
+     (POST "/assign-:id" {::store/keys            [store]
+                          {:keys [driver-id-digits
+                                  id
+                                  license-plate]} :params}
+       (when-let [trip (get-trip store id)]
+         (-> (str "assigned-" id)
+             (redirect :see-other)
+             (assoc :flash {:success "Chauffeur en kenteken toegewezen"})
+             (assoc ::store/commands [[:put! :trips (-> trip
+                                                        (otm/trip-driver-id-digits! driver-id-digits)
+                                                        (otm/trip-license-plate! license-plate))]]))))
+
+     (GET "/assigned-:id" {:keys                [flash]
+                           ::store/keys         [store]
+                           {:keys [id]}         :params
+                           {:keys [ishare-log]} :flash}
+       (when-let [trip (get-trip store id)]
+         (render (str "Transportopdracht toegewezen")
+                 (assigned-trip trip {:ishare-log ishare-log})
+                 flash))))))

src/dil_demo/web.clj

@@ -115,7 +115,8 @@
 (defn make-app [config]
   (-> handler
       (wrap-with-prefix "/erp" (erp/make-handler (config :erp)))
-      (wrap-with-prefix "/tms" (tms/make-handler (config :tms)))
+      (wrap-with-prefix "/tms-1" (tms/make-handler (config :tms-1) "tms-1"))
+      (wrap-with-prefix "/tms-2" (tms/make-handler (config :tms-2) "tms-2"))
       (wrap-with-prefix "/wms" (wms/make-handler (config :wms)))
       (wrap-carriers config)
 

test/dil_demo/tms/web_test.clj

@@ -18,18 +18,20 @@
     {:id "some-id"
      :external-attributes {:consignment-ref "some-ref"}}}})
 
+(def sut-handler (sut/make-handler "tms"))
+
 (deftest handler
   (testing "/"
-    (let [{:keys [status headers]} (sut/handler (request :get "/"))]
+    (let [{:keys [status headers]} (sut-handler (request :get "/"))]
       (is (= http-status/ok status))
       (is (= "text/html; charset=utf-8" (get headers "Content-Type")))))
 
   (testing "/assign-not-found"
-    (is (nil? (sut/handler (request :get "/assign-not-found")))))
+    (is (nil? (sut-handler (request :get "/assign-not-found")))))
 
   (testing "/assign-some-id"
     (let [{:keys [status headers body]}
-          (sut/handler (assoc (request :get "/assign-some-id")
+          (sut-handler (assoc (request :get "/assign-some-id")
                               ::store/store store))]
       (is (= http-status/ok status))
       (is (= "text/html; charset=utf-8" (get headers "Content-Type")))