<commit_before>(ns puppetlabs.services.ca.certificate-authority-core
  (:import  [java.io InputStream])
  (:require [puppetlabs.puppetserver.certificate-authority :as ca]
            [puppetlabs.puppetserver.ringutils :as ringutils]
            [puppetlabs.puppetserver.liberator-utils :as utils]
            [slingshot.slingshot :as sling]
            [clojure.tools.logging :as log]
            [schema.core :as schema]
            [compojure.core :as compojure :refer [GET ANY PUT]]
            [liberator.core :as liberator]
            [liberator.representation :as representation]
            [ring.middleware.json :as json]
            [ring.util.response :as rr]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal

(defn bad-request?
  "Given a map (thrown via slingshot), should it result in a
  HTTP 400 (bad request) response being sent back to the client?"
  [x]
  (when (map? x)
    (let [type (:type x)
          expected-types #{:disallowed-extension
                           :duplicate-cert
                           :hostname-mismatch
                           :invalid-signature
                           :invalid-subject-name}]
      (contains? expected-types type))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 'handler' functions for HTTP endpoints

(defn handle-get-certificate
  [subject {:keys [cacert signeddir]}]
  (-> (if-let [certificate (ca/get-certificate subject cacert signeddir)]
        (rr/response certificate)
        (rr/not-found (str "Could not find certificate " subject)))
      (rr/content-type "text/plain")))

(defn handle-get-certificate-request
  [subject {:keys [csrdir]}]
  (-> (if-let [certificate-request (ca/get-certificate-request subject csrdir)]
        (rr/response certificate-request)
        (rr/not-found (str "Could not find certificate_request " subject)))
      (rr/content-type "text/plain")))

(schema/defn handle-put-certificate-request!
  [subject :- String
   certificate-request :- InputStream
   ca-settings :- ca/CaSettings]
  (sling/try+
    (ca/process-csr-submission! subject certificate-request ca-settings)
    (rr/content-type (rr/response nil) "text/plain")
    (catch bad-request? {:keys [message]}
      (log/error message)
      (-> (rr/response message)
          (rr/status 400)
          (rr/content-type "text/plain")))))

(defn handle-get-certificate-revocation-list
  [{:keys [cacrl]}]
  (-> (ca/get-certificate-revocation-list cacrl)
      (rr/response)
      (rr/content-type "text/plain")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compojure app

(defn get-desired-state
  [context]
  (keyword (get-in context [:request :body :desired_state])))

(liberator/defresource certificate-status
  [subject settings]
  :allowed-methods [:get :put :delete]

  :available-media-types ["application/json"]

  :can-put-to-missing? false

  :delete!
  (fn [context]
    (ca/delete-certificate! settings subject))

  :exists?
  (fn [context]
    (ca/certificate-exists? settings subject))

  :handle-exception utils/exception-handler

  :handle-not-implemented
  (fn [context]
    (when (= :put (get-in context [:request :request-method]))
      ; We've landed here because :exists? returned false, and we have set
      ; `:can-put-to-missing? false` above.  This happens when
      ; a request comes in with an invalid hostname/subject specified in
      ; in the URL; liberator is pushing us towards a 501 here, but instead
      ; we want to return a 404.  There seems to be some disagreement as to
      ; which makes the most sense in general - see
      ; https://github.com/clojure-liberator/liberator/pull/120
      ; ... but in our case, a 404 definitely makes more sense.
      (-> "Invalid certificate subject."
          (representation/as-response context)
          (assoc :status 404)
          (representation/ring-response))))

  :handle-ok
  (fn [context]
    (ca/get-certificate-status settings subject))

  :malformed?
  (fn [context]
    (when (= :put (get-in context [:request :request-method]))
      (let [state (get-desired-state context)]
        (schema/check ca/DesiredCertState state))))

  :handle-malformed
  (fn [context]
    (if (ringutils/json-request? (get context :request))
      "Bad Request."
      "Request headers must include 'Content-Type: application/json'."))

  ;; Never return a 201, we're not creating a new cert or anything like that.
  :new? false

  :put!
  (fn [context]
    (let [desired-state (get-desired-state context)]
      (ca/set-certificate-status! settings subject desired-state))))

(liberator/defresource certificate-statuses
  [settings]
  :allowed-methods [:get]

  :available-media-types ["application/json"]

  :handle-exception utils/exception-handler

  :handle-ok
  (fn [context]
    (ca/get-certificate-statuses settings)))

(schema/defn routes
  [ca-settings :- ca/CaSettings]<commit_msg>(PE-5731) fixup bad reference after rebase<commit_after>(ns puppetlabs.services.ca.certificate-authority-core
  (:import  [java.io InputStream])
  (:require [puppetlabs.puppetserver.certificate-authority :as ca]
            [puppetlabs.puppetserver.ringutils :as ringutils]
            [puppetlabs.puppetserver.liberator-utils :as utils]
            [slingshot.slingshot :as sling]
            [clojure.tools.logging :as log]
            [schema.core :as schema]
            [compojure.core :as compojure :refer [GET ANY PUT]]
            [liberator.core :as liberator]
            [liberator.representation :as representation]
            [ring.middleware.json :as json]
            [ring.util.response :as rr]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal

(defn bad-request?
  "Given a map (thrown via slingshot), should it result in a
  HTTP 400 (bad request) response being sent back to the client?"
  [x]
  (when (map? x)
    (let [type (:type x)
          expected-types #{:disallowed-extension
                           :duplicate-cert
                           :hostname-mismatch
                           :invalid-signature
                           :invalid-subject-name}]
      (contains? expected-types type))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 'handler' functions for HTTP endpoints

(defn handle-get-certificate
  [subject {:keys [cacert signeddir]}]
  (-> (if-let [certificate (ca/get-certificate subject cacert signeddir)]
        (rr/response certificate)
        (rr/not-found (str "Could not find certificate " subject)))
      (rr/content-type "text/plain")))

(defn handle-get-certificate-request
  [subject {:keys [csrdir]}]
  (-> (if-let [certificate-request (ca/get-certificate-request subject csrdir)]
        (rr/response certificate-request)
        (rr/not-found (str "Could not find certificate_request " subject)))
      (rr/content-type "text/plain")))

(schema/defn handle-put-certificate-request!
  [subject :- String
   certificate-request :- InputStream
   ca-settings :- ca/CaSettings]
  (sling/try+
    (ca/process-csr-submission! subject certificate-request ca-settings)
    (rr/content-type (rr/response nil) "text/plain")
    (catch bad-request? {:keys [message]}
      (log/error message)
      (-> (rr/response message)
          (rr/status 400)
          (rr/content-type "text/plain")))))

(defn handle-get-certificate-revocation-list
  [{:keys [cacrl]}]
  (-> (ca/get-certificate-revocation-list cacrl)
      (rr/response)
      (rr/content-type "text/plain")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compojure app

(defn get-desired-state
  [context]
  (keyword (get-in context [:request :body :desired_state])))

(liberator/defresource certificate-status
  [subject settings]
  :allowed-methods [:get :put :delete]

  :available-media-types ["application/json"]

  :can-put-to-missing? false

  :delete!
  (fn [context]
    (ca/delete-certificate! settings subject))

  :exists?
  (fn [context]
    (ca/certificate-exists? settings subject))

  :handle-exception utils/exception-handler

  :handle-not-implemented
  (fn [context]
    (when (= :put (get-in context [:request :request-method]))
      ; We've landed here because :exists? returned false, and we have set
      ; `:can-put-to-missing? false` above.  This happens when
      ; a request comes in with an invalid hostname/subject specified in
      ; in the URL; liberator is pushing us towards a 501 here, but instead
      ; we want to return a 404.  There seems to be some disagreement as to
      ; which makes the most sense in general - see
      ; https://github.com/clojure-liberator/liberator/pull/120
      ; ... but in our case, a 404 definitely makes more sense.
      (-> "Invalid certificate subject."
          (representation/as-response context)
          (assoc :status 404)
          (representation/ring-response))))

  :handle-ok
  (fn [context]
    (ca/get-certificate-status settings subject))

  :malformed?
  (fn [context]
    (when (= :put (get-in context [:request :request-method]))
      (let [state (get-desired-state context)]
        (schema/check ca/DesiredCertificateState state))))

  :handle-malformed
  (fn [context]
    (if (ringutils/json-request? (get context :request))
      "Bad Request."
      "Request headers must include 'Content-Type: application/json'."))

  ;; Never return a 201, we're not creating a new cert or anything like that.
  :new? false

  :put!
  (fn [context]
    (let [desired-state (get-desired-state context)]
      (ca/set-certificate-status! settings subject desired-state))))

(liberator/defresource certificate-statuses
  [settings]
  :allowed-methods [:get]

  :available-media-types ["application/json"]

  :handle-exception utils/exception-handler

  :handle-ok
  (fn [context]
    (ca/get-certificate-statuses settings)))

(schema/defn routes
  [ca-settings :- ca/CaSettings]
{'fraction_non_alphanumeric': 0.16986986986986988, 'fraction_numerical': 0.005205205205205205, 'mean_word_length': 3.069653767820774, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 13, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2767599', 'n_tokens_mistral': 3285, 'n_tokens_neox': 3046, 'n_words': 770}