################################################################################
#                                                                              #
#   calnexRest.tcl                                                             #
#                                                                              #
#   TCL interface to the new line of Calnex products                           #
#                                                                              #
#   Copyright (c) Calnex Solutions Ltd 2008 - 2022                             #
#                                                                              # 
#   The contents of this file should not be copied or distributed              #
#   without permission being granted by Calnex Solutions Ltd.                  #
#                                                                              #
#   All rights reserved.                                                       #
#                                                                              #
################################################################################
#
# Version 1.1, 24 Oct 2022:
#     Displays HTTP request error contents
#
#
package require rest
package require json
package require json::write
package require md5


set [namespace current]::__IpAddress ""
set [namespace current]::__lastError ""
set [namespace current]::__authToken "null"


proc __chkForError { command } {
	global [namespace current]::__lastError
    if {[string compare $__lastError ""] != 0 } { 
		error "$__lastError (command=\"$command\")"
	}
}

proc calnexInit {IpAddr args} {
	global [namespace current]::__IpAddress
	global [namespace current]::__lastError
	global [namespace current]::__authToken
	
	if {$IpAddr == ""} {
		set __lastError "Must specify an IP Address for the instrument"
	} else {
		set __IpAddress $IpAddr
		
		# Ascertain whether or not authentication feature is enabled
		set features [dict get [calnexGet instrument/options/features] "Features"]
		set authFeatureEnabled [expr [lsearch $features "Authentication"]>=0]
	
		if {[llength $args]!=0 && [llength $args]!=1} {
			set __lastError "Unexpected number of arguments"
		} elseif {$authFeatureEnabled && [llength $args]!=1} {
			set __lastError "Password must be supplied"	
		} else {			
			if {$authFeatureEnabled} {
				set password [lindex $args 0]
				
				if {[string length $password]!=32} {			
					# Script has supplied a plain text password - MD5 hash it
					set tok [md5::MD5Init]
					md5::MD5Update $tok $password
					set password [string tolower [md5::Hex [md5::MD5Final $tok]]]
				}
				
				# Log in and obtain authentication token
				set authResp [calnexGet authentication/login Password $password]
				set __authToken [dict get $authResp "AuthToken"]
			} elseif {[llength $args]==1}	{
				# Script has passed a password - warn user but don't throw error
				puts "WARNING: Authentication option not fitted, supplied password not required!"
			}
			
			set model [calnexGetVal instrument/information HwType]
			set sn [calnexGetVal instrument/information SerialNumber]
			puts "$model $sn"
		}
	}

    __chkForError "calnexInit"
}

proc calnexSendReq {req url body} {
	global [namespace current]::__IpAddress
	global [namespace current]::__lastError
	global [namespace current]::__authToken
	
	set rawBody $body

	set httpErrorDict [dict create 400 "Bad Request" 401 "Not Authorised" 404 "Not Found" 500 "Internal Server Error" 501 "Not Implemented"]
	set ret ""
    set __lastError ""
    if {$__IpAddress == ""} {
        set __lastError "IP address not configured - call calnexInit before any other calls"
        set ret ""
    } else {
		set config "method ${req} headers \{Content-Type application/json\} error-body true"
		#set ret [rest::simple "http://$__IpAddress/api/${url}?format=json" "" $config $body]
		
		if { [catch {
		
			# Insert authentication token
			if {$body=="" || $body=="{}"} {
				# Body is empty so format from scratch
				set body [json::write object AuthToken $__authToken]
			} else {
				# Append onto existing body params
				set openBracePos  [string first \{ $body]
				set closeBracePos [string last \n\} $body]
				if {$openBracePos!=-1 && $closeBracePos>1} {
					set params [string range $body 0 $closeBracePos-1]
					set authParam ",\n    \"AuthToken\" : $__authToken\n\}"
					set body [concat $params$authParam]
				} else {
					set __lastError "Unexpected JSON body format"
				}
			}

			set ret [rest::simple "http://$__IpAddress/api/${url}?format=json" "" $config $body]
		} errmsg ] } {
			set httpErrorString ""
			set httpStr [lindex [split $errmsg] 0]
			if {$httpStr == "HTTP"} {
				set httpErrorNum [lindex [split $errmsg] 1]
				#puts $errmsg
				#puts $httpErrorNum
				if {[dict exists $httpErrorDict $httpErrorNum]} {
					set httpErrorString [dict get $httpErrorDict $httpErrorNum]
				}
				#throw $httpErrorNum "HTTP $httpErrorNum: $httpErrorString ($url)"
				set __lastError "HTTP $httpErrorNum: $httpErrorString \n $errmsg"
			} else {
				set __lastError "$errmsg"
			}
		}

	}
    return $ret
}

proc calnexGet {url args} {
	set body [json::write object {*}$args]
	set resp [calnexSendReq get $url $body]
	set res ""
	if {$resp!=""} {
		try {
			set res [json::json2dict $resp]
		} trap {JSON SYNTAX} {} {
			set res $resp
		}
	}
    __chkForError "calnexGet $url"
	return $res
}

proc calnexGetVal {url arg} {
	global [namespace current]::__lastError
    set body ""
	set ret ""
	set calnexSendReqRet [calnexSendReq get $url $body]
    __chkForError "calnexGetVal $url"
	set res [json::json2dict $calnexSendReqRet]
	if [dict exists $res $arg] {
		set ret [dict get $res $arg]
	} else {
		set __lastError "$arg does not exist in response: $res"
	}
    __chkForError "calnexGetVal $url"
	return $ret
}

proc calnexSet {url args} {
	set body [json::write object {*}$args]
	calnexSendReq put $url $body
    __chkForError "calnexSet $url"
}

proc calnexCreate {url args} {
	set body [json::write object {*}$args]
	calnexSendReq post $url $body
    __chkForError "calnexCreate $url"
}

proc calnexDel {url} {
	calnexSendReq delete $url ""
    __chkForError "calnexDel $url"
}

#
# Old syntax - kept for backwards compatibility
#

proc p100req {req url body} {
	return [calnexSendReq $req $url $body]
}

proc p100get {url args} {
	return [calnexGet $url {*}$args]
}

proc p100set {url args} {
	calnexSet $url {*}$args
}

proc p100create {url args} {
	calnexCreate $url {*}$args
}

proc p100del {url} {
	calnexDel $url
}

proc a100req {req url body} {
	return [calnexSendReq $req $url $body]
}

proc a100get {url args} {
	return [calnexGet $url {*}$args]
}

proc a100set {url args} {
	calnexSet $url {*}$args
}

proc a100create {url args} {
	calnexCreate $url {*}$args
}

proc a100del {url} {
	calnexDel $url
}