       PROCESS OPTIONS, NOMONOPRC
          IDENTIFICATION DIVISION.
      *********************************************************************
      *                                                                   *
      *                  IBM Web Services Client for ILE                  *
      *                                                                   *
      *  FILE NAME:      restRS.CBLLE                                     *
      *                                                                   *
      *  DESCRIPTION:    Source to do REST request using transport APIs   *
      *                                                                   *
      *********************************************************************
      * LICENSE AND DISCLAIMER                                            *
      * ----------------------                                            *
      * This material contains IBM copyrighted sample programming source  *
      * code ( Sample Code ).                                             *
      * IBM grants you a nonexclusive license to compile, link, execute,  *
      * display, reproduce, distribute and prepare derivative works of    *
      * this Sample Code.  The Sample Code has not been thoroughly        *
      * tested under all conditions.  IBM, therefore, does not guarantee  *
      * or imply its reliability, serviceability, or function. IBM        *
      * provides no program services for the Sample Code.                 *
      *                                                                   *
      * All Sample Code contained herein is provided to you "AS IS"       *
      * without any warranties of any kind. THE IMPLIED WARRANTIES OF     *
      * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND             *
      * NON-INFRINGMENT ARE EXPRESSLY DISCLAIMED.                         *
      * SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED          *
      * WARRANTIES, SO THE ABOVE EXCLUSIONS MAY NOT APPLY TO YOU.  IN NO  *
      * EVENT WILL IBM BE LIABLE TO ANY PARTY FOR ANY DIRECT, INDIRECT,   *
      * SPECIAL OR OTHER CONSEQUENTIAL DAMAGES FOR ANY USE OF THE SAMPLE  *
      * CODE INCLUDING, WITHOUT LIMITATION, ANY LOST PROFITS, BUSINESS    *
      * INTERRUPTION, LOSS OF PROGRAMS OR OTHER DATA ON YOUR INFORMATION  *
      * HANDLING SYSTEM OR OTHERWISE, EVEN IF WE ARE EXPRESSLY ADVISED OF *
      * THE POSSIBILITY OF SUCH DAMAGES.                                  *
      *                                                                   *
      *  <START_COPYRIGHT>                                                *
      *                                                                   *
      *  Licensed Materials - Property of IBM                             *
      *                                                                   *
      *  5770-SS1                                                         *
      *                                                                   *
      *  (c) Copyright IBM Corp. 2019, 2019                               *
      *  All Rights Reserved                                              *
      *                                                                   *
      *  U.S. Government Users Restricted Rights - use,                   *
      *  duplication or disclosure restricted by GSA                      *
      *  ADP Schedule Contract with IBM Corp.                             *
      *                                                                   *
      *  Status: Version 1 Release 0                                      *
      *  <END_COPYRIGHT>                                                  *
      *                                                                   *
      *  TO COMPILE:                                                      *
      *     CRTCBLMOD MODULE(MYLIB/*PGMID) SRCSTMF('/RESTrs.CBLLE')       *
      *     CRTPGM PGM(MYLIB/RESTRS) BNDSRVPGM((QSYSDIR/QAXIS10CC))       *
      *                                                                   *
      *********************************************************************
          PROGRAM-ID.     RESTRS.

          ENVIRONMENT DIVISION.
          CONFIGURATION SECTION.
          SPECIAL-NAMES.

          INPUT-OUTPUT SECTION.
          FILE-CONTROL.
          DATA DIVISION.
          FILE SECTION.
          WORKING-STORAGE SECTION.

      *--------------------------------------------------------------------
      * Transport APIs constants - Constants for transport protocols.
      *--------------------------------------------------------------------
          01 AXISC_PROTOCOL_HTTP11 PIC S9(09) BINARY VALUE 1.
          
      *--------------------------------------------------------------------
      * Transport APIs constants - Constants for transport properties. 
      *--------------------------------------------------------------------
          01 AXISC_HTTP_BASICAUTH        
                    PIC S9(09) BINARY VALUE 10.
          01 AXISC_HTTP_COOKIES          
                    PIC S9(09) BINARY VALUE 15.
          01 AXISC_HTTP_HEADER           
                    PIC S9(09) BINARY VALUE 20.
          01 AXISC_HTTP_HEADERS_RAW      
                    PIC S9(09) BINARY VALUE 22.
          01 AXISC_HTTP_HEADERS_RESPONSE 
                    PIC S9(09) BINARY VALUE 23.
          01 AXISC_HTTP_METHOD           
                    PIC S9(09) BINARY VALUE 40.
          01 AXISC_HTTP_PROXY            
                    PIC S9(09) BINARY VALUE 50.
          01 AXISC_HTTP_PROXYAUTH        
                    PIC S9(09) BINARY VALUE 60.
          01 AXISC_HTTP_PROXYSSL         
                    PIC S9(09) BINARY VALUE 65.
          01 AXISC_HTTP_REDIRECT         
                    PIC S9(09) BINARY VALUE 70.
          01 AXISC_HTTP_SSL              
                    PIC S9(09) BINARY VALUE 80.
          01 AXISC_HTTP_STATUS_CODE      
                    PIC S9(09) BINARY VALUE 90.
          01 AXISC_CONNECT_TIMEOUT       
                    PIC S9(09) BINARY VALUE 100.
          01 AXISC_CONVERT_PAYLOAD_REQUEST  
                    PIC S9(09) BINARY VALUE 101.
          01 AXISC_CONVERT_PAYLOAD_RESPONSE 
                    PIC S9(09) BINARY VALUE 102.
          01 AXISC_CONVERT_PAYLOAD       
                    PIC S9(09) BINARY VALUE 103.
          01 AXISC_IO_TIMEOUT            
                    PIC S9(09) BINARY VALUE 105.
 
      *--------------------------------------------------------------------
      * Axis APIs constants - Constants for exception codes.
      *--------------------------------------------------------------------
          01 EXC_CLIENT_HANDLER_FAILED            
                    PIC S9(09) BINARY VALUE 10.
          01 EXC_TRANSPORT_EXCEPTION              
                    PIC S9(09) BINARY VALUE 11.
          01 EXC_OPEN_CONNECTION_FAILED           
                    PIC S9(09) BINARY VALUE 12.
          01 EXC_TRANSPORT_TYPE_MISMATCH          
                    PIC S9(09) BINARY VALUE 13.
          01 EXC_NO_UNSEC_TRANSPORT_LAYER      
                    PIC S9(09) BINARY VALUE 14.
          01 EXC_NO_SECURE_TRANSPORT_LAYER        
                    PIC S9(09) BINARY VALUE 15.
          01 EXC_SSL_RECEPTION_EXCEPTION          
                    PIC S9(09) BINARY VALUE 16.
          01 EXC_SSL_SENDING_EXCEPTION            
                    PIC S9(09) BINARY VALUE 17.
          01 EXC_SSL_INIT_ERROR                   
                    PIC S9(09) BINARY VALUE 18.
          01 EXC_SSL_SOCKET_CREATE_ERROR          
                    PIC S9(09) BINARY VALUE 19.
          01 EXC_SSL_SOCKET_CONNECT_ERROR         
                    PIC S9(09) BINARY VALUE 20.
          01 EXC_SSL_INVALID_SOCKET_ERROR         
                    PIC S9(09) BINARY VALUE 21.
          01 EXC_SSL_CONTEXT_CREATE_ERROR         
                    PIC S9(09) BINARY VALUE 22.
          01 EXC_SSL_ERROR                        
                    PIC S9(09) BINARY VALUE 23.
          01 EXC_TRAN_UNKNOWN_HTTP_RESPONSE  
                    PIC S9(09) BINARY VALUE 50.
          01 EXC_TRAN_HTTP_EXCEPTION         
                    PIC S9(09) BINARY VALUE 51.
          01 EXC_TRAN_UNEXPECTED_STRING      
                    PIC S9(09) BINARY VALUE 52.
          01 EXC_TRAN_CHANNEL_INIT_ERROR     
                    PIC S9(09) BINARY VALUE 53.
          01 EXC_TRAN_SOCKET_CREATE_ERROR    
                    PIC S9(09) BINARY VALUE 54.
          01 EXC_TRAN_SOCKET_CONNECT_ERROR   
                    PIC S9(09) BINARY VALUE 55.
          01 EXC_TRAN_INVALID_SOCKET         
                    PIC S9(09) BINARY VALUE 56.
          01 EXC_TRAN_OUTPUT_STREAM_ERROR 
                    PIC S9(09) BINARY VALUE 57.
          01 EXC_TRAN_INPUT_STREAM_ERROR  
                    PIC S9(09) BINARY VALUE 58.
          01 EXC_TRAN_TIMEOUT_EXCEPTION      
                    PIC S9(09) BINARY VALUE 59.
          01 EXC_TRAN_TIMEOUT_EXPIRED        
                    PIC S9(09) BINARY VALUE 60.
          01 EXC_TRAN_LOADING_SSLCHA_FAILED 
                    PIC S9(09) BINARY VALUE 61.
          01 EXC_TRAN_LOADING_CHA_FAILED    
                    PIC S9(09) BINARY VALUE 62.
          01 EXC_SERVICE_THROWN_EXCEPTION         
                    PIC S9(09) BINARY VALUE 70.
          01 EXC_CONFIGURATION_ERROR              
                    PIC S9(09) BINARY VALUE 73.
          01 EXC_REDIRECT_RECEIVED                
                    PIC S9(09) BINARY VALUE 75.
                    
      *--------------------------------------------------------------------
      * Miscellaneous elements
      *--------------------------------------------------------------------
          01 MAX-BUFFER-SIZE      PIC S9(09) BINARY VALUE 32767.
      
          01 rc                   PIC S9(09) BINARY.
          01 tHandle              POINTER VALUE NULL.
          
          01 uri                  PIC X(200).
          
          01 propBuf1             PIC X(200).
          01 propBuf2             PIC X(200).
          01 propInt              PIC S9(09) BINARY.
          
          01 logFile              PIC X(20) VALUE IS Z"/tmp/axis.log".
          01 logFilter            POINTER VALUE NULL.

          01 NULLSTR              PIC X(1) VALUE IS Z"".
          01 NULLPTR              POINTER VALUE NULL.
          01 NONEVAL              PIC X(5) VALUE IS Z"NONE".

          01 axisCode             PIC S9(09) BINARY.
          01 axisErrorMessagePtr  POINTER VALUE NULL.
          
          01 statusCode           POINTER VALUE NULL.
          01 httpStatusCode       PIC X(2000).
          
          01 headerPtr            POINTER VALUE NULL.
          01 bytesRead            PIC S9(09) BINARY.
          01 bufferSize           PIC S9(09) BINARY.
          
          01 stringBufferCount    PIC 9(9) BINARY.

          01 request              PIC X(32767).
          
          01 response-area.
             05 response          PIC X OCCURS 32767 TIMES.
          
          01 some-pointer         POINTER.
          01 array-index          PIC S9(09) BINARY.
          
          LINKAGE SECTION.
          
          01 ls-working-buffer PIC X(32767).

          PROCEDURE DIVISION.
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
      * Web service logic. The code will attempt to invoke a web
      * service and display the results.
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
          MAIN.
      *--------------------------------------------------------------------
      * Uncomment to enable trace
      *--------------------------------------------------------------------
      *          CALL PROCEDURE "axiscAxisStartTrace" USING 
      *               BY VALUE ADDRESS OF logFile,
      *               BY VALUE logFilter.

      *--------------------------------------------------------------------
      * Web service logic. The code will attempt to invoke a Web service.
      *--------------------------------------------------------------------
                
      * Set URI to web service
                STRING "http://localhost:10039" 
                        Z"/web/services/students"
                        DELIMITED BY SIZE INTO uri.
                        
      * Create HTTP transport handle.
                CALL PROCEDURE "axiscTransportCreate" USING
                     BY VALUE ADDRESS OF uri,
                     BY VALUE AXISC_PROTOCOL_HTTP11,
                     GIVING tHandle.
                     
                IF (tHandle = NULL) 
                     DISPLAY "TransportCreate() failed.",
                     PERFORM errorFound.
                
      * Set HTTP method - redundant since default is GET
                MOVE Z"GET" TO propBuf1.
                CALL PROCEDURE "axiscTransportSetProperty" USING
                    BY VALUE tHandle, 
                    BY VALUE AXISC_HTTP_METHOD, 
                    BY VALUE ADDRESS OF propBuf1,
                    GIVING rc.
                    
      * Set basic auth
                MOVE Z"amra" TO propBuf1.
                MOVE Z"pwd" TO propBuf2.
                CALL PROCEDURE "axiscTransportSetProperty" USING
                    BY VALUE tHandle, 
                    BY VALUE AXISC_HTTP_BASICAUTH, 
                    BY VALUE ADDRESS OF propBuf1,
                    BY VALUE ADDRESS OF propBuf2,
                    GIVING rc.

      * Set connect timeout value
                COMPUTE propInt = 30.
                CALL PROCEDURE "axiscTransportSetProperty" USING
                    BY VALUE tHandle, 
                    BY VALUE AXISC_CONNECT_TIMEOUT, 
                    BY VALUE ADDRESS OF propInt,
                    GIVING rc.

      * Set SSL information - turn off SSLv2 and sslv3.
                MOVE Z"/QIBM/USERDATA/ICSS/CERT/SERVER/DEFAULT.KDB" 
                  TO propBuf1.
                CALL PROCEDURE "axiscTransportSetProperty" USING
                    BY VALUE tHandle, 
                    BY VALUE AXISC_HTTP_SSL, 
                    BY VALUE ADDRESS OF NULLSTR,
                    BY VALUE ADDRESS OF NULLSTR,
                    BY VALUE ADDRESS OF NONEVAL,
                    BY VALUE ADDRESS OF NONEVAL,
                    BY VALUE NULLPTR,
                    GIVING rc.

                PERFORM flushAndReceiveData.
                
      *--------------------------------------------------------------------
      * Now delete the handle 
      *--------------------------------------------------------------------

                PERFORM cleanup.
                GOBACK.
                
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
      * Procedure
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
       errorFound.
           DISPLAY "==Unknown error encountered.".
           STOP RUN.
           
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
      * Procedure
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
       cleanup.
           CALL PROCEDURE "axiscTransportDestroy" USING
                BY VALUE tHandle.
                
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
      * Procedure
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
       checkError.
           DISPLAY "==Transport API Error encountered.".

      *--------------------------------------------------------------------
      * Get Axis client library error code
      *--------------------------------------------------------------------           
           CALL PROCEDURE "axiscTransportGetLastErrorCode" USING
                BY VALUE tHandle, 
                GIVING axisCode.
                
      *--------------------------------------------------------------------
      * Get Axis client library error message
      *--------------------------------------------------------------------           
           CALL PROCEDURE "axiscTransportGetLastError" USING
                BY VALUE tHandle, 
                GIVING axisErrorMessagePtr.
           
      *--------------------------------------------------------------------
      * Write out error code and error message
      *--------------------------------------------------------------------           
           SET ADDRESS OF ls-working-buffer TO axisErrorMessagePtr.
           
           INSPECT ls-working-buffer TALLYING stringBufferCount
                   FOR CHARACTERS BEFORE X"00".
           
           DISPLAY "(" axisCode ") " 
                   ls-working-buffer(1:stringBufferCount).
           
           PERFORM cleanup.
           
           STOP RUN.
           
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
      * Procedure
      *--------------------------------------------------------------------
      *--------------------------------------------------------------------
       flushAndReceiveData.
       
      *--------------------------------------------------------------------
      * Flush data so request is sent
      *--------------------------------------------------------------------
           CALL PROCEDURE "axiscTransportFlush" USING
                BY VALUE tHandle, 
                GIVING rc.
           IF (rc = -1) 
               PERFORM checkError.
           
      *--------------------------------------------------------------------
      * Receive data and print out data and response to stdout
      *--------------------------------------------------------------------

           COMPUTE bytesRead = 0.
           COMPUTE rc = 0.
           
           PERFORM TEST AFTER UNTIL rc < 1 
                              AND bytesREAD < MAX-BUFFER-SIZE
              
      *--------------------------------------------------------------------
      * Need to move pointer to next available free space in buffer
      * after each read until an error or no more data. 
      *--------------------------------------------------------------------
              COMPUTE bytesRead   = bytesRead + rc
              COMPUTE bufferSize  = MAX-BUFFER-SIZE - bytesRead
              COMPUTE array-index = bytesRead + 1
              
              SET some-pointer TO ADDRESS OF response(array-index)
                            
              CALL PROCEDURE "axiscTransportReceive" USING
                   BY VALUE tHandle, 
                   BY VALUE some-pointer,
                   BY VALUE bufferSize,
                   BY VALUE 0,
                   GIVING rc     
           END-PERFORM.
      
           IF (rc = -1) 
               PERFORM checkError.
               
           IF (bytesRead = 0) 
               DISPLAY "No data to read".
               
      *--------------------------------------------------------------------
      * If we read some bytes, dump that data.
      *--------------------------------------------------------------------
           IF (bytesRead > 0)  
               DISPLAY "Bytes read: " bytesRead,
               SET ADDRESS OF ls-working-buffer TO 
                   ADDRESS OF response(1),
               DISPLAY "Data: " ls-working-buffer(1:bytesRead).
                      
      *--------------------------------------------------------------------
      * Dump HTTP status code.
      *--------------------------------------------------------------------
          CALL PROCEDURE "axiscTransportGetProperty" USING
               BY VALUE tHandle, 
               BY VALUE AXISC_HTTP_STATUS_CODE, 
               BY VALUE ADDRESS OF some-pointer,
               GIVING rc,
                    
          IF (rc = -1) 
              PERFORM checkError,
          ELSE     
              SET ADDRESS OF ls-working-buffer TO some-pointer,
           
              DISPLAY "HTTP status code: " ls-working-buffer(1:3).
               
