* Class       : zcl_validator_rest_handler
* Title       : Service validation - SICF handler class
* Description :
"! This is the service handler class for validation requests via REST service calls (POST).
"! It uses header parameters CLAS, GROUP and PROCESS (and the optional LANGUAGE), it takes
"! any JSON content provided and it involves customised checks to compose the response.
"! The response is either errors=0 (which means, continue with the next service call) or
"! errorr=n (which means: stop here - and focus on the errors).
CLASS zcl_validator_rest_handler DEFINITION
  PUBLIC
  FINAL
  CREATE PUBLIC .

  PUBLIC SECTION.

    INTERFACES if_http_extension .

    "! The class prefix will be applied for the execution of check methods.
    CONSTANTS co_class_prefix TYPE string VALUE 'ZCL_VALIDATOR_'.
    TYPES: BEGIN OF gty_check_credentials,
             class   TYPE c LENGTH 20,
             group   TYPE c LENGTH 20,
             process TYPE c LENGTH 20,
             method  TYPE c LENGTH 20,
           END OF gty_check_credentials.
    TYPES: BEGIN OF gty_validation_message,
             number  TYPE int2,
             msgcode TYPE c LENGTH 16,
             message TYPE char120,
           END OF gty_validation_message.
    TYPES gty_validation_messages TYPE SORTED TABLE OF gty_validation_message WITH UNIQUE KEY number.
    TYPES: BEGIN OF gty_check_result,
             method   TYPE c LENGTH 20,
             messages TYPE gty_validation_messages,
           END OF gty_check_result.
    TYPES gty_check_results TYPE SORTED TABLE OF gty_check_result WITH UNIQUE KEY method.
    TYPES: BEGIN OF gty_json_response,
             errors       TYPE int1,
             checkresults TYPE gty_check_results,
             class        TYPE c LENGTH 20,
             group        TYPE c LENGTH 20,
             process      TYPE c LENGTH 20,
             language     TYPE sy-langu,
           END OF gty_json_response.
    CLASS-DATA gt_check_methods TYPE STANDARD TABLE OF gty_check_credentials.

    CLASS-METHODS class_constructor.

  PRIVATE SECTION.
    CLASS-METHODS set_error_status IMPORTING is_server TYPE REF TO if_http_server iv_code TYPE i iv_reason TYPE string.

ENDCLASS.


CLASS zcl_validator_rest_handler IMPLEMENTATION.

  METHOD class_constructor.
    "List of supported checks
    gt_check_methods = VALUE #(
      ( class = 'CONTRACT' group = 'GENERAL' process = 'READ' method = 'REQUESTEDBY' )
      ( class = 'PERSON' group = 'GENERAL' process = 'READ' method = 'REQUESTEDBY' )
      ( class = 'PERSON' group = 'GENERAL' process = 'READ' method = 'MANDATORYFIELDS' )
    ).
  ENDMETHOD.

  METHOD if_http_extension~handle_request.

    DATA: BEGIN OF ls_seoclass,
            class  TYPE seoclass-clsname,
            method TYPE c LENGTH 32,
          END OF ls_seoclass.
    DATA lr_data TYPE REF TO data.
    DATA lr_descr TYPE REF TO cl_abap_datadescr.
    DATA lo_validation_object TYPE REF TO object.
    DATA lt_validation_messages TYPE gty_validation_messages.
    DATA lt_check_results TYPE gty_check_results.
    DATA ls_check_results TYPE gty_check_result.
    DATA ls_json_response TYPE gty_json_response.

    FIELD-SYMBOLS: <ls_request_content> TYPE any.
    CLEAR ls_json_response.
    ls_json_response-class = to_upper( server->request->get_header_field( 'CLASS' ) ).
    ls_json_response-group = to_upper( server->request->get_header_field( 'GROUP' ) ).
    ls_json_response-process = to_upper( server->request->get_header_field( 'PROCESS' ) ).
    "Support for the language of return messages
    ls_json_response-language = server->request->get_header_field( 'LANGUAGE' ).
    ls_json_response-language = COND #(  WHEN ls_json_response-language IS INITIAL THEN sy-langu ELSE ls_json_response-language ).
    "Ensure the header credentials are all available
    IF ls_json_response-class IS INITIAL OR ls_json_response-group IS INITIAL OR ls_json_response-process IS INITIAL.
      set_error_status( is_server = server iv_code = 400 iv_reason = 'Missing data - header (class, group, process)' ).
      RETURN.
    ENDIF.
    "Ensure the header credentials are valid - at least 1 check module should be available
    IF NOT line_exists( gt_check_methods[ class = ls_json_response-class group = ls_json_response-group process = ls_json_response-process ] ).
      set_error_status( is_server = server iv_code = 400
        iv_reason = |Invalid combination of credentials (class={ ls_json_response-class }, group={ ls_json_response-group }, process={ ls_json_response-process })| ).
      RETURN.
    ENDIF.

    "Get the JSON body from the request
    DATA(lv_json) = server->request->get_cdata(  ).
    IF lv_json IS INITIAL.
      set_error_status( is_server = server iv_code = 400 iv_reason = 'Missing data - No JSON content (body)' ).
      RETURN.
    ENDIF.

    TRY.
        cl_abap_typedescr=>describe_by_name(
          EXPORTING p_name = |{ co_class_prefix }{ ls_json_response-class }=>GTY_REQUEST_CONTENT|
          RECEIVING p_descr_ref = DATA(lo_descr)
          EXCEPTIONS type_not_found = 4 ).
        IF sy-subrc = 4.
          set_error_status( is_server = server iv_code = 400 iv_reason = |Class { co_class_prefix }{ ls_json_response-class } unavailable| ).
          RETURN.
        ENDIF.

        lr_descr ?= lo_descr.
        CREATE DATA lr_data TYPE HANDLE lr_descr.

        ASSIGN lr_data->* TO <ls_request_content>.

        "Map the JSON content onto the ABAP content
        /ui2/cl_json=>deserialize(
          EXPORTING json = lv_json pretty_name = /ui2/cl_json=>pretty_mode-camel_case
          CHANGING data = <ls_request_content> ).

        IF <ls_request_content> IS INITIAL.
          set_error_status( is_server = server iv_code = 400 iv_reason = |Faulty data - no valid content (body) - JSON structured ok ? | ).
          RETURN.
        ENDIF.

      CATCH cx_sy_move_cast_error INTO DATA(lx).
        set_error_status( is_server = server iv_code = 400 iv_reason = |{ lx->get_text( ) } (internal error)| ).
        RETURN.
    ENDTRY.

    ls_seoclass-class = |{ co_class_prefix }{ ls_json_response-class }|.
    TRY.
        "Create an instance of the validation class - and set it's is_request_content
        "attribute with the data from
