Skip to content

Commit

Permalink
Show http-messages in output failing test-rio command
Browse files Browse the repository at this point in the history
  • Loading branch information
mdemare committed Jan 7, 2025
1 parent 9528e17 commit 97b1259
Show file tree
Hide file tree
Showing 2 changed files with 142 additions and 24 deletions.
53 changes: 29 additions & 24 deletions src/nl/surf/eduhub_rio_mapper/cli_commands.clj
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,8 @@
[nl.surf.eduhub-rio-mapper.rio.loader :as rio.loader]
[nl.surf.eduhub-rio-mapper.specs.ooapi :as ooapi]
[nl.surf.eduhub-rio-mapper.specs.rio :as rio]
[nl.surf.eduhub-rio-mapper.utils.http-utils :refer [*http-messages*]]
[nl.surf.eduhub-rio-mapper.utils.printer :as printer]
[nl.surf.eduhub-rio-mapper.worker :as worker])
(:import [java.util UUID]))

Expand Down Expand Up @@ -76,37 +78,40 @@

"test-rio"
(let [[client-info _args] (parse-client-info-args args clients)
uuid (UUID/randomUUID)
new-uuid (UUID/randomUUID)
old-uuid (UUID/randomUUID)
new-uuid (UUID/randomUUID)

eduspec (-> "../test/fixtures/ooapi/education-specification-template.json"
io/resource
slurp
(json/read-str :key-fn keyword)
(assoc :educationSpecificationId uuid))]
(assoc :educationSpecificationId old-uuid))]

(try
(let [insert-req {:institution-oin (:institution-oin client-info)
:institution-schac-home (:institution-schac-home client-info)
::ooapi/type "education-specification"
::ooapi/id uuid
::ooapi/entity eduspec}
rio-code (-> insert-req insert! :aanleveren_opleidingseenheid_response :opleidingseenheidcode)
link-req (merge insert-req {::ooapi/id new-uuid ::rio/opleidingscode rio-code})]
(link! link-req)
(let [rio-obj (rio.loader/find-rio-object rio-code getter (:institution-oin client-info) "opleidingseenheid")
nieuwe-sleutel (->> rio-obj
:content
(filter #(= :kenmerken (:tag %)))
(map :content)
(map #(reduce (fn [m el] (assoc m (:tag el) (-> el :content first))) {} %))
(filter #(= "eigenOpleidingseenheidSleutel" (:kenmerknaam %)))
first
:kenmerkwaardeTekst)]
(when (not= nieuwe-sleutel (str uuid))
(throw (ex-info "Failed to set eigenOpleidingseenheidSleutel" {:rio-queue-status :down})))))

(println "The RIO Queue is UP")
(binding [*http-messages* (atom [])]
(let [insert-req {:institution-oin (:institution-oin client-info)
:institution-schac-home (:institution-schac-home client-info)
::ooapi/type "education-specification"
::ooapi/id old-uuid
::ooapi/entity eduspec}
rio-code (-> insert-req insert! :aanleveren_opleidingseenheid_response :opleidingseenheidcode)
link-req (merge insert-req {::ooapi/id new-uuid ::rio/opleidingscode rio-code})]
(link! link-req)
(let [rio-obj (rio.loader/find-rio-object rio-code getter (:institution-oin client-info) "opleidingseenheid")
nieuwe-sleutel (->> rio-obj
:content
(filter #(= :kenmerken (:tag %)))
(map :content)
(map #(reduce (fn [m el] (assoc m (:tag el) (-> el :content first))) {} %))
(filter #(= "eigenOpleidingseenheidSleutel" (:kenmerknaam %)))
first
:kenmerkwaardeTekst)]
(when (not= nieuwe-sleutel (str new-uuid))
(println "old uuid " old-uuid)
(println "new uuid " new-uuid)
(printer/print-http-messages @nl.surf.eduhub-rio-mapper.utils.http-utils/*http-messages*)
(throw (ex-info "Failed to set eigenOpleidingseenheidSleutel" {:rio-queue-status :down}))))
(println "The RIO Queue is UP")))
(catch Exception ex
(when-let [ex-data (ex-data ex)]
(when (= :down (:rio-queue-status ex-data))
Expand Down
113 changes: 113 additions & 0 deletions src/nl/surf/eduhub_rio_mapper/utils/printer.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,113 @@
;; This file is part of eduhub-rio-mapper
;;
;; Copyright (C) 2022 SURFnet B.V.
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU Affero General Public License
;; as published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this program. If not, see
;; <https://www.gnu.org/licenses/>.

(ns nl.surf.eduhub-rio-mapper.utils.printer
(:require [clojure.data.json :as json]
[clojure.string :as str]
[clojure.xml :as xml]
[nl.jomco.http-status-codes :as http-status]
[nl.surf.eduhub-rio-mapper.utils.xml-utils :as xml-utils])
(:import [java.io ByteArrayInputStream StringWriter]))

(defmacro print-boxed
"Print pretty box around output of evaluating `form`."
[title & form]
`(let [sw# (StringWriter.)
r# (binding [*out* sw#] ~@form)
s# (str sw#)]
(println)
(print "╭─────" ~title "\n")
(println (str/replace (str/trim s#) #"\n" "\n"))
(println "╰─────")
r#))

(defn- print-soap-body
"Print the body of a SOAP request or response."
[s]
;; Use clojure.xml/parse because it is more lenient than
;; clojure.data.xml/parse which trips over missing namespaces.
(let [xml (xml/parse (ByteArrayInputStream. (.getBytes s)))]
(xml-utils/debug-print-xml (-> xml :content second :content first)
:initial-indent " ")))

(defn- print-json
"Print indented JSON."
[v]
(when v
(print " ")
(println (json/write-str v :indent true :indent-depth 1))))

(defn- print-json-str
"Parse string as JSON and print it."
[s]
(when s
(print-json (json/read-str s))))

(defn- print-rio-message
"Print boxed RIO request and response."
[{{:keys [method url]
req-body :body
{action :SOAPAction} :headers} :req
{res-body :body
:keys [status]} :res}]
(print-boxed "RIO"
(println (str/upper-case (name method)) url status)
(println "- action:" action)
(println "- request:\n")
(print-soap-body req-body)
(println)
(when (= http-status/ok status)
(println "- response:\n")
(print-soap-body res-body)
(println))))

(defn- print-ooapi-message
"Print boxed OOAPI request and response."
[{{:keys [method url]} :req
{:keys [status body]} :res}]
(print-boxed "OOAPI"
(println (str/upper-case method) url status)
(println)
(when (= http-status/ok status)
(print-json-str body))))

(defn- keywordize-keys
"Recursively change map keys to keywords."
[m]
(->> m
(map (fn [[k v]]
[(if (keyword? k)
k
(keyword k))
(if (map? v)
(keywordize-keys v)
v)]))
(into {})))

(defn print-http-messages
"Print HTTP message as returned by API status."
[http-messages]
(when-let [msg (first http-messages)]
;; need to keywordize-keys because http-message may be translated
;; from from JSON (in which case they are all keywords) or come
;; straight from http-utils (which is a mixed bag)
(let [{:keys [req] :as msg} (keywordize-keys msg)]
(if (-> req :headers :SOAPAction)
(print-rio-message msg)
(print-ooapi-message msg)))
(recur (next http-messages))))

0 comments on commit 97b1259

Please sign in to comment.