jac_travel.clj

(ns price-sheet.jac-travel
  (:require [clj-time.core :as time]
            [clj-time.format :as format]
            [clojure.core.match :as ccm]
            [clojure.data.xml :as xml]
            [clojure.data.zip.xml :as xml-zip]
            [clojure.set :as set]
            [clojure.string :as string]
            [clojure.zip :as zip]
            [clojurewerkz.money.amounts :as money]
            [pandect.core :as pandect]
            [price-sheet.app-config :as app-config]
            [price-sheet.core :refer :all]
            [price-sheet.db :as db]
            [price-sheet.domain.money :as lib-money]
            [price-sheet.domain.room :as room]
            [price-sheet.domain.room-rate :as r]
            [price-sheet.domain.supplier-config :as supplier-config]
            [price-sheet.domain.supplier-property :as property]
            [price-sheet.lib.i18n :as i18n]
            [price-sheet.lib.util :as util]
            [price-sheet.ota :as ota]
            [price-sheet.supplier :as supplier]
            [price-sheet.lib.uuid :as uuid]
            [price-sheet.xml :as pxml]))

(property/defsupplierproperty JacTravelSupplierProperty [])
(util/definstance? JacTravelSupplierProperty)

(extend-type JacTravelSupplierProperty
  SupplierIdentifiable
  (supplier-code [_] "jac_travel")

  property/SupplierProperty
  (commission-tier [property] (property/max-commission-tier property 3))
  (business-model [_] "wholesale")
  (default-request-group [property] property/default-group-name)
  (short-code [_] "28")

  Restrictable
  (restriction-code [property] (property/call-center-visibility property)))

(defmethod db/doc->SupplierProperty "jac_travel" [supplier-property property]
  (-> supplier-property
      (update-in [:availability_config :margin] db/mongoid-decimal)
      (db/join-supplier-property property [])
      (merge (db/select-taxes (property/availability-config supplier-property)))
      map->JacTravelSupplierProperty))

(def date-format (format/formatter "dd MMM yyyy"))
(def ota-date-format (format/formatters :date))
(def unparse (partial format/unparse date-format))
(def unparse-local (partial format/unparse-local-date date-format))
(def ota-unparse-local (partial format/unparse-local-date ota-date-format))

(defmethod supplier/allow-availability-request? :jac_travel [{:keys [room-rate-request]}]
  (let [room (room/uniform-room (rooms room-rate-request))]
    (<= 1 (room/count-occupants room)  4)))

