!> Fortran side of the suite's local HTTP server.
!>
!> The server itself is `test/http_server.c`, compiled and linked with the
!> tests. Everything here is a thin `iso_c_binding` wrapper that takes and
!> returns ordinary Fortran strings.
module test_server
    use, intrinsic :: iso_c_binding
    use cepis_strings, only: to_c_chars, from_integer
    use, intrinsic :: iso_fortran_env, only: int64
    implicit none
    private

    public :: server_start
    public :: server_stop
    public :: server_reset
    public :: server_base_url
    public :: server_respond
    public :: server_respond_more
    public :: server_respond_default
    public :: server_count
    public :: server_total
    public :: server_path

    interface
        function ts_start() bind(c, name='ts_start') result(handle)
            import :: c_ptr
            type(c_ptr) :: handle
        end function ts_start

        subroutine ts_stop(handle) bind(c, name='ts_stop')
            import :: c_ptr
            type(c_ptr), value :: handle
        end subroutine ts_stop

        subroutine ts_reset(handle) bind(c, name='ts_reset')
            import :: c_ptr
            type(c_ptr), value :: handle
        end subroutine ts_reset

        function ts_port(handle) bind(c, name='ts_port') result(port)
            import :: c_ptr, c_int
            type(c_ptr), value :: handle
            integer(c_int) :: port
        end function ts_port

        subroutine ts_respond(handle, path, status, body, headers) &
            bind(c, name='ts_respond')
            import :: c_ptr, c_char, c_long
            type(c_ptr), value :: handle
            character(kind=c_char), intent(in) :: path(*)
            integer(c_long), value :: status
            character(kind=c_char), intent(in) :: body(*)
            character(kind=c_char), intent(in) :: headers(*)
        end subroutine ts_respond

        subroutine ts_respond_more(handle, path, status, body, headers) &
            bind(c, name='ts_respond_more')
            import :: c_ptr, c_char, c_long
            type(c_ptr), value :: handle
            character(kind=c_char), intent(in) :: path(*)
            integer(c_long), value :: status
            character(kind=c_char), intent(in) :: body(*)
            character(kind=c_char), intent(in) :: headers(*)
        end subroutine ts_respond_more

        subroutine ts_respond_default(handle, status, body, headers) &
            bind(c, name='ts_respond_default')
            import :: c_ptr, c_char, c_long
            type(c_ptr), value :: handle
            integer(c_long), value :: status
            character(kind=c_char), intent(in) :: body(*)
            character(kind=c_char), intent(in) :: headers(*)
        end subroutine ts_respond_default

        function ts_count(handle, prefix) bind(c, name='ts_count') result(total)
            import :: c_ptr, c_char, c_size_t
            type(c_ptr), value :: handle
            character(kind=c_char), intent(in) :: prefix(*)
            integer(c_size_t) :: total
        end function ts_count

        function ts_total(handle) bind(c, name='ts_total') result(total)
            import :: c_ptr, c_size_t
            type(c_ptr), value :: handle
            integer(c_size_t) :: total
        end function ts_total

        function ts_path_length(handle, index) bind(c, name='ts_path_length') result(length)
            import :: c_ptr, c_size_t
            type(c_ptr), value :: handle
            integer(c_size_t), value :: index
            integer(c_size_t) :: length
        end function ts_path_length

        subroutine ts_path_copy(handle, index, out, out_size) &
            bind(c, name='ts_path_copy')
            import :: c_ptr, c_char, c_size_t
            type(c_ptr), value :: handle
            integer(c_size_t), value :: index
            character(kind=c_char), intent(inout) :: out(*)
            integer(c_size_t), value :: out_size
        end subroutine ts_path_copy
    end interface

contains

    !> Start a server on a random loopback port. `c_null_ptr` on failure.
    function server_start() result(handle)
        type(c_ptr) :: handle

        handle = ts_start()
    end function server_start

    subroutine server_stop(handle)
        type(c_ptr), intent(in) :: handle

        call ts_stop(handle)
    end subroutine server_stop

    !> Forget every route and every recorded request.
    subroutine server_reset(handle)
        type(c_ptr), intent(in) :: handle

        call ts_reset(handle)
    end subroutine server_reset

    !> `http://127.0.0.1:PORT`.
    function server_base_url(handle) result(url)
        type(c_ptr), intent(in) :: handle
        character(len=:), allocatable :: url

        url = 'http://127.0.0.1:'//from_integer(int(ts_port(handle), int64))
    end function server_base_url

    !> Register the only reply for `path`, replacing any previous route.
    subroutine server_respond(handle, path, status, body, headers)
        type(c_ptr), intent(in) :: handle
        character(len=*), intent(in) :: path
        integer, intent(in) :: status
        character(len=*), intent(in) :: body
        character(len=*), intent(in) :: headers

        call ts_respond(handle, to_c_chars(path), int(status, c_long), &
                        to_c_chars(body), to_c_chars(headers))
    end subroutine server_respond

    !> Append another reply to `path`. Each request consumes the next entry;
    !> the last one repeats once the queue runs out. This is how retrying is
    !> tested.
    subroutine server_respond_more(handle, path, status, body, headers)
        type(c_ptr), intent(in) :: handle
        character(len=*), intent(in) :: path
        integer, intent(in) :: status
        character(len=*), intent(in) :: body
        character(len=*), intent(in) :: headers

        call ts_respond_more(handle, to_c_chars(path), int(status, c_long), &
                             to_c_chars(body), to_c_chars(headers))
    end subroutine server_respond_more

    !> The reply for any path with no explicit route. Used where the request
    !> path is thousands of characters long and matching it buys nothing.
    subroutine server_respond_default(handle, status, body, headers)
        type(c_ptr), intent(in) :: handle
        integer, intent(in) :: status
        character(len=*), intent(in) :: body
        character(len=*), intent(in) :: headers

        call ts_respond_default(handle, int(status, c_long), to_c_chars(body), &
                                to_c_chars(headers))
    end subroutine server_respond_default

    !> How many requests so far had a path starting with `prefix`.
    function server_count(handle, prefix) result(total)
        type(c_ptr), intent(in) :: handle
        character(len=*), intent(in) :: prefix
        integer :: total

        total = int(ts_count(handle, to_c_chars(prefix)))
    end function server_count

    !> How many requests the server has served in total.
    function server_total(handle) result(total)
        type(c_ptr), intent(in) :: handle
        integer :: total

        total = int(ts_total(handle))
    end function server_total

    !> The path of request `index`, counting from one. Empty when there is no
    !> such request.
    function server_path(handle, index) result(path)
        type(c_ptr), intent(in) :: handle
        integer, intent(in) :: index
        character(len=:), allocatable :: path
        character(kind=c_char), allocatable :: buffer(:)
        integer :: length, i

        length = int(ts_path_length(handle, int(index - 1, c_size_t)))
        if (length <= 0) then
            path = ''
            return
        end if

        allocate (buffer(length + 1))
        call ts_path_copy(handle, int(index - 1, c_size_t), buffer, &
                          int(length + 1, c_size_t))
        allocate (character(len=length) :: path)
        do i = 1, length
            path(i:i) = buffer(i)
        end do
    end function server_path

end module test_server