!> @file cortex_link.f90
!> @brief Fortran wrapper around the socket shim (cortex_link.c)
!!        plus URI parsing and length-prefix frame I/O.
!!
!! Phase G: §11.4 of the master spec. The C shim provides a BSD-sockets
!! (POSIX) and a Winsock2 (Windows) backend, so attached mode runs on
!! Linux, macOS, and Windows alike.

module cortex_link
  use, intrinsic :: iso_c_binding, only: c_int, c_size_t, c_char, c_null_char, c_ptr, c_loc
  use, intrinsic :: iso_fortran_env, only: int8, int64
  use mpi_runtime, only: parallel_fatal
  implicit none
  private

  public :: parse_uri
  public :: cortex_open
  public :: cortex_send_frame
  public :: cortex_recv_frame
  public :: cortex_close_fd
  public :: be_u32_to_i64
  public :: is_frame_len_valid
  public :: is_send_frame_valid
  public :: MAX_FRAME_BYTES
  public :: MAX_SEND_FRAME_BYTES

  !> Upper bound on a single length-prefixed INBOUND frame field (header
  !! or payload), enforced before allocation in =cortex_recv_frame=. The
  !! Cortex peer is on the loopback TCP port, but it is still untrusted
  !! input: without a cap a buggy/compromised peer can request ~4 GiB
  !! per field and exhaust memory. 64 MiB is generously above any
  !! legitimate request frame (headers are small JSON; bulk binary data
  !! rides the COPY_SOLUTION *reply*, which the worker sizes itself, not
  !! an inbound request). This cap deliberately does NOT apply to the
  !! send path — see =MAX_SEND_FRAME_BYTES=.
  integer(int64), parameter :: MAX_FRAME_BYTES = 64_int64 * 1024_int64 * 1024_int64

  !> Upper bound on an OUTBOUND frame field: the u32 wire length prefix
  !! (spec §12.2) can express at most 2^32-1 bytes. Legitimate
  !! COPY_SOLUTION replies routinely exceed the 64 MiB inbound cap (any
  !! 2D grid past ~1182² with 6 primitives), so the send side must not
  !! reuse =MAX_FRAME_BYTES= (audit 2026-07-06 N1). Handlers that build
  !! bulk replies pre-check against this limit and return a reply-level
  !! error instead of ever tripping the fatal send-side guard.
  integer(int64), parameter :: MAX_SEND_FRAME_BYTES = 4294967295_int64

  interface
    function c_cortex_connect_tcp(host, port) bind(C, name="cortex_connect_tcp") result(fd)
      import :: c_int, c_char
      character(kind=c_char), intent(in) :: host(*)
      integer(c_int), value :: port
      integer(c_int) :: fd
    end function c_cortex_connect_tcp

    function c_cortex_send_all(fd, buf, n) bind(C, name="cortex_send_all") result(r)
      import :: c_int, c_size_t, c_ptr
      integer(c_int), value :: fd
      type(c_ptr), value :: buf
      integer(c_size_t), value :: n
      integer(c_size_t) :: r
    end function c_cortex_send_all

    function c_cortex_recv_all(fd, buf, n) bind(C, name="cortex_recv_all") result(r)
      import :: c_int, c_size_t, c_ptr
      integer(c_int), value :: fd
      type(c_ptr), value :: buf
      integer(c_size_t), value :: n
      integer(c_size_t) :: r
    end function c_cortex_recv_all

    function c_cortex_close(fd) bind(C, name="cortex_close") result(r)
      import :: c_int
      integer(c_int), value :: fd
      integer(c_int) :: r
    end function c_cortex_close
  end interface

