Class ::nsmcp::QuestionService (public)

 ::nx::Class ::nsmcp::QuestionService

Defined in /usr/local/ns/tcl/nsmcp/question-service.tcl

Testcases:

No testcase defined.

Source code:

    :object variable section ns/server/[ns_info server]/module/nsmcp

    :property backend:required
    :property {backends {}}
    :property {backendErrors {}}
    :property store:required
    :property queue:required
    :property {lifetime 3600}
    :property {maxConversations:integer 20}
    :property {maxTurns:integer 20}
    :property {maxBytes:integer 2097152}
    :property {maxEvidenceBytes:integer 16777216}
    :property {evidenceDirectory {}}
    :variable mutex
    
    :method init {} {
        if {${:maxBytes}<1 || ${:maxEvidenceBytes}<1} {error "Question storage limits must be positive"}
        if {${:evidenceDirectory} eq ""} {
            set channel [file tempfile path]
            close $channel
            file delete $path
            set :evidenceDirectory ${path}.questions
        }
        set :evidenceDirectory [file normalize ${:evidenceDirectory}]
        if {![file exists ${:evidenceDirectory}]} {
            file mkdir ${:evidenceDirectory}
            file attributes ${:evidenceDirectory} -permissions 0700
        }
        if {[file type ${:evidenceDirectory}] ne "directory" || ([file attributes ${:evidenceDirectory} -permissions]&0077)!=0} {
            error "Question evidence directory must be private (0700)"
        }
        :cleanup
        set :mutex [ns_mutex create]
        if {${:queue} ni [ns_job queues]} {ns_job create ${:queue} 1}
    }
    :method owned {context handle} {
        if {![regexp {^[a-f0-9]{64}$} $handle] || ![nsv_exists ${:store} $handle]} {return -code error -errorcode {NSMCP QUESTION CONVERSATION_UNAVAILABLE} "Unknown or expired conversation"}
        set record [nsv_get ${:store} $handle]
        if {[dict get $record principal] ne [$context principal] || [dict get $record server] ne [$context server]} {
            return -code error -errorcode {NSMCP QUESTION CONVERSATION_UNAVAILABLE} "Unknown or expired conversation"
        }
        if {[dict get $record expires] <= [clock seconds] && [dict get $record status] ni {queued running cancelling}} {
            :drop $handle
            return -code error -errorcode {NSMCP QUESTION CONVERSATION_UNAVAILABLE} "Unknown or expired conversation"
        }
        return $record
    }
    :public method describe {} {
        return [dict merge [${:backend} describe] [dict create maxBytes ${:maxBytes} maxEvidenceBytes ${:maxEvidenceBytes}]]
    }
    # Evidence is separate from the bounded conversation/continuation record.
    # Callers hold the service mutex; public retrieval verifies conversation
    # ownership before accepting an opaque evidence identifier.
    :method cleanup {} {
        foreach path [glob -nocomplain -directory ${:evidenceDirectory} *] {
            set handle [file tail $path]
            if {![regexp {^[a-f0-9]{64}$} $handle]} {continue}
            if {![nsv_exists ${:store} $handle]} {file delete -force $path; continue}
            set record [nsv_get ${:store} $handle]
            if {[dict get $record expires]<=[clock seconds] && [dict get $record status] ni {queued running cancelling}} {:drop $handle}
        }
    }
    :method drop {handle} {
        file delete -force [file join ${:evidenceDirectory} $handle]
        nsv_unset -nocomplain ${:store} $handle
    }
    :method toolEvidence {handle event} {
        set result [dict get $event result]
        set directory [file join ${:evidenceDirectory} $handle]
        set used 0
        foreach path [glob -nocomplain -directory $directory *.json] {incr used [file size $path]}
        set bytes [string length [encoding convertto utf-8 $result]]
        dict set event result {}
        dict set event evidenceHandle {}
        if {$used+$bytes>${:maxEvidenceBytes}} {
            dict set event result {Evidence omitted: conversation evidence storage limit reached.}
            dict set event truncated true
            return $event
        }
        set temporary {}
        set channel {}
        if {[catch {
            if {![file exists $directory]} {file mkdir $directory; file attributes $directory -permissions 0700}
            set id [ns_crypto::randombytes -encoding hex 16]
            set channel [file tempfile temporary [file join $directory pending-]]
            file attributes $temporary -permissions 0600
            fconfigure $channel -encoding utf-8 -translation lf
            puts -nonewline $channel $result
            close $channel
            set channel {}
            file rename $temporary [file join $directory $id.json]
            dict set event evidenceHandle $id
            # Tiny results remain inline for older admin clients and cheap polling.
            if {$bytes<=4096} {dict set event result $result}
        } reason]} {
            if {$channel ne ""} {catch {close $channel}}
            if {$temporary ne ""} {catch {file delete $temporary}}
            ns_log warning "nsmcp: question evidence could not be retained: $reason"
            dict set event result {Evidence unavailable: storage failed. The model may still have used this result.}
            dict set event truncated true
        }
        return $event
    }
    :public method evidence {context handle id} {
        ns_mutex lock ${:mutex}
        try {
            set record [:owned $context $handle]
            if {![regexp {^[a-f0-9]{32}$} $id]} {error "Unknown evidence"}
            set found false
            foreach turn [dict get $record turns] {
                foreach tool [dict get $turn tools] {
                    if {[dict exists $tool evidenceHandle] && [dict get $tool evidenceHandle] eq $id} {set found true}
                }
            }
            if {!$found} {error "Unknown evidence"}
            set path [file join ${:evidenceDirectory} $handle $id.json]
            if {[file type $path] ne "file" || [file size $path]>${:maxEvidenceBytes}} {error "Evidence unavailable"}
            set channel [open $path r]
            try {
                fconfigure $channel -encoding utf-8 -translation lf
                set result [read $channel]
            } finally {close $channel}
            return [list {} object [list result string $result]]
        } finally {ns_mutex unlock ${:mutex}}
    }


    :method defaultBackend {} {return [dict get [${:backend} describe] backend]}

    :method provider {name} {
        if {[dict exists ${:backends} $name]} {return [dict get ${:backends} $name]}
        if {$name eq [:defaultBackend]} {return ${:backend}}
        error "Question backend is not available"
    }

    # Choices are configuration metadata only; do not contact either provider.
    :public method choices {} {
        set providers ${:backends}
        dict set providers [:defaultBackend] ${:backend}
        set choices {}
        dict for {name object} $providers {
            dict set choices $name [dict merge [$object describe] {available true}]
        }
        dict for {name reason} ${:backendErrors} {
            if {![dict exists $choices $name]} {
                dict set choices $name [dict create available false reason $reason]
            }
        }
        return [dict create default [:defaultBackend] backends $choices]
    }
    :public method send {context question {handle {}} {backendName {}}} {
        set question [string trim $question]
        if {$question eq "" || [string bytelength $question] > 16384} {error "Supply a question up to 16 KiB"}
        ns_mutex lock ${:mutex}
        try {
            if {$handle eq ""} {
                :cleanup
                foreach key [nsv_array names ${:store}] {
                    set old [nsv_get ${:store} $key]
                    if {[dict get $old expires] <= [clock seconds] && [dict get $old status] ni {queued running cancelling}} {
                        :drop $key
                    }
                }
                if {[llength [nsv_array names ${:store}]] >= ${:maxConversations}} {error "Conversation limit reached; remove an old conversation"}
                if {$backendName eq ""} {set backendName [:defaultBackend]}
                :provider $backendName
                set handle [ns_crypto::randombytes -encoding hex 32]
                set record [dict create principal [$context principal] server [$context server] backend $backendName status idle state {} turns {}]
            } else {
                set record [:owned $context $handle]
                if {![dict exists $record backend]} {dict set record backend [:defaultBackend]}
                if {$backendName ne "" && $backendName ne [dict get $record backend]} {
                    error "Changing backend requires a new conversation"
                }
            }
            if {[dict get $record status] in {queued running cancelling}} {error "A question is already running in this conversation"}
            if {[llength [dict get $record turns]] >= ${:maxTurns}} {error "Conversation turn limit reached; start a new conversation"}
            set turn [ns_crypto::randombytes -encoding hex 16]
            dict set record current $turn
            dict set record status queued
            dict set record expires [expr {[clock seconds]+int(${:lifetime})}]
            dict lappend record turns [dict create id $turn question $question answer {} status queued tools {} error {}]
            nsv_set ${:store} $handle $record
            try {
                ns_job queue -detached ${:queue} [list [self] run $handle $turn]
            } on error {message options} {
                dict set record status failed
                set last [lindex [dict get $record turns] end]
                dict set last status failed
                dict set last error "Unable to queue the question"
                dict set record turns [lreplace [dict get $record turns] end end $last]
                nsv_set ${:store} $handle $record
                return -options $options $message
            }
        } finally {ns_mutex unlock ${:mutex}}
        return [:poll $context $handle]
    }
    :public method event {handle turn event} {
        ns_mutex lock ${:mutex}
        try {
            if {![nsv_exists ${:store} $handle]} {return false}
            set record [nsv_get ${:store} $handle]
            if {[dict get $record current] ne $turn} {return false}
            set continue [expr {[dict get $record status] ne "cancelling"}]
            if {[dict get $event type] eq "check"} {return $continue}
            set last [lindex [dict get $record turns] end]
            switch -- [dict get $event type] {
                text {dict append last answer [dict get $event text]}
                job {
                    set key [dict get $event jobHandle]
                    if {![dict exists $last jobs $key] && [dict exists $last jobs] && [dict size [dict get $last jobs]]>=128} {
                        error "Question background job limit reached"
                    }
                    dict set last jobs $key $event
                }
                tool {dict lappend last tools [:toolEvidence $handle $event]}
                state {
                    set state [dict get $event state]
                    if {[string bytelength $state]>${:maxBytes}} {error "Question continuation size limit reached; start a new conversation"}
                    dict set record state [zlib compress [encoding convertto utf-8 $state]]
                    dict set record stateEncoding zlib-tcl-v1
                }
            }
            dict set record turns [lreplace [dict get $record turns] end end $last]
            if {[string bytelength $record] > ${:maxBytes}} {error "Conversation size limit reached (${:maxBytes} bytes); start a new conversation"}
            nsv_set ${:store} $handle $record
            return $continue
        } finally {ns_mutex unlock ${:mutex}}
    }
    :public method run {handle turn} {
        ns_mutex lock ${:mutex}
        try {
            if {![nsv_exists ${:store} $handle]} {return}
            set record [nsv_get ${:store} $handle]
            if {[dict get $record current] ne $turn} {return}
            if {[dict get $record status] in {cancelling cancelled}} {
                set skip true
            } else {
                set skip false
                dict set record status running
                nsv_set ${:store} $handle $record
            }
            set state [dict get $record state]
            if {[dict exists $record stateEncoding]} {
                set state [encoding convertfrom utf-8 [zlib decompress $state]]
            }
            set backendName [:defaultBackend]
            if {[dict exists $record backend]} {set backendName [dict get $record backend]}
            set question [dict get [lindex [dict get $record turns] end] question]
        } finally {ns_mutex unlock ${:mutex}}
        # A timed-out turn may have started a job without publishing provider
        # history. Carry its handle explicitly into the next question.
        set pendingJobs {}
        foreach previous [dict get $record turns] {
            if {![dict exists $previous jobs]} continue
            dict for {jobHandle job} [dict get $previous jobs] {
                dict set job needsRetrieval [expr {[dict get $previous status] in {failed cancelled}
                    || [dict get $job status] in {queued running}}]
                dict set pendingJobs $jobHandle $job
            }
        }
        dict for {jobHandle job} $pendingJobs {
            if {[dict get $job needsRetrieval]} {
                append question "\nExisting background jobHandle $jobHandle ([dict get $job name]); retrieve it with log_results rather than starting it again."
            }
        }
        set error {}
        set status cancelled
        if {!$skip} {
            if {[catch {[:provider $backendName] run $question $state [list [self] event $handle $turn]} status]} {
                set error $status
                set status failed
            }
        }
        ns_mutex lock ${:mutex}
        try {
            if {![nsv_exists ${:store} $handle]} {return}
            set record [nsv_get ${:store} $handle]
            if {[dict get $record current] ne $turn} {return}
            if {[dict get $record status] eq "cancelling"} {set status cancelled; set error {}}
            dict set record status $status
            set last [lindex [dict get $record turns] end]
            dict set last status $status
            dict set last error $error
            dict set record turns [lreplace [dict get $record turns] end end $last]
            nsv_set ${:store} $handle $record
        } finally {ns_mutex unlock ${:mutex}}
    }
    :public method cancel {context handle} {
        ns_mutex lock ${:mutex}
        try {
            set record [:owned $context $handle]
            if {[dict get $record status] eq "queued"} {
                dict set record status cancelled
                set last [lindex [dict get $record turns] end]
                dict set last status cancelled
                dict set record turns [lreplace [dict get $record turns] end end $last]
                nsv_set ${:store} $handle $record
            } elseif {[dict get $record status] eq "running"} {
                dict set record status cancelling
                nsv_set ${:store} $handle $record
            }
        } finally {ns_mutex unlock ${:mutex}}
        return [:poll $context $handle]
    }
    :public method forget {context handle} {
        ns_mutex lock ${:mutex}
        try {
            set record [:owned $context $handle]
            if {[dict get $record status] in {queued running cancelling}} {error "Cancel the running question before starting a new conversation"}
            :drop $handle
        } finally {ns_mutex unlock ${:mutex}}
        return {{} object {status string forgotten}}
    }
    :public method poll {context handle} {
        ns_mutex lock ${:mutex}
        try {set record [:owned $context $handle]} finally {ns_mutex unlock ${:mutex}}
        set turns {}; set i 0
        foreach entry [dict get $record turns] {
            set tools {}; set j 0
            foreach call [dict get $entry tools] {
                lappend tools $j object [list name string [dict get $call name] status string [dict get $call status]  arguments string [dict get $call arguments] result string [dict get $call result] truncated boolean [dict get $call truncated]]
                if {[dict exists $call evidenceHandle]} {
                    set fields [lindex $tools end]
                    lappend fields evidenceHandle string [dict get $call evidenceHandle]
                    set tools [lreplace $tools end end $fields]
                }
                incr j
            }
            set jobs {}; set k 0
            if {[dict exists $entry jobs]} {
                dict for {jobHandle job} [dict get $entry jobs] {
                    set fields [list jobHandle string $jobHandle name string [dict get $job name] status string [dict get $job status]]
                    if {[dict exists $job progress]} {
                        set progress {}
                        foreach key {examinedBytes sourceBytes} {
                            if {[dict exists $job progress $key]} {lappend progress $key number [dict get $job progress $key]}
                        }
                        lappend fields progress object $progress
                    }
                    lappend jobs $k object $fields
                    incr k
                }
            }
            lappend turns $i object [list id string [dict get $entry id] question string [dict get $entry question]  answer string [dict get $entry answer] status string [dict get $entry status]  error string [dict get $entry error] tools array $tools jobs array $jobs]
            incr i
        }
        set backendName [:defaultBackend]
        if {[dict exists $record backend]} {set backendName [dict get $record backend]}
        return [list {} object [list conversation string $handle server string [dict get $record server] backend string $backendName  status string [dict get $record status] expires number [dict get $record expires] turns array $turns]]
    }

    # Startup configuration belongs to the class object: the service instance
    # and its adapters do not exist yet. Backend construction is private; only
    # trusted configuration may supply endpoints, credentials and commands.
    :object method createBackend {backend moduleDirectory object} {
        set tokenFile [ns_config ${:section} questionMcpTokenFile {}]
        if {$tokenFile eq "" || [file pathtype $tokenFile] ne "absolute" || ![file isfile $tokenFile] || ![file readable $tokenFile]} {
            error "questionMcpTokenFile must name a readable absolute MCP credential file"
        }
        set timeout [ns_baseunit -time [ns_config ${:section} questionTimeout 180s]]
        set maxBytes [ns_baseunit -size [ns_config ${:section} questionMaxBytes 2MiB]]
        set maxResult [ns_baseunit -size [ns_config ${:section} questionMaxResultBytes 128KiB]]
        if {$timeout < 1 || $timeout > 3600 || $maxResult < 1024} {
            error "Questions require a 1..3600s timeout, result limit of at least 1KiB"
        }
        set field [expr {$backend eq "codex" ? "questionCodexModel" : "questionApiModel"}]
        set model [ns_config ${:section} $field {}]
        if {$model eq "" && $backend eq [ns_config ${:section} questionBackend codex]} {
            set model [ns_config ${:section} questionModel {}]
        }
        switch -- $backend {
            codex {
                set directory [ns_config ${:section} questionDirectory [file join [ns_info home] data nsmcp-questions]]
                file mkdir $directory
                set url [ns_config ${:section} questionMcpUrl {}]
                if {![regexp {^https?://[^/]+/} $url]} {error "questionMcpUrl must name an absolute HTTP(S) MCP endpoint"}
                set host [ns_config ${:section} questionMcpHost {}]
                if {$host ne "" && ![regexp {^[A-Za-z0-9.\[\]:_-]+$} $host]} {
                    error "questionMcpHost must be an HTTP authority without whitespace or a path"
                }
                set command [ns_config ${:section} questionCodexCommand codex]
                if {[auto_execok $command] eq ""} {error "questionCodexCommand is not executable: $command"}
                set launcher [file join $moduleDirectory scripts codex-questions.sh]
                ::nsmcp::CodexQuestionBackend create $object  -command $command -launcher $launcher  -tokenFile $tokenFile -url $url -host $host -directory $directory  -model $model -timeout $timeout -maxResultBytes $maxResult
            }
            chat-completions {
                set apiKeyFile [ns_config ${:section} questionApiKeyFile {}]
                if {[file pathtype $apiKeyFile] ne "absolute" || ![file isfile $apiKeyFile] || ![file readable $apiKeyFile]} {
                    error "questionApiKeyFile must name a readable absolute API key file"
                }
                if {$model eq ""} {error "questionModel is required for chat-completions"}
                set url [ns_config ${:section} questionApiUrl {}]
                if {[catch {ns_parseurl $url} parsed] || ![dict exists $parsed proto] || ![dict exists $parsed host]
                    || [dict exists $parsed userinfo] || [dict exists $parsed query] || [dict exists $parsed fragment]
                    || ([dict get $parsed proto] ne "https"
                        && !([dict get $parsed proto] eq "http" && [dict get $parsed host] in {127.0.0.1 ::1 localhost}))} {
                    error "questionApiUrl must be HTTPS (or loopback HTTP), without credentials, query or fragment"
                }
                set options [ns_json parse -output triples -maxdepth 16 -maxstring 16384 -maxcontainer 1000 -- [ns_config ${:section} questionApiOptions {{}}]]
                if {[lindex $options 1] ne "object"} {error "questionApiOptions must be a JSON object"}
                foreach {key type value} [lindex $options 2] {
                    if {$key in {model messages tools tool_choice stream stream_options max_tokens max_completion_tokens n}} {
                        error "questionApiOptions cannot override $key"
                    }
                }
                set maxResponse [ns_baseunit -size [ns_config ${:section} questionMaxResponseBytes 8MiB]]
                if {$maxResponse < 1024} {error "questionMaxResponseBytes must be at least 1KiB"}
                ::nsmcp::ChatCompletionsBackend create $object  -apiUrl $url -apiKeyFile $apiKeyFile -tokenFile $tokenFile -model $model -apiOptions $options  -timeout $timeout -maxResultBytes $maxResult -maxHistoryBytes [expr {$maxBytes/2}]  -maxResponseBytes $maxResponse  -maxOutputTokens [ns_config -int -min 1 -max 131072 ${:section} questionMaxOutputTokens 4096]  -maxToolCalls [ns_config -int -min 1 -max 128 ${:section} questionMaxToolCalls 32]  -maxApiRequests [ns_config -int -min 1 -max 64 ${:section} questionMaxApiRequests 16]
            }
        }
        return $object
    }

    # Read this virtual server's configuration and instantiate its service.
    # Alternatives may be unavailable; a configured default must initialize.
    :public object method setup {moduleDirectory} {
        if {![ns_config -bool ${:section} enableQuestions false]} {return}
        if {![nsf::object::exists ::nsmcp::tools]} {error "Questions require the configured nsmcp HTTP endpoint"}
        set backend [ns_config ${:section} questionBackend codex]
        if {$backend ni {codex chat-completions}} {error "Unsupported question backend: $backend"}
        set lifetime [ns_baseunit -time [ns_config ${:section} questionLifetime 1h]]
        if {$lifetime < 1} {error "questionLifetime must be positive"}
        set maxBytes [ns_baseunit -size [ns_config ${:section} questionMaxBytes 2MiB]]
        set maxEvidence [ns_baseunit -size [ns_config ${:section} questionMaxEvidenceBytes 16MiB]]
        if {$maxBytes<65536 || $maxEvidence<1024} {error "questionMaxBytes requires at least 64KiB; questionMaxEvidenceBytes requires at least 1KiB"}
        set evidenceDirectory [ns_config ${:section} questionEvidenceDirectory [file join [ns_info home] data nsmcp-question-evidence [ns_info server]]]
        if {[file pathtype $evidenceDirectory] ne "absolute"} {error "questionEvidenceDirectory must be absolute"}
        :createBackend $backend $moduleDirectory ::nsmcp::questionBackend
        set backends [dict create $backend ::nsmcp::questionBackend]
        set errors {}
        foreach candidate {codex chat-completions} {
            if {$candidate eq $backend} {continue}
            set object ::nsmcp::questionBackend_[string map {- _} $candidate]
            if {[catch {:createBackend $candidate $moduleDirectory $object} reason]} {
                if {[nsf::object::exists $object]} {$object destroy}
                dict set errors $candidate [string range $reason 0 1023]
            } else {
                dict set backends $candidate $object
            }
        }
        :create ::nsmcp::questions -backend ::nsmcp::questionBackend  -backends $backends -backendErrors $errors  -store nsmcp:questions:[ns_info server] -queue nsmcp-questions-[ns_info server]  -lifetime $lifetime -maxBytes $maxBytes -maxEvidenceBytes $maxEvidence -evidenceDirectory $evidenceDirectory  -maxConversations [ns_config -int -min 1 ${:section} questionMaxConversations 20]  -maxTurns [ns_config -int -min 1 ${:section} questionMaxTurns 20]
    }

XQL Not present:

Generic, PostgreSQL, Oracle