# negotiation.test --
#
# Tests HTTP protocol negotiation and related transfer options.
#
# Copyright (c) 2024-2026 Massimo Manghi
#
# SPDX-License-Identifier: TCL
#
# See the file "license.terms" at the top level of this distribution
# for information on usage and redistribution of this file, and for the
# complete disclaimer of warranties and limitation of liability.
#
# Portions of this file were drafted or revised with AI assistance
# under the direction and review of Massimo Manghi

package require tcltest
package require zlib
namespace import ::tcltest::*

source [file join [file dirname [file normalize [info script]]] support.tcl]
source [file join [file dirname [file normalize [info script]]] http_common.tcl]

::tclcurl::test::load_package

proc ::tclcurl::test::chunk_encode_fixture {body {chunkSize 16}} {
    set encoded {}
    set bodyLength [string length $body]
    for {set offset 0} {$offset < $bodyLength} {incr offset $chunkSize} {
        set chunk [string range $body $offset [expr {$offset + $chunkSize - 1}]]
        append encoded [format %X [string length $chunk]] "\r\n" $chunk "\r\n"
    }
    append encoded "0\r\n\r\n"
    return $encoded
}

test negotiation-1.1 {-httpversion 1.0 sends an HTTP/1.0 request} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                          -httpversion 1.0 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        set response [::tclcurl::test::parse_server_response $body]
        list $rc \
             [$handle getinfo responsecode] \
             [dict get $response request-version]
    }
} -result {0 200 1.0}

test negotiation-1.2 {-httpversion 1.1 sends an HTTP/1.1 request} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                          -httpversion 1.1 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        set response [::tclcurl::test::parse_server_response $body]
        list $rc \
             [$handle getinfo responsecode] \
             [dict get $response request-version]
    }
} -result {0 200 1.1}

test negotiation-1.3 {-httpversion rejects malformed values} -constraints http_server -body {
    ::tclcurl::test::with_easy_handle handle {
        set status [catch {
                  $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                                    -httpversion bogus \
                                    -noprogress 1
              } result]
        list $status [string match {bad http version "bogus"*} $result]
    }
} -result {1 1}

test negotiation-2.1 {-encoding identity sends Accept-Encoding: identity} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                          -encoding identity \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        set response [::tclcurl::test::parse_server_response $body]
        list $rc \
             [$handle getinfo responsecode] \
             [dict get $response accept-encoding]
    }
} -result {0 200 identity}

test negotiation-2.2 {-encoding deflated sends Accept-Encoding: deflated} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                          -encoding deflated \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        set response [::tclcurl::test::parse_server_response $body]
        list $rc \
             [$handle getinfo responsecode] \
             [dict get $response accept-encoding]
    }
} -result {0 200 deflated}

test negotiation-2.3 {-encoding all enables libcurl-supported encodings} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                          -encoding all \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        set response [::tclcurl::test::parse_server_response $body]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[dict get $response accept-encoding] ne {}}]
    }
} -result {0 200 1}

test negotiation-2.4 {-encoding rejects malformed values} -constraints http_server -body {
    ::tclcurl::test::with_easy_handle handle {
        set status [catch {
                  $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                                    -encoding bogus \
                                    -noprogress 1
              } result]
        list $status [string match {bad encoding "bogus"*} $result]
    }
} -result {1 1}

test negotiation-3.1 {-transferencoding requests transfer-encoded content} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                          -transferencoding 1 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        set response [::tclcurl::test::parse_server_response $body]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[dict get $response te] ne {}}] \
             [expr {[string first "TE" [dict get $response connection]] >= 0}]
    }
} -result {0 200 1 1}

test negotiation-3.2 {-transferencoding rejects malformed values} -constraints http_server -body {
    ::tclcurl::test::with_easy_handle handle {
        set status [catch {
                  $handle configure -url [::tclcurl::test::server::base_url request-inspect] \
                                    -transferencoding bogus \
                                    -noprogress 1
              } result]
        list $status [string match {setting option -transferencoding:*} $result]
    }
} -result {1 1}

test negotiation-4.1 {-contentdecoding decodes a deflated response body} -constraints http_server -body {
    set body {}
    set payload [::tclcurl::test::negotiation_payload]
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url deflated-data] \
                          -encoding deflated \
                          -contentdecoding 1 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {$body eq $payload}]
    }
} -result {0 200 1}

test negotiation-4.2 {-contentdecoding 0 preserves the compressed response body} -constraints http_server -body {
    set body {}
    set payload [::tclcurl::test::negotiation_payload]
    set compressed [zlib compress $payload]
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url deflated-data] \
                          -encoding deflated \
                          -contentdecoding 0 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {$body eq $compressed}]
    }
} -result {0 200 1}

test negotiation-5.1 {-transferdecoding decodes a chunked response body} -constraints http_server -body {
    set body {}
    set payload [::tclcurl::test::negotiation_payload]
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url chunked-data] \
                          -transferdecoding 1 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {$body eq $payload}]
    }
} -result {0 200 1}

test negotiation-5.2 {-transferdecoding 0 preserves chunk framing} -constraints http_server -body {
    set body {}
    set payload [::tclcurl::test::negotiation_payload]
    set chunked [::tclcurl::test::chunk_encode_fixture $payload]
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url chunked-data] \
                          -transferdecoding 0 \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {$body eq $chunked}]
    }
} -result {0 200 1}

cleanupTests
