# http.test --
#
# Tests HTTP transport features including bodies, headers, callbacks, and ranges.
#
# 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 sha256
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

test http-1.1 {GET into -bodyvar returns a body and 200 response code} -constraints http_server -body {
    ::tclcurl::test::transport_basic_get ::tclcurl::test::server::base_url {}
} -result {0 200 1}

test http-1.2 {HEAD populates -headervar and reports 200} -constraints http_server -body {
    ::tclcurl::test::transport_head ::tclcurl::test::server::base_url {}
} -result {0 200 1}

test http-1.3 {-writeproc receives body data} -constraints http_server -body {
    ::tclcurl::test::transport_writeproc ::tclcurl::test::server::base_url {}
} -cleanup {
    unset -nocomplain ::tclcurl::test::writeBuffer
} -result {0 200 1}

test http-1.4 {getinfo exposes transfer metadata after a successful request} -constraints http_server -body {
    ::tclcurl::test::transport_metadata ::tclcurl::test::server::base_url {}
} -result {1 1 1}

test http-1.5 {reset allows the same easy handle to be reused} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url] -bodyvar body -noprogress 1
        $handle perform
        set firstLength [string length $body]
        set body {}
        $handle reset
        $handle configure -url [::tclcurl::test::server::base_url] -bodyvar body -noprogress 1
        set rc [$handle perform]
        list $rc [expr {$firstLength > 0}] [expr {[string length $body] > 0}]
    }
} -result {0 1 1}

test http-1.6 {duphandle keeps a reusable request configuration} -constraints http_server -body {
    set body {}
    set dupBody {}
    set primary [curl::init]
    set duplicate {}
    set code [catch {
        $primary configure -url [::tclcurl::test::server::base_url] -bodyvar body -noprogress 1
        set duplicate [$primary duphandle]
        $duplicate configure -bodyvar dupBody
        set rc [$duplicate perform]
        list $rc [expr {[string length $dupBody] > 0}]
    } result options]
    catch {$duplicate cleanup}
    catch {$primary cleanup}
    return -options $options $result
} -result {0 1}

test http-1.7 {-http200aliases accepts a custom response line from the server} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure \
            -url [::tclcurl::test::server::base_url tclcurl-http200alias] \
            -bodyvar body \
            -http200aliases [list "yummy/4.5 200 OK" "great/1.3 350 WRONG"] \
            -noprogress 1
        set rc [$handle perform]
        list $rc [$handle getinfo responsecode] [expr {$body eq "http200aliases=matched\n"}]
    }
} -result {0 200 1}

test http-1.8 {-failonerror turns a missing resource into a Tcl error} -constraints http_server -body {
    set errbuf {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url tclcurl-missing-resource] -failonerror 1 -errorbuffer errbuf -noprogress 1
        list [catch {$handle perform}] [expr {[string length $errbuf] > 0}]
    }
} -result {1 1}

test http-1.9 {share handle can be attached to two easy handles} -constraints http_server -body {
    set share  [curl::shareinit]
    set first  [curl::init]
    set second [curl::init]
    set firstBody  {}
    set secondBody {}
    set code [catch {
        $share share dns
        $first  configure -url [::tclcurl::test::server::base_url] -share $share -bodyvar firstBody  -noprogress 1
        $second configure -url [::tclcurl::test::server::base_url] -share $share -bodyvar secondBody -noprogress 1
        $first perform
        $second perform
        list [expr {[string length $firstBody] > 0}] [expr {[string length $secondBody] > 0}]
    } result options]
    catch {$second cleanup}
    catch {$first cleanup}
    catch {$share cleanup}
    return -options $options $result
} -result {1 1}

test http-1.10 {share handle cleanup is rejected while an easy handle still uses it} -constraints http_server -body {
    set share  [curl::shareinit]
    set handle [curl::init]
    set code [catch {
        $share share dns
        $handle configure -url [::tclcurl::test::server::base_url] -share $share -noprogress 1
        $share cleanup
    } result]
    catch {$handle cleanup}
    catch {$share cleanup}
    list $code $result
} -result {1 {Share handle is still attached to one or more easy handles.}}

test http-1.11 {/tclcurl-man serves the HTML manual through the HTTP test server} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url tclcurl-man] \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[string first "<title>TclCurl</title>" $body] >= 0}] \
             [expr {[$handle getinfo contenttype] eq "text/html; charset=utf-8"}]
    }
} -result {0 200 1 1}

test http-1.12 {the default path serves the seeded doc root index page} -constraints http_server -body {
    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::env_or_default TCLCURL_TEST_HTTP_BASE_URL "http://127.0.0.1:8990/"] \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[string first "<title>Tclcurl tiny web server</title>" $body] >= 0}] \
             [expr {[$handle getinfo contenttype] eq "text/html; charset=utf-8"}]
    }
} -result {0 200 1 1}

test http-1.13 {unknown GET paths fall back to files under the configured doc root} -constraints http_server -body {
    set fixtureRoot [::tclcurl::test::doc_root]
    set fixturePath [file join $fixtureRoot http-static-fixture.txt]
    file mkdir [file dirname $fixturePath]
    set fh [open $fixturePath wb]
    try {
        puts -nonewline $fh "static-docroot-fixture\n"
    } finally {
        close $fh
    }

    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url http-static-fixture.txt] \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {$body eq "static-docroot-fixture\n"}] \
             [expr {[$handle getinfo contenttype] eq "text/plain; charset=utf-8"}]
    }
} -cleanup {
    catch {file delete -force [file join [::tclcurl::test::doc_root] http-static-fixture.txt]}
} -result {0 200 1 1}