contains

  !> Parse a "tcp://host:port" URI into host string and integer port.
  !! Errors fatally on a malformed URI — bug in the caller.
  subroutine parse_uri(uri, host, port)
    character(len=*), intent(in) :: uri
    character(len=*), intent(out) :: host
    integer, intent(out) :: port

    integer :: colon_pos, last_colon, ios

    ! Guard the fixed-length scheme compare: a CLI value shorter than
    ! "tcp://x" (7 chars) cannot be a valid URI, and uri(1:6) on a
    ! shorter string is an out-of-bounds substring.
    if (len_trim(uri) < 7) then
      error stop 'cortex_link: URI too short (expected tcp://host:port)'
    end if
    if (uri(1:6) /= "tcp://") then
      error stop 'cortex_link: URI must start with "tcp://"'
    end if
    ! Find the LAST colon (host could be an IPv4 literal which doesn't
    ! contain colons, but be robust to future IPv6).
    last_colon = 0
    do colon_pos = 7, len_trim(uri)
      if (uri(colon_pos:colon_pos) == ":") last_colon = colon_pos
    end do
    if (last_colon == 0) then
      error stop 'cortex_link: URI missing port (expected tcp://host:port)'
    end if

    ! Reject a host longer than the caller's buffer rather than
    ! silently truncating it (a truncated host would connect to the
    ! wrong/no endpoint).
    if (last_colon - 1 - 7 + 1 > len(host)) then
      error stop 'cortex_link: URI host exceeds host buffer length'
    end if
    host = uri(7:last_colon - 1)
    ! Validate the port parse instead of crashing with an unformatted
    ! runtime error on a non-numeric/empty port.
    read (uri(last_colon + 1:), *, iostat=ios) port
    if (ios /= 0) then
      error stop 'cortex_link: URI port is not a valid integer'
    end if
  end subroutine parse_uri

  !> Open a TCP loopback connection to the Cortex server.
  subroutine cortex_open(uri, fd)
    character(len=*), intent(in) :: uri
    integer, intent(out) :: fd

    character(len=128) :: host
    character(kind=c_char, len=130) :: host_c
    integer :: port

    call parse_uri(uri, host, port)
    host_c = trim(host)//c_null_char
    fd = int(c_cortex_connect_tcp(host_c, int(port, c_int)))
    if (fd < 0) then
      error stop 'cortex_link: cortex_connect_tcp failed (check Cortex is listening)'
    end if
  end subroutine cortex_open

  !> Send a length-prefixed frame: 4-byte BE header length, header
  !! bytes, 4-byte BE payload length, payload bytes. Both length
  !! prefixes are always present (payload length is zero when payload
  !! is empty; spec §12.2).
  subroutine cortex_send_frame(fd, header, payload)
    integer, intent(in) :: fd
    integer(int8), intent(in), target :: header(:)
    integer(int8), intent(in), target :: payload(:)

    integer(int8), target :: header_len_be(4), payload_len_be(4)

    ! The only send-side wall is the u32 length prefix itself: a field
    ! longer than 2^32-1 bytes cannot be framed at all. Callers building
    ! bulk replies (COPY_SOLUTION) pre-check their sizes and reply with a
    ! protocol-level error instead, so tripping this guard is a caller
    ! bug, not a data-dependent condition. Do NOT gate sends on the 64 MiB
    ! MAX_FRAME_BYTES request cap — replies legitimately exceed it
    ! (audit 2026-07-06 N1). Once validated, the int64 value is in
    ! [0, 2^32-1] and pack_be_u32 packs it directly from int64 (an int32
    ! round-trip would be an out-of-range conversion past 2^31-1).
    if (.not. is_send_frame_valid(size(header, kind=int64)) .or. &
        .not. is_send_frame_valid(size(payload, kind=int64))) &
      call parallel_fatal('cortex_link: outgoing frame exceeds the u32 wire limit (caller must pre-check)')

    call pack_be_u32(size(header, kind=int64), header_len_be)
    call pack_be_u32(size(payload, kind=int64), payload_len_be)

    call send_bytes(fd, header_len_be)
    if (size(header) > 0) call send_bytes(fd, header)
    call send_bytes(fd, payload_len_be)
    if (size(payload) > 0) call send_bytes(fd, payload)
  end subroutine cortex_send_frame

  !> Receive a length-prefixed frame. Both header and payload are
  !! returned as allocatable byte arrays (caller owns).
  subroutine cortex_recv_frame(fd, header, payload)
    integer, intent(in) :: fd
    integer(int8), allocatable, intent(out) :: header(:)
    integer(int8), allocatable, intent(out) :: payload(:)

    integer(int8) :: len_be(4)
    integer(int64) :: header_len, payload_len
    integer :: alloc_stat

    call recv_bytes(fd, len_be)
    header_len = be_u32_to_i64(len_be)
    if (.not. is_frame_len_valid(header_len)) &
      error stop 'cortex_link: header frame length out of range (negative or > MAX_FRAME_BYTES)'
    allocate (header(int(header_len)), stat=alloc_stat)
    if (alloc_stat /= 0) error stop 'cortex_link: cortex_recv_frame: header allocation failed'
    if (header_len > 0) call recv_bytes(fd, header)

    call recv_bytes(fd, len_be)
    payload_len = be_u32_to_i64(len_be)
    if (.not. is_frame_len_valid(payload_len)) &
      error stop 'cortex_link: payload frame length out of range (negative or > MAX_FRAME_BYTES)'
    allocate (payload(int(payload_len)), stat=alloc_stat)
    if (alloc_stat /= 0) error stop 'cortex_link: cortex_recv_frame: payload allocation failed'
    if (payload_len > 0) call recv_bytes(fd, payload)
  end subroutine cortex_recv_frame

  subroutine cortex_close_fd(fd)
    integer, intent(in) :: fd
    integer(c_int) :: rc
    rc = c_cortex_close(int(fd, c_int))
  end subroutine cortex_close_fd

  ! ---- internals ----

  subroutine send_bytes(fd, buf)
    integer, intent(in) :: fd
    integer(int8), intent(in), target :: buf(:)
    integer(c_size_t) :: sent

    ! Use size(..., kind=int64) so the element count is correct past 2^31-1.
    ! After the MAX_FRAME_BYTES cap in cortex_send_frame the cast to c_size_t
    ! is safe on any LP64 / LLP64 platform (c_size_t >= 64 bits in practice).
    sent = c_cortex_send_all(int(fd, c_int), c_loc(buf), &
                             int(size(buf, kind=int64), c_size_t))
    if (sent /= int(size(buf, kind=int64), c_size_t)) then
      error stop 'cortex_link: send_bytes: short send (peer closed?)'
    end if
  end subroutine send_bytes

  subroutine recv_bytes(fd, buf)
    integer, intent(in) :: fd
    integer(int8), intent(inout), target :: buf(:)
    integer(c_size_t) :: got

    got = c_cortex_recv_all(int(fd, c_int), c_loc(buf), int(size(buf), c_size_t))
    if (got /= size(buf)) then
      error stop 'cortex_link: recv_bytes: short recv (peer closed?)'
    end if
  end subroutine recv_bytes

  !> Pack an UNSIGNED 32-bit length prefix from an int64 value in
  !! [0, 4294967295]. Takes int64 so a length in (2^31-1, 2^32-1] —
  !! legitimate for large COPY_SOLUTION replies — never round-trips
  !! through int32 (an out-of-range conversion, processor-dependent).
  !! Inverse of =be_u32_to_i64=.
  pure subroutine pack_be_u32(n, out)
    integer(int64), intent(in) :: n
    integer(int8), intent(out) :: out(4)
    out(1) = int(iand(ishft(n, -24), int(z'FF', int64)), int8)
    out(2) = int(iand(ishft(n, -16), int(z'FF', int64)), int8)
    out(3) = int(iand(ishft(n, -8), int(z'FF', int64)), int8)
    out(4) = int(iand(n, int(z'FF', int64)), int8)
  end subroutine pack_be_u32

  !> Decode a 4-byte big-endian length prefix as an UNSIGNED 32-bit
  !! value widened to int64. Each byte is masked into int64 before the
  !! shift/OR, so a wire value with the high bit set (0x80000000..
  !! 0xFFFFFFFF) decodes as a large positive int64 — not a negative
  !! int32 (the desync bug). Range: [0, 4294967295].
  pure function be_u32_to_i64(buf) result(n)
    integer(int8), intent(in) :: buf(4)
    integer(int64) :: n
    n = ior(ishft(iand(int(buf(1), int64), int(z'FF', int64)), 24), &
            ishft(iand(int(buf(2), int64), int(z'FF', int64)), 16))
    n = ior(n, ior(ishft(iand(int(buf(3), int64), int(z'FF', int64)), 8), &
                   iand(int(buf(4), int64), int(z'FF', int64))))
  end function be_u32_to_i64

  !> A decoded frame length is acceptable iff it is non-negative and
  !! within the =MAX_FRAME_BYTES= cap. (Non-negativity is structurally
  !! guaranteed by =be_u32_to_i64=, but kept explicit so the predicate
  !! is correct for any int64 caller.)
  pure function is_frame_len_valid(n) result(ok)
    integer(int64), intent(in) :: n
    logical :: ok
    ok = (n >= 0_int64) .and. (n <= MAX_FRAME_BYTES)
  end function is_frame_len_valid

  !> Check that a send-side frame field (header or payload) can be
  !! represented by the u32 wire length prefix. Deliberately NOT
  !! symmetric with =is_frame_len_valid=: the 64 MiB inbound cap guards
  !! against an untrusted peer's *request* sizes, while outbound frames
  !! are sized by the worker itself and legitimately carry bulk
  !! COPY_SOLUTION replies far beyond 64 MiB (audit 2026-07-06 N1).
  pure function is_send_frame_valid(n) result(ok)
    integer(int64), intent(in) :: n
    logical :: ok
    ok = (n >= 0_int64) .and. (n <= MAX_SEND_FRAME_BYTES)
  end function is_send_frame_valid

end module cortex_link