(defn make-rooms [rooms]
  (let [room (room/uniform-room rooms)
        n-adults (room/count-adults room)
        n-children (room/count-children room)
        qty [:QUANTITY (count rooms)]
        room-vec-fn (partial conj [:ROOM])]
    (ccm/match [n-adults n-children]
      [1 0] (room-vec-fn [:OCCUPANCY 1] qty)
      [1 1] (map #(room-vec-fn [:OCCUPANCY %] qty) [2 3])
      [2 0] (map #(room-vec-fn [:OCCUPANCY %] qty) [2 3])
      [1 2] (room-vec-fn [:OCCUPANCY 4] qty)
      [3 0] (room-vec-fn [:OCCUPANCY 4] qty)
      [4 0] (room-vec-fn [:OCCUPANCY 5] qty)
      [1 3] (room-vec-fn [:OCCUPANCY 5] qty)
      [2 1] (room-vec-fn [:OCCUPANCY 7]
                         qty
                         [:NO_OF_CHILDREN 1]
                         [:AGES_OF_CHILDREN (first (room/child-ages room))])
      [2 2] (room-vec-fn [:OCCUPANCY 8]
                         qty
                         [:NO_OF_CHILDREN 2]
                         [:AGES_OF_CHILDREN (string/join #"," (room/child-ages room))])
      :else nil)))

(defn request-xml [{:keys [room-rate-request credential-set supplier-properties]}]
  (xml/emit-str
   (xml/sexp-as-element
    [:HOTEL_AVAILABILITY_AND_PRICE_SEARCH_CRITERIA
     [:VERSION_HISTORY {:APPLICATION_NAME "AppName"
                        :XML_FILE_NAME    "XMLFileName"
                        :LICENCE_KEY      (:licence_key credential-set)
                        :TS_API_VERSION   "TSAPIVersion"}
      [:XML_VERSION_NO "3.0"]]
     [:SERVICE_ID {:AVAILABLE_ONLY "True"} (string/join #"," (map property/property-code supplier-properties))]
     [:BOOKING_START_DATE (unparse-local (check-in room-rate-request))]
     [:BOOKING_END_DATE (unparse-local (time/minus
                                        (check-out room-rate-request)
                                        (time/days 1)))]
     [:ROOM_REPLY
      [:ANY_ROOM]]
     [::ROOMS_REQUIRED
      (make-rooms (rooms room-rate-request))]])))

(defn http-request [{:keys [credential-set supplier-properties room-rate-request supplier-config] :as request}]
  {:headers {"Content-Type" "text/xml; charset=utf-8"}
   :method  :post
   :url     (:avail_url credential-set)
   :proxy   (app-config/proxy-connection)
   :timeout (supplier-config/supplier-timeout supplier-config)
   :body    (request-xml request)})

(defn ota-http-request-sexp [{:keys [credential-set supplier-properties room-rate-request request-id]}]
  (let [room (room/uniform-room (rooms room-rate-request))]
    (supplier/soap-sexp
     :header [:Interface {:xmlns               "http://api.hotels-vacation.com/Documentation/XML/OTA/4/2011B/"
                          :ChannelIdentifierId "HIS_VACATION_XML4H"
                          :Version             "2011B"
                          :Interface           "VACATION QUICK CONNECT XML 4 OTA"}
              [:ComponentInfo {:User          (:username credential-set)
                               :Pwd           (:password credential-set)
                               :ComponentType "Hotel"}]]
     :body [:OTA_HotelAvailRQ {:xmlns        "http://www.opentravel.org/OTA/2003/05"
                               :EchoToken    request-id
                               :Target       "Production"
                               :Version      "1.000"
                               :TimeStamp    (pxml/format-date-time (time/now))
                               :BestOnly     "false"
                               :SummaryOnly  "false"
                               :MaxResponses "0"}
            [:POS]
            [:AvailRequestSegments
             [:AvailRequestSegment
              [:StayDateRange {:Start (ota-unparse-local (check-in room-rate-request))
                               :Duration "Day"
                               :End (ota-unparse-local (check-out room-rate-request))}]
              [:RatePlanCandidates
               [:RatePlanCandidate {:RatePlanCode "*"
                                    :RPH          ""
                                    :RatePlanType "5"}
                [:HotelRefs
                 [:HotelRef {:HotelCode (property/property-code (first supplier-properties))}]]]]
              [:RoomStayCandidates
               [:RoomStayCandidate {:RoomTypeCode "*" :Quantity (count (rooms room-rate-request))}
                (ota/guest-counts-sexp {:ota/guest-counts {:ota/adult (room/count-adults room)
                                                           :ota/child (room/count-children room)}})]]]]])))

(defn ota-http-request [{:keys [credential-set supplier-config] :as request}]
  (-> request
      ota-http-request-sexp
      (supplier/soap-http-request (:ota_avail_url credential-set) "GetSinglePropertyTransientAvailability")
      (assoc :timeout (supplier-config/supplier-timeout supplier-config)
             :proxy (app-config/proxy-connection))))

(defmethod supplier/make-supplier-request [:jac_travel ::supplier/general-availability-request] [request]
  (-> request
      (assoc :http-request (http-request request))
      (supplier/map->SingleHttpSupplierRequest)))

(defmethod supplier/make-supplier-request [:jac_travel ::supplier/any-request-type] [request]
  (-> request
      (assoc :http-request (http-request request))
      (supplier/map->Single+FanoutHttpSupplierRequest)))

(defmethod supplier/make-secondary-requests ["jac_travel" ::supplier/any-request-type] [supplier-response supplier-request]
  [(ota-http-request supplier-request)])

(defmethod supplier/supplier-successful? "jac_travel" [{:keys [http-response]}]
  (not (pxml/text (:parsed-body http-response) :ERROR :ERROR_NUMBER)))

(defmethod supplier/room-rate-locs ["jac_travel" ::supplier/general-availability-request] [{:keys [http-response supplier-request]}]
  (let [room-rate-context (supplier/room-rate-context supplier-request)]
    (for [service-id-loc (xml-zip/xml-> (:parsed-body http-response) :SERVICE_ID)
          room-rate-loc (-> service-id-loc
                            zip/right
                            zip/right
                            zip/right
                            (xml-zip/xml-> :OPTION))]
      [(pxml/text service-id-loc)
       (assoc room-rate-context :room-rate-loc room-rate-loc)])))

(defmethod supplier/room-rate-locs ["jac_travel" ::supplier/any-request-type] [{:keys [http-response supplier-request secondary-responses]}]
  (let [room-rate-context (supplier/room-rate-context supplier-request)
        parsed-body (:parsed-body http-response)
        ota-room-stays-loc (some-> (first secondary-responses)
                                   (:parsed-body)
                                   (xml-zip/xml1-> :Body :OTA_HotelAvailRS :RoomStays))
        service-id (pxml/text parsed-body :SERVICE_ID)]
    (if-not  ota-room-stays-loc
      []
      (for [room-rate-loc (xml-zip/xml-> parsed-body :OPTIONS :OPTION)
            :let [room-type-code (pxml/text room-rate-loc :OPTIONID)
                  ota-room-stay-loc (xml-zip/xml1->
                                     ota-room-stays-loc
                                     :RoomStay [:RoomTypes :RoomType (xml-zip/attr= :RoomTypeCode room-type-code)])]
            :when ota-room-stay-loc]
        [service-id
         (assoc room-rate-context
                :room-rate-loc room-rate-loc
                :ota-room-stay-loc ota-room-stay-loc)]))))

(defn meal-type-key [price-loc]
  (let [meal-plan-type-loc (xml-zip/xml1-> price-loc :MEAL_PLAN :MEAL_PLAN_TYPE)
        breakfast (pxml/text meal-plan-type-loc :INCLUDESBREAKFAST)
        lunch (pxml/text meal-plan-type-loc :INCLUDESLUNCH)
        dinner (pxml/text meal-plan-type-loc :INCLUDESDINNER)]
    (ccm/match [breakfast lunch dinner]
      ["1" "0" "0"] :breakfast
      ["1" "1" "0"] :half-board-lunch
      ["1" "0" "1"] :half-board-dinner
      ["1" "1" "1"] :full-board
      ["0" "0" "1"] :dinner
      :else nil)))

(defn meal-plan-code [room-rate-loc]
  (let [mt-set (into #{} (map meal-type-key (xml-zip/xml-> room-rate-loc :PRICES :PRICE)))]
    (when (= (count mt-set) 1)
      (first mt-set))))

(defmethod supplier/make-rate-plan ["jac_travel" ::supplier/any-request-type] [{:as m :keys [room-rate-loc supplier-property]}]
  (let [name (string/trim (pxml/text room-rate-loc :PRICES :PRICE :MEAL_PLAN :MEAL_PLAN_TEXT))
        rpc (pandect/sha1 (pxml/text room-rate-loc :OPTIONID))]
    (assoc (supplier/wholesale-rate-plan supplier-property rpc) :name name)))

(defmethod supplier/make-room-type ["jac_travel" ::supplier/any-request-type] [{:keys [room-rate-loc supplier-property] :as m}]
  (let [code (pxml/text room-rate-loc :OPTIONID)]
    (r/map->RoomType
     {:code code
      :name (pxml/text room-rate-loc :OPTION_NAME)
      :uuid (uuid/room-type-uuid-str (supplier-code supplier-property)
                                     (property/property-code supplier-property)
                                     code)})))

(defn nightly-rates [{:keys [room-rate-loc supplier-request]}]
  (let [child-age-freqs (-> (rooms supplier-request)
                            first
                            room/child-ages
                            frequencies)
        child-total (fn [price-loc]
                      (apply +
                             (for [child-price-loc (xml-zip/xml-> price-loc :CHILD_PRICES :CHILD_PRICE)
                                   :let [age (util/parse-int (pxml/text child-price-loc :AGE))
                                         child-price (-> (pxml/text child-price-loc :SELL_PRICE_AMOUNT)
                                                         util/parse-decimal)]]
                               (* child-price (get child-age-freqs age)))))]
    (for [price-loc (xml-zip/xml-> room-rate-loc :PRICES :PRICE)
          :let [child-total (child-total price-loc)
                amount (util/parse-decimal (pxml/text price-loc :SELL_PRICE_AMOUNT))]]
      (r/map->NightlyRate {:amount (lib-money/money
                                    (+ amount child-total)
                                    (pxml/text price-loc :SELL_CURRENCY_CODE))}))))

(defmethod supplier/make-net-rate ["jac_travel" ::supplier/any-request-type] [m]
  (r/rate :nightly_rates (nightly-rates m)))

(defmethod supplier/make-sell-rate ["jac_travel" ::supplier/any-request-type] [{:keys [room-rate supplier-property]}]
  (apply-margin (r/net-rate room-rate)
                (:margin supplier-property)))

(defmethod supplier/make-supplier-defined-fields ["jac_travel" ::supplier/any-request-type] [{:keys [room-rate-loc]}]
  (let [supplier-defined-fields (for [price (xml-zip/xml-> room-rate-loc :PRICES :PRICE)]
                                  {:sell_price_id (pxml/text price :SELL_PRICE_ID)
                                   :option_date (pxml/text price :PRICE_DATE)
                                   :occupancy_id (pxml/text room-rate-loc :OCCUPANCY)})]
    {:fields supplier-defined-fields}))

(defmethod supplier/make-cancel-policies ["jac_travel" ::supplier/general-availability-request] [m]
  nil)

(defmethod supplier/make-cancel-policies ["jac_travel" ::supplier/any-request-type] [{:keys [ota-room-stay-loc room-rate] :as m}]
  (for [loc (xml-zip/xml-> ota-room-stay-loc :CancelPenalties :CancelPenalty)]
    (ota/cancel-penalty->policy loc room-rate)))

(defmethod supplier/update-room-rate ["jac_travel" ::supplier/general-availability-request] [{:keys [room-rate]}]
  room-rate)

(defmethod supplier/update-room-rate ["jac_travel" ::supplier/any-request-type] [{:keys [room-rate room-rate-loc]}]
  (let [mpc (meal-plan-code room-rate-loc)]
    (-> room-rate
        (assoc :meal_plan mpc)
        (update :value_adds set/union (i18n/meal-type->value-adds mpc)))))