;EASY-PEASY-TCP - Provide a very easy to use TCP client interface.
;Written in 2019 by Prince Trippy programmer@verisimilitudes.net .

;To the extent possible under law, the author(s) have dedicated all copyright
;and related and neighboring rights to this software to the public domain worldwide.
;This software is distributed without any warranty.

;You should have received a copy of the CC0 Public Domain Dedication along with this software.
;If not, see <http://creativecommons.org/publicdomain/zero/1.0/>.

(cl:defpackage #:easy-peasy-tcp
  (:documentation "This package exports a function, macro, and conditions for an easy TCP client.")
  (:use #:common-lisp)
  (:export #:open-tcp-connection #:with-tcp-connection #:tcp-error #:tcp-connect-error))

(cl:in-package #:easy-peasy-tcp)

(defun ip-address-p (standard-object)
  "This predicate returns NIL if its argument is not considered an IP address and T otherwise."
  (typep standard-object
         '(or (vector (unsigned-byte 8) 4) ;(vector (unsigned-byte 8) 16)
           (cons (unsigned-byte 8)
            (cons (unsigned-byte 8)
             (cons (unsigned-byte 8)
                   (cons (unsigned-byte 8) (eql nil))))))))

(define-condition tcp-error (error)
  ((address :accessor tcp-error-address :initarg :tcp-error-address
            :type (satisfies ip-address-p)
            :initform (error "A TCP-ERROR must have an associated IP address.
A special IP address should be used in cases where this may not otherwise be sensible."))
   (port :accessor tcp-error-port :initarg :tcp-error-port :type (unsigned-byte 16)
         :initform (error "A TCP-ERROR must have an associated TCP port.
A special TCP port should be used in cases where this may not otherwise be sensible.")))
  (:documentation "All TCP client errors are children of this condition.
This condition has slots for IP address and TCP port, as this is expected to be useful.")
  (:report (lambda (condition stream &aux (address (tcp-error-address condition)))
             (write-string "A TCP-ERROR for " stream)
             (case (length address) ;Optimize IPv6 display later.
               (4 (format stream "~{~d~^.~}" (coerce address 'list)))
               (16 (format stream "[~{~2x~2x~^:~}]" (coerce address 'list))))
             (format stream ":~d has been signalled." (tcp-error-port condition)))))

(define-condition tcp-connect-error (tcp-error) ()
  (:documentation "This represents a failure to reach the ESTABLISHED phase of a TCP connection.")
  ;I'll clean this up later.
  (:report (lambda (condition stream &aux (address (tcp-error-address condition)))
             (write-string "A TCP-CONNECT-ERROR for " stream)
             (case (length address) ;Optimize IPv6 display later.
               (4 (format stream "~{~d~^.~}" (coerce address 'list)))
               (16 (format stream "[~{~2x~2x~^:~}]" (coerce address 'list))))
             (format stream ":~d has been signalled." (tcp-error-port condition)))))

(defun open-tcp-connection (address port &key timeout (direction :io) (element-type 'base-char)
                                           (external-format :default) &allow-other-keys)
  "Create a TCP connection to the specified IP address and TCP port and return a stream.
If an ESTABLISHED connection can't be made, TCP-CONNECT-ERROR is signalled.
In the case of other errors, TCP-ERROR is signalled.
The TIMEOUT is NIL or a positive integer, which indicates seconds to wait; if NIL, wait forever.
The DIRECTION, ELEMENT-TYPE, and EXTERNAL-FORMAT arguments are as for COMMON-LISP:OPEN."
  (check-type address (satisfies ip-address-p))
  (check-type port (unsigned-byte 16))
  (check-type direction (member :input :output :io :probe))
  (check-type timeout (or null unsigned-byte))
  ;This :PROBE option seems rather useless and difficult to give proper semantics to.
  ;Perhaps I should discard the idea and only allow the remaining three.
  #+sbcl (let ((open (ignore-errors (make-instance 'sb-bsd-sockets:inet-socket
                                                   :type :stream :protocol :tcp))))
           (or open (error 'tcp-error :tcp-error-address address :tcp-error-port port))
           (handler-case (sb-bsd-sockets:socket-connect open address port)
             (error () (error 'tcp-connect-error :tcp-error-address address :tcp-error-port port)))
           (let ((stream (sb-bsd-sockets:socket-make-stream
                          open :timeout timeout :element-type element-type
                          :buffering :full :external-format external-format
                          :input (member direction '(:input :probe :io))
                          :output (member direction '(:output :io)))))
             ;I can't do this because CLOSE isn't to be used on an already closed stream.
             ;(if (eq direction :probe) (close stream))
             stream))
  ;This SOCKET:SOCKET-CONNECT seems to always create a bidirectional stream, so I ignore DIRECTION.
  ;Must I convert an IP address to its textual representation for CLISP?  I'm still researching.
  #+clisp (handler-case (socket:socket-connect port (format nil "~{~d~^.~}" (coerce address 'list))
                          :element-type element-type :external-format external-format
                          :timeout timeout)
            (error () (error 'tcp-connect-error :tcp-error-address address :tcp-error-port port))))

(defmacro with-tcp-connection ((stream address port &rest open) &body progn)
  "Execute the given body with a TCP connection bound to STREAM, as if by OPEN-TCP-CONNECTION.
The STREAM is CLOSEd upon exit of the body for any reason."
  `(with-open-stream (,stream (open-tcp-connection ,address ,port ,@open))
     ,@progn))
.