(!******************************************************
   Xpress Executor Example Model
   =============================

   file blendxe.mos
   ````````````````
   Demonstrates executing the 'blend3c' model using an Xpress Executor configured
   to run a submodel extracted from a zipfile, which also contains the input
   data.
   It will then display the results.
   Assumes that you have an Xpress Executor component already configured
   with the runzippedsubmodel.bim model.
  
   (c) 2015-2017 Fair Isaac Corporation
       author: J. Farmer, Jul. 2017
*******************************************************!)


model "Blend XE"
 uses "mmhttp", "mmssl", "mmsystem", "mmxml", "mmjobs"

 parameters

  ! You should set the DMP_XE_REST_ENDPOINT, DMP_SOLUTION_CLIENT_ID and DMP_SOLUTION_SECRET parameters
  ! to point to the component you want to test.
  
  ! The REST endpoint of the Xpress Executor DMP component
  ! Obtain this by clicking "View Links" for the Xpress Executor component on the DMP UI
  DMP_XE_REST_ENDPOINT=""

  ! The client ID of solution containing the Xpress Executor DMP component
  ! Obtain this through the DMP UI
  DMP_SOLUTION_CLIENT_ID=""

  ! The secret of the solution containing the Xpress Executor DMP component
  ! Obtain this through the DMP UI
  DMP_SOLUTION_SECRET=""

  ! The root DMP manager URL. This will be different depending on which instance of DMP you are using.
  DMP_MANAGER_URL="https://manager-svc.prd-platform.ficoanalyticcloud.com"

  ! The remote model file
  MODELFILE="../model/blend3c.mos"

  ! The input file for the remote model
  INPUTFILE="../data/blend.csv"

  ! File into which to save the results
  RESULTFILE="blendresults.csv"

 end-parameters

 declarations
  ! XML document containing final status of execution
  executionStatus: xmldoc
  
  ! Array of parameters
  modelParameterNames: set of string
  modelParameters: dynamic array(modelParameterNames) of text

  ! Array of input files to include in zip (not including submodel bim)
  ! In this array, key is the local file, value is path of file in the zipfile
  modelInputSourceFiles: set of string
  modelInputFiles: dynamic array(modelInputSourceFiles) of text

  ! Token used to authorise access to the Xpress Executor component
  bearerToken: text
 end-declarations

 forward procedure authoriseDmpComponent
 forward procedure createInputZip(modelfile:text,modelInputFiles:array(modelInputSourceFiles) of text)
 forward function startExecution(inputzipfile:text,modelParameters:array(modelParameterNames) of text) : xmldoc
 forward procedure waitForCompletion(executionStatus:xmldoc)
 forward procedure deleteExecution(executionStatus:xmldoc)
 forward function getURLFromPath(path:text) : text
 forward function getNodeValue(doc:xmldoc,path:text) : text
 forward function getNodeValue(doc:xmldoc,path:string) : text
 forward function fetchPathFromComponent(path:text,destfile:text) : integer
 
 public declarations
  ! Temporary variables used in assembling HTTP requests
  httpPostBody: text
  httpResponseBody: text
  inputBase64: text
  runLog: text
 end-declarations
 
 ! Configure Mosel to use TLS1.2 ciphers with HTTPS to allow us to talk to DMP
 setparam("https_ciphers","TLSv1.2+HIGH:\!SSLv2:\!aNULL:\!eNULL:\!3DES:@STRENGTH")

 ! Log into DMP
 writeln("Requesting authorization token from DMP")
 authoriseDmpComponent

 ! Execute our model
 writeln("Initiating model execution")
 modelParameters("INPUTFILE"):="blend.csv"     ! Read inputs from the file blend.csv
 modelParameters("RESULTFILE"):="result"       ! In Xpress Executor, we can only access model results from a file called "result"
 modelInputFiles(INPUTFILE) := "blend.csv"     ! Include blend.csv in the zipfile we upload
 createInputZip(MODELFILE,modelInputFiles)
 executionStatus := startExecution("input.zip",modelParameters)

 ! Model will be executing asynchronously; wait for it to complete.
 writeln("Waiting for completion of execution")
 waitForCompletion(executionStatus)
 
 ! Check execution was successful
 writeln("Processing model results")
 ! In event of failure, echo the remote model status, exit code & run log to aid with troubleshooting
 if getNodeValue(executionStatus,"/jsv/status")<>"OK" or getNodeValue(executionStatus,"/jsv/exitCode")<>"0" then
  writeln("Execution failed!")
  writeln("Execution status: ", getNodeValue(executionStatus,"/jsv/status"))
  writeln("Execution exit code: ", getNodeValue(executionStatus,"/jsv/exitCode"))
  writeln
  writeln("Execution log:")
  ! Fetch the remote execution log as it may contain error messages from the model
  if fetchPathFromComponent( getNodeValue(executionStatus,"/jsv/runLogPath"), "text:runLog" )<>200 then
   writeln("Execution log not available")
  end-if
  writeln(runLog)
  exit(1)
 end-if
 
 ! Download results file
 if fetchPathFromComponent( getNodeValue(executionStatus,"/jsv/resultPath"), RESULTFILE )<>200 then
  writeln("Model results are not available!")
  exit(1)
 end-if
 
 ! Parse results and display to user
 declarations
  ORES=1..2
  use: array(ORES) of real
 end-declarations
 initializations from "mmsheet.csv:"+RESULTFILE
  use as "[A1:B2]"
 end-initializations
 writeln
 writeln("Solution:")
 forall(o in ORES)  writeln(" use(" + o + "): ", use(o))

 ! Delete execution from component
 deleteExecution( executionStatus )


 ! Use the client ID and secret from the solution to request a token that we can use to
 ! authorise access to the Xpress Executor component
 procedure authoriseDmpComponent
  declarations
   payloadDoc: xmldoc
   responseCode: integer
  end-declarations
  
  ! Assemble payload to send to DMP
  reset(payloadDoc)
  rootElem := addnode(payloadDoc, 0, XML_ELT, "jsv")
  setattr(payloadDoc, rootElem, "jst", "obj")
  clientIdElem := addnode(payloadDoc, rootElem, XML_ELT, "clientId")
  setattr(payloadDoc, clientIdElem, "jst", "str")
  setvalue(payloadDoc, clientIdElem, DMP_SOLUTION_CLIENT_ID)
  secretElem := addnode(payloadDoc, rootElem, XML_ELT, "secret")
  setattr(payloadDoc, secretElem, "jst", "str")
  setvalue(payloadDoc, secretElem, DMP_SOLUTION_SECRET)

  ! Post to server
  jsonsave(payloadDoc, "text:httpPostBody")
  reset(payloadDoc)
  responseCode := httppost( DMP_MANAGER_URL + "/registration/rest/client/token", "text:httpPostBody", "text:httpResponseBody", "Content-Type: application/json" );
  reset(httpPostBody)
  
  ! Check response
  if responseCode<>200 then
    writeln("ERROR: Failed to authorise with DMP (HTTP response: "+responseCode+")")
    writeln(httpResponseBody)
    exit(1)
  end-if
  
  ! Store bearer token
  bearerToken := httpResponseBody
  reset(httpResponseBody)
 end-procedure
 
 
 ! Build the input zipfile from the given files
 procedure createInputZip(modelfile:text,modelInputFiles:array(modelInputSourceFiles) of text)
  declarations
   zipdir, workdir: string
  end-declarations

  ! Create temporary directory
  workdir := getparam("workdir")
  zipdir := workdir + "/inputdir"
  makedir(zipdir)
  if getsysstat<>0 then
   writeln("Failed to create ",zipdir)
   exit(1)
  end-if

  ! Compile or copy model into directory
  if endswith(modelfile,".mos") then
   if compile("s",string(modelfile),zipdir+"/submodel.bim")<>0 then
    writeln("ERROR: Failed to compile ",modelfile)
    exit(1)
   end-if
  else
   fcopy(modelfile,zipdir+"/submodel.bim")
   if getsysstat<>0 then
    writeln("ERROR: Failed to copy ",modelfile," to ",zipdir,"/submodel.bim")
    exit(1)
   end-if
  end-if

  ! Copy other input files into directory
  forall( sourceFileName in modelInputSourceFiles | exists(modelInputFiles(sourceFileName)) ) do
   fcopy( sourceFileName, zipdir+"/"+modelInputFiles(sourceFileName) )
   if getsysstat<>0 then
    writeln("ERROR: Failed to copy ",sourceFileName," to ",zipdir,"/",modelInputFiles(sourceFileName)  )
    exit(1)
   end-if
  end-do

  ! Ensure old zipfile if present
  if getfstat("input.zip")<>0 then
   removefiles("input.zip")
  end-if

  ! Create zip
  newzip(0, "input.zip", zipdir, [text("submodel.bim")]+ sum(sourceFileName in modelInputSourceFiles | exists(modelInputFiles(sourceFileName))) [modelInputFiles(sourceFileName)] )
  if getsysstat<>0 then
   writeln("ERROR: Failed to create zipfile" )
   exit(1)
  end-if

  ! Clean up
  removefiles( SYS_RECURS, zipdir, "*" )
  removedir(zipdir)
 end-procedure


 ! Start execution of model, using the given input data files.  Returns initial execution status
 function startExecution(inputzipfile:text,modelParameters:array(modelParameterNames) of text) : xmldoc
  declarations
   payloadDoc: xmldoc
   responseDoc: xmldoc
   responseCode: integer
   headers: text
   paramstr: text
  end-declarations

  ! Assemble payload to send to DMP
  reset(payloadDoc)
  rootElem := addnode(payloadDoc, 0, XML_ELT, "jsv")
  setattr(payloadDoc, rootElem, "jst", "obj")
  
  ! Create parameters string
  forall( paramName in modelParameterNames | exists(modelParameters(paramName)) ) do
   setmodpar(paramstr, paramName, modelParameters(paramName))
  end-do
  ! Set parameters in JSON doc
  paramsElem := addnode(payloadDoc, rootElem, XML_ELT, "parameters")
  setattr(payloadDoc, paramsElem, "jst", "obj")
  paramElem := addnode(payloadDoc, paramsElem, XML_ELT, "jsv")
  setattr(payloadDoc, paramElem, "name", "SUBMODEL_PARAMS")
  setattr(payloadDoc, paramElem, "jst", "str")
  setvalue(payloadDoc, paramElem, paramstr)

  ! Set input data
  fcopy( inputzipfile, "mmssl.base64:text:inputBase64" )
  if getsysstat<>0 then
   writeln("Error encoding ",inputzipfile)
   exit(1)
  end-if
  inputDataElem := addnode(payloadDoc, rootElem, XML_ELT, "inputBase64")
  setattr(payloadDoc, inputDataElem, "jst", "str")
  setvalue(payloadDoc, inputDataElem, inputBase64 )
  reset(inputBase64)
  
  ! Assemble HTTP headers
  headers += "Content-Type: application/json\n"
  headers += "Accepts: application/json\n"
  headers += "Authorization: Bearer "+bearerToken+"\n"
  
  ! Post to server
  jsonsave(payloadDoc, "mmsystem.text:httpPostBody")
  reset(payloadDoc)
  responseCode := httppost( DMP_XE_REST_ENDPOINT, "text:httpPostBody", "text:httpResponseBody", headers );
  reset(httpPostBody)
  
  ! Check response
  if responseCode<>200 then
    writeln("ERROR: Failed to start model execution (HTTP response: "+responseCode+")")
    writeln(httpResponseBody)
    exit(1)
  end-if
  
  ! Parse response JSON
  jsonload(responseDoc, "text:httpResponseBody", 0)
  reset(httpResponseBody)
  returned := responseDoc
  
 end-function
 

 ! Return URL of given path on Xpress Executor component
 function getURLFromPath(path:text) : text
  declarations
   url: text
  end-declarations
  ! Strip the path off the endpoint URL
  url := DMP_XE_REST_ENDPOINT
  lastSlash := 0
  forall (i in 1..3) do
   nextSlash := findtext(url,"/",lastSlash+1)
   if nextSlash=0 then
    writeln("Failed to parse URL!")
    exit(1)
   end-if
   lastSlash := nextSlash
  end-do
  deltext(url, lastSlash, getsize(url))
  ! Append given path
  url += path
  ! And done
  returned := url
 end-function
 
 
 ! Return content of given XPATH expression in given document.  Aborts model if was not found.
 function getNodeValue(doc:xmldoc,path:string) : text
  declarations
   nodeId: integer
  end-declarations
  
  nodeId := getnode(doc,path)
  if nodeId=-1 then
   writeln("Failed to find node '",path,"' in document")
   exit(1)
  end-if
  
  returned := getvalue(doc,nodeId)
 end-function
 function getNodeValue(doc:xmldoc,path:text) : text
  returned := getNodeValue(doc,string(path))
 end-function


 ! Fetch the given path from the Xpress Executor component and save content to the given destination file. Returns response code.
 function fetchPathFromComponent(path:text,destfile:text) : integer
  declarations
   responseCode: integer
   headers: text
   url: text
  end-declarations

  reset(headers)
  headers += "Accepts: application/json\n"
  headers += "Authorization: Bearer "+bearerToken+"\n"
  url := getURLFromPath( path )

  responseCode := httpget( url, string(destfile), headers )
  returned := responseCode
 end-function


 
 ! Wait for model execution to complete; updates the supplied execution status document
 procedure waitForCompletion(executionStatus: xmldoc)
  declarations
   responseCode: integer
  end-declarations

  ! Loop while status indicates execution not completed
  status := getNodeValue(executionStatus,"/jsv/status")
  while (status="NOT_COMPLETED" or status="NOT_LOADED") do
   ! Wait for half a second
   sleep(500)

   ! Refresh status
   responseCode := fetchPathFromComponent( getNodeValue(executionStatus,"/jsv/statusPath"), "text:httpResponseBody" )
   if responseCode<>200 then
    writeln("ERROR: Encountered HTTP error code ",responseCode," when querying execution status")
    writeln(httpResponseBody)  ! Write out response body, in case it contains an error message.
    exit(1)
   end-if
   jsonload(executionStatus, "text:httpResponseBody", 0)
   reset(httpResponseBody)
   status := getNodeValue(executionStatus,"/jsv/status")
  end-do
  
 end-procedure


 ! Delete the execution from the service
 procedure deleteExecution(executionStatus: xmldoc)
  declarations
   responseCode: integer
   headers: text
  end-declarations

  reset(headers)
  headers += "Accepts: application/json\n"
  headers += "Authorization: Bearer "+bearerToken+"\n"

  responseCode := httpdel( getURLFromPath(getNodeValue(executionStatus,"/jsv/statusPath")), "null:", headers )
  if responseCode<>200 then
   writeln("Warning: Received HTTP response ",responseCode," when deleting execution")
  end-if
 end-procedure


end-model