diff --git a/src/http/http_client.f90 b/src/http/http_client.f90 index 03dacea..ab815e8 100644 --- a/src/http/http_client.f90 +++ b/src/http/http_client.f90 @@ -11,7 +11,7 @@ module http_client use stdlib_optval, only: optval use http_request, only: request_type use http_response, only: response_type - use http_header, only : header_type + use http_header, only: append_header, header_has_key, header_type implicit none @@ -43,6 +43,7 @@ function new_request(url, method, header, json) result(response) type(request_type) :: request type(response_type) :: response type(client_type) :: client + integer :: i ! setting request url request%url = url @@ -50,20 +51,24 @@ function new_request(url, method, header, json) result(response) ! Set default HTTP method. request%method = optval(method, 1) - ! Set default request headers. - request%header = [header_type('user-agent', 'fortran-http/1.0.0')] - if(present(header)) then - request%header = [header, request%header] + ! Set request header + if (present(header)) then + request%header = header + ! Set default request headers. + if (.not. header_has_key(header, 'user-agent')) then + call append_header(request%header, 'user-agent', 'fortran-http/0.1.0') + end if + else + request%header = [header_type('user-agent', 'fortran-http/0.1.0')] end if - + if(present(json)) then request%json = json request%header = [request%header, header_type('Content-Type', 'application/json')] end if - client = client_type(request=request) - ! Populates the response + client = client_type(request=request) response = client%client_get_response() end function new_request @@ -254,7 +259,7 @@ function client_header_callback(ptr, size, nmemb, client_data) bind(c) h_value = buf(i+2 : ) h_value = h_value( : len(h_value)-2) if(len(h_value) > 0 .and. len(h_key) > 0) then - call response%append_header(h_key, h_value) + call append_header(response%header, h_key, h_value) ! response%header = [response%header, header_type(h_key, h_value)] end if end if diff --git a/src/http/http_header.f90 b/src/http/http_header.f90 index 7ae0e78..917402c 100644 --- a/src/http/http_header.f90 +++ b/src/http/http_header.f90 @@ -1,9 +1,90 @@ module http_header - use iso_c_binding + + !! This module provides a simple key value type to use for HTTP headers. + !! It also provides procedures to inquire about the presence of a key and + !! its value in a header array, as well as a procedure to append new + !! headers to an existing array of headers. + + use stdlib_ascii, only: to_lower + implicit none private + public :: header_type + public :: append_header + public :: get_header_value + public :: header_has_key + type :: header_type character(:), allocatable :: key, value end type header_type + +contains + + subroutine append_header(header, key, value) + !! Append a new header_type instance with key and value members to the + !! header array. + type(header_type), allocatable, intent(inout) :: header(:) + !! Header array to append to + character(*), intent(in) :: key + !! Key member of header_type to append + character(*), intent(in) :: value + !! Value member of header_type to append + type(header_type), allocatable :: temp(:) + integer :: n + + if (allocated(header)) then + n = size(header) + allocate(temp(n+1)) + temp(1:n) = header + temp(n+1) = header_type(key, value) + call move_alloc(temp, header) + else + allocate(header(1)) + header(1) = header_type(key, value) + end if + end subroutine append_header + + pure function get_header_value(header, key) result(val) + !! Return the value of a requested key in a header array. If the key is + !! not found, the function returns an empty string (unallocated). If + !! there are duplicates of the key in the header array, return the value + !! of the first occurence of the key. + type(header_type), intent(in) :: header(:) + !! Header to search for key + character(*), intent(in) :: key + !! Key to search in header + character(:), allocatable :: val + !! Value of the key to return + integer :: n + + do n = 1, size(header) + if (to_lower(key) == to_lower(header(n)%key)) then + val = header(n)%value + return + end if + end do + + end function get_header_value + + pure logical function header_has_key(header, key) + !! Return .true. if key is present in header, .false. otherwise. + !! HTTP headers are case insensitive, so values are converted to + !! lowercase before comparison. + type(header_type), intent(in) :: header(:) + !! Header to search for key + character(*), intent(in) :: key + !! Key to search in header + integer :: n + + header_has_key = .false. + do n = 1, size(header) + if (to_lower(key) == to_lower(header(n)%key)) then + header_has_key = .true. + return + end if + end do + + end function header_has_key + end module http_header \ No newline at end of file diff --git a/src/http/http_request.f90 b/src/http/http_request.f90 index 583289d..e5a1839 100644 --- a/src/http/http_request.f90 +++ b/src/http/http_request.f90 @@ -1,5 +1,7 @@ module http_request - use http_header, only : header_type + use http_header, only: header_type + use stdlib_string_type, only: string_type, to_lower, operator(==), char + implicit none private @@ -20,5 +22,4 @@ module http_request integer :: method type(header_type), allocatable :: header(:) end type request_type - end module http_request diff --git a/src/http/http_response.f90 b/src/http/http_response.f90 index f4ce418..5b5114d 100644 --- a/src/http/http_response.f90 +++ b/src/http/http_response.f90 @@ -1,6 +1,6 @@ module http_response use, intrinsic :: iso_fortran_env, only: int64 - use http_header, only : header_type + use http_header, only: header_type, get_header_value use stdlib_string_type, only: string_type, to_lower, operator(==), char implicit none @@ -16,49 +16,18 @@ module http_response logical :: ok = .true. type(header_type), allocatable :: header(:) contains - procedure :: append_header procedure :: header_value end type response_type contains - subroutine append_header(this, key, value) - class(response_type), intent(inout) :: this - character(*), intent(in) :: key, value - type(header_type), allocatable :: temp(:) - integer :: n - - if (allocated(this%header)) then - n = size(this%header) - allocate(temp(n+1)) - temp(1:n) = this%header - temp(n+1) = header_type(key, value) - call move_alloc(temp, this%header) - else - allocate(this%header(1)) - this%header(1) = header_type(key, value) - end if - - end subroutine append_header - ! The header_value function takes a key string as input and returns the corresponding - ! value as a string from a response_type object's header array, which contains key-value - ! pairs representing HTTP headers. If the key is not found, the function returns an empty - ! string. If there are duplicates of the key in the header array, the function returns - ! the value associated with the first occurrence of the key. + ! value as a string from a response_type object's header array. pure function header_value(this, key) result(val) class(response_type), intent(in) :: this character(*), intent(in) :: key character(:), allocatable :: val - type(string_type) :: string_to_match - integer :: i - string_to_match = to_lower(string_type(key)) - - do i=1, size(this%header) - if(to_lower(string_type(this%header(i)%key)) == string_to_match) then - val = this%header(i)%value - return - end if - end do + val = get_header_value(this%header, key) end function header_value + end module http_response diff --git a/test/test_header.f90 b/test/test_header.f90 new file mode 100644 index 0000000..d17b62e --- /dev/null +++ b/test/test_header.f90 @@ -0,0 +1,69 @@ +program test_header + + use iso_fortran_env, only: stderr => error_unit + use http_header, only: get_header_value, header_has_key, header_type + + implicit none + type(header_type), allocatable :: header(:) + logical :: ok = .true. + integer :: n + + header = [ & + header_type('One', '1'), & + header_type('Two', '2') & + ] + + if (.not. size(header) == 2) then + ok = .false. + write(stderr, '(a)') 'Failed: Header size is incorrect.' + end if + + if (.not. header(1)%value == '1') then + ok = .false. + write(stderr, '(a)') 'Failed: First header value is incorrect.' + end if + + if (.not. header(2)%value == '2') then + ok = .false. + write(stderr, '(a)') 'Failed: Second header value is incorrect.' + end if + + header = [header, header_type('Three', '3')] + + if (.not. size(header) == 3) then + ok = .false. + write(stderr, '(a)') 'Failed: Appending to header failed.' + end if + + if (.not. header(3)%value == '3') then + ok = .false. + write(stderr, '(a)') 'Failed: Appended header value is incorrect.' + end if + + do n = 1, size(header) + if (.not. get_header_value(header, header(n)%key) == header(n)%value) then + ok = .false. + write(stderr, '(a)') 'Failed: Appended header value is incorrect.' + end if + end do + + do n = 1, size(header) + if (.not. header_has_key(header, header(n)%key)) then + ok = .false. + write(stderr, '(a)') 'Failed: Incorrect output from header_has_key.' + end if + end do + + if (header_has_key(header, "Non-Existent")) then + ok = .false. + write(stderr, '(a)') 'Failed: Incorrect output from header_has_key for non-existent key.' + end if + + if (.not. ok) then + write(stderr, '(a)'), 'test_header: One or more tests failed.' + error stop 1 + else + print '(a)', 'test_header: All tests passed.' + end if + +end program test_header \ No newline at end of file