*================================================================
        CREATE OBJECT lo_validation_object TYPE (ls_seoclass-class)
          EXPORTING
            is_request_content = <ls_request_content>
            iv_language = ls_json_response-language.
*================================================================

        "Execute validations for the group and process
        LOOP AT gt_check_methods INTO DATA(ls_check_method)
          WHERE class = ls_json_response-class AND
                group = ls_json_response-group AND
                process = ls_json_response-process.

          ls_seoclass-method = |CHECK_{ ls_check_method-method }|.
*================================================================
          CALL METHOD lo_validation_object->(ls_seoclass-method)
            RECEIVING
              rt_validation_messages = lt_validation_messages.
*================================================================

          "Merge the messages into the grand message list.
          IF lines( lt_validation_messages ) > 0.
            ls_check_results-method = ls_check_method-method.
            ls_check_results-messages = lt_validation_messages.
            INSERT ls_check_results INTO TABLE lt_check_results.

            ls_json_response-errors = ls_json_response-errors + lines( lt_validation_messages ).
          ENDIF.

        ENDLOOP.
      CATCH cx_sy_create_object_error cx_sy_dyn_call_illegal_method INTO DATA(lx2).
        set_error_status( is_server = server iv_code = 500 iv_reason = |{ lx2->get_text( ) } (internal error)| ).
        RETURN.
    ENDTRY.

    ls_json_response-checkresults = lt_check_results.
    "Map the ABAP results onto JSON content and set response content type and content
    server->response->set_content_type( if_rest_media_type=>gc_appl_json ).
    server->response->set_cdata( data = /ui2/cl_json=>serialize( EXPORTING data = ls_json_response ) ).
    "Log faulty calls - when sensorboard sensortype is listening
    TRY.
        "Why the dynamic calls ? This service should also work without the sensorboard.
        "Feel free to remove it completely - if the sensorboard is not going to be available
        SELECT COUNT( * ) FROM ('ZSENSORS') WHERE sensor = 'VALIDATOR' AND status <> 'X' INTO @DATA(lv_counter).
        IF lv_counter > 0.
          CALL METHOD ('ZCL_SENSORS_VALIDATOR')=>('LOG_FAILED_VALIDATION')
            EXPORTING
              iv_credentials = |{ ls_json_response-class }/{ ls_json_response-group }/{ ls_json_response-process }|
              iv_json        = lv_json.
        ENDIF.
      CATCH cx_sy_dynamic_osql_semantics cx_sy_dyn_call_illegal_class cx_sy_dyn_call_illegal_method.
        "Sensorboard functionality unavailable
    ENDTRY.

  ENDMETHOD.

  METHOD set_error_status.
    is_server->response->set_status( code = iv_code reason = iv_reason ).
    "For production systems - the error message is reset to 'Internal error (123#)'
    SELECT SINGLE cccategory FROM t000 INTO @DATA(lv_category)
      WHERE mandt = @sy-mandt.
    IF lv_category = 'P'. "Production system
      is_server->response->set_cdata( data = 'Internal error (#123)' ).
    ELSE.
      is_server->response->set_cdata( data = iv_reason ).
    ENDIF.
  ENDMETHOD.

ENDCLASS.