test http-1.14 {static file serving preserves binary response bytes} -constraints http_server -body {
    set sourcePath [file join [file dirname [file normalize [info script]]] tcl9.png]
    set fixturePath [file join [::tclcurl::test::doc_root] http-static-fixture.png]
    file copy -force $sourcePath $fixturePath
    set fh [open $sourcePath rb]
    try {
        set expectedSha [::sha2::sha256 -hex [read $fh]]
    } finally {
        close $fh
    }

    set body {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url http-static-fixture.png] \
                          -bodyvar body \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[::sha2::sha256 -hex $body] eq $expectedSha}] \
             [expr {[$handle getinfo contenttype] eq "image/png"}]
    }
} -cleanup {
    catch {file delete -force [file join [::tclcurl::test::doc_root] http-static-fixture.png]}
} -result {0 200 1 1}

test http-2.1.0 {-post with -postfields sends application/x-www-form-urlencoded data} -constraints http_server -body {
    set payload "firstName=Massimo&lastName=Manghi&city=Parma+Italy"
    ::tclcurl::test::transport_postfields ::tclcurl::test::server::base_url {} $payload
} -result {0 200 POST application/x-www-form-urlencoded 1 1}

test http-2.1.1 {-postfields with -postfieldsize sends application/x-www-form-urlencoded data} -constraints http_server -body {
    set payload "firstName=Massimo&lastName=Manghi&city=Parma+Italy"
    ::tclcurl::test::transport_postfieldsize ::tclcurl::test::server::base_url {} $payload
} -result {0 200 POST application/x-www-form-urlencoded 1 1}

test http-2.1.2 {-postfieldsize rejects malformed size values} -constraints http_server -body {
    set payload "firstName=Massimo&lastName=Manghi&city=Parma+Italy"
    ::tclcurl::test::transport_postfieldsize_invalid ::tclcurl::test::server::base_url {} $payload
} -result {1 {setting option -postfieldsize: bogus}}

test http-2.2 {-post can stream request data through -readproc} -constraints http_server -body {
    set payload "upload=from-readproc&mode=form-urlencoded"
    ::tclcurl::test::transport_post_readproc ::tclcurl::test::server::base_url {} $payload
} -cleanup {
    unset -nocomplain ::tclcurl::test::readproc
} -result {0 200 POST application/x-www-form-urlencoded 1 1}

test http-2.3 {-upload with -infile sends a binary HTTP PUT body} -constraints http_server -body {
    set fixture [file join [file dirname [file normalize [info script]]] tcl9.png]
    ::tclcurl::test::transport_upload_infile ::tclcurl::test::server::base_url {} $fixture
} -result {0 200 PUT 19698 1}

test http-2.4 {-upload with -readproc streams the same binary payload} -constraints http_server -body {
    set fixture [file join [file dirname [file normalize [info script]]] tcl9.png]
    set fh [open $fixture rb]
    try {
        set payload [read $fh]
    } finally {
        close $fh
    }
    ::tclcurl::test::transport_upload_readproc ::tclcurl::test::server::base_url {} $payload
} -cleanup {
    unset -nocomplain ::tclcurl::test::readproc
} -result {0 200 PUT 19698 1 1}

test http-3.1 {-range returns the requested byte subset from a large response} -constraints http_server -body {
    set start 16384
    set end   98303
    ::tclcurl::test::transport_range_single ::tclcurl::test::server::base_url {} $start $end
} -cleanup {
    unset -nocomplain ::tclcurl::test::writeBuffer
    unset -nocomplain ::tclcurl::test::writeProcCalls
    catch {unset headers}
} -result {0 206 1 1 1}

test http-3.2 {-range can request multiple byte subsets in a single transfer} -constraints http_server -body {
    set ranges {{16 47} {102 134} {1233 2643}}
    ::tclcurl::test::transport_range_multi ::tclcurl::test::server::base_url {} $ranges
} -cleanup {
    catch {unset headers}
} -result {0 206 1 1}

test http-4.1 {-timeoutms succeeds when the server responds before the deadline} -constraints http_server -body {
    ::tclcurl::test::transport_timeout_success ::tclcurl::test::server::base_url {} wait-200ms -timeoutms 900 "waited=200ms"
} -result {0 200 1 1}

test http-4.2 {-timeoutms fails when the response takes too long} -constraints http_server -body {
    ::tclcurl::test::transport_timeout_failure ::tclcurl::test::server::base_url {} wait-600ms?reply=none -timeoutms 100
} -result {1 1 1}

test http-4.3 {-lowspeedlimit and -lowspeedtime abort a transfer that stays below the minimum rate} -constraints http_server -body {
    set body {}
    set errbuf {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url slow-body-1] \
                          -lowspeedlimit 20 \
                          -lowspeedtime 5 \
                          -bodyvar body \
                          -errorbuffer errbuf \
                          -noprogress 1
        list [catch {$handle perform}] \
             [expr {[string length $errbuf] > 0}] \
             [expr {[string length $body] > 0}]
    }
} -result {1 1 1}

test http-4.4 {-lowspeedlimit and -lowspeedtime allow a transfer that stays above the minimum rate} -constraints http_server -body {
    set body {}
    set payload [string range [::tclcurl::test::range_fixture] 0 191]
    set errbuf {}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url slow-body-2] \
                          -lowspeedlimit 20 \
                          -lowspeedtime 5 \
                          -bodyvar body \
                          -errorbuffer errbuf \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {$body eq $payload}] \
             [expr {$errbuf eq {}}]
    }
} -result {0 200 1 1}

cleanupTests
