feat(TCP): enhanced TCP module

lib/Data/Term.hm

@@ -14,8 +14,14 @@
 -----------------------------------------------------------------------------
 module Data.Term where
 
+import Unsafe.Coerce (unsafeCoerce)
+
 -- | A piece of data of any datatype is called a Term in Erlang.
+-- we use Term as top type of Hamler
 foreign import data Term :: Type
 
-class ToTerm a where
-  toTerm :: a -> Term
+toTerm :: forall a. a -> Term
+toTerm = unsafeCoerce
+
+fromTerm :: forall a. Term -> a
+fromTerm = unsafeCoerce

lib/Data/Timeout.hm

@@ -21,10 +21,16 @@ import Data.Show (class Show, show)
 import Data.Read (class Read, read)
 import Data.Function (error)
 import Data.List ((++))
+import Foreign (class IsFFI)
+import Data.Term (Term, toTerm)
 
 -- | The Erlang Timeout.
 data Timeout = Infinity | Timeout Integer
 
+instance IsFFI Timeout Term where
+  toFFI Infinity = toTerm :infinity
+  toFFI (Timeout num) = toTerm num
+
 instance Show Timeout where
   show Infinity = "Infinity"
   show (Timeout x) = "Timeout " ++ show x

lib/Foreign.hm

@@ -41,3 +41,6 @@ foreign import ffiIO4 :: forall a b c d e. Mod -> Fun -> a -> b -> c -> d -> IO
 foreign import ffiIO5 :: forall a b c d e f. Mod -> Fun -> a -> b -> c -> d -> e IO f
 foreign import ffiIO6 :: forall a b c d e f g. Mod -> Fun -> a -> b -> c -> d -> e -> f -> IO g
 foreign import ffiIO7 :: forall a b c d e f g h. Mod -> Fun -> a -> b -> c -> d -> e -> f -> g -> IO h
+
+class IsFFI a b | a -> b where
+  toFFI :: a -> b

lib/Foreign.hrl

@@ -21,6 +21,9 @@
 
 -define(EvalIO(IO), 'Control.Monad':pureImpl(?RunIO(IO))).
 
+-define(TOFFI(M, I, F), ('Foreign':toFFI(M:I()))(F)).
+-define(TOFFIs(M, I, L), begin FFI = 'Foreign':toFFI(M:I()), [FFI(F) || F <- L] end).
+
 -include("./Foreign/Maybe.hrl").
 
 -endif.

lib/Network/Inet.hm

@@ -17,7 +17,8 @@ module Network.Inet where
 import Control.Monad (IO)
 import Data.Int (UInt8, UInt16)
 import Data.Unit (Unit)
-import Foreign (ffiIO1)
+import Foreign (ffiIO1, class IsFFI)
+import Data.Term(toTerm, Term)
 
 -- | Host name
 type Hostname = String
@@ -30,6 +31,10 @@ data IpAddress
   = Ip4Address (UInt8, UInt8, UInt8, UInt8)
   | Ip6Address (UInt16, UInt16, UInt16, UInt16, UInt16, UInt16, UInt16, UInt16)
 
+instance IsFFI IpAddress Term where
+  toFFI (Ip4Address addr) = toTerm addr
+  toFFI (Ip6Address addr) = toTerm addr
+
 data StatOption
   = RecvCnt
   | RecvMax
@@ -42,6 +47,24 @@ data StatOption
   | SendOct
   | SendPend
 
+data Family
+ = Inet
+ | Inet6
+ | Local
+
+instance IsFFI Family Atom where
+  toFFI Inet = :inet
+  toFFI Inet6 = :inet6
+  toFFI Local = :local
+
+data Backend
+  = InetBackend
+  | SocketBackend
+
+instance IsFFI Backend Atom where
+  toFFI InetBackend = :inet
+  toFFI SocketBackend = :socket
+
 -- | The inet Socket.
 foreign import data Socket :: Type
 

lib/Network/TCP.erl

@@ -21,38 +21,44 @@
         , connect/3
         , connectTimeout/4
         , listen/2
-        , recv/2
+        , recv/3
         , recvTimeout/3
-        , send/2
+        , send/3
         , shutdown/2
         ]).
 
+-define(HMod, 'Network.TCP').
+
 accept(LSocket) ->
-  ?IO(return(gen_tcp:accept(LSocket))).
+    ?IO(return(gen_tcp:accept(LSocket))).
 
 acceptTimeout(LSocket, Timeout) ->
-  ?IO(return(gen_tcp:accept(LSocket, Timeout))).
+    ?IO(return(gen_tcp:accept(LSocket, Timeout))).
 
 connect(Address, Port, Options) ->
-  ?IO(return(gen_tcp:connect(unwrap(Address), Port, Options))).
+    Opts = ?TOFFIs(?HMod, isffiTcpOptionTerm, Options),
+    ?IO(return(gen_tcp:connect(unwrap(Address), Port, Opts))).
 
 connectTimeout(Address, Port, Options, Timeout) ->
-  ?IO(return(gen_tcp:connect(unwrap(Address), Port, Options, Timeout))).
+    Opts = ?TOFFIs(?HMod, isffiTcpOptionTerm, Options),
+    ?IO(return(gen_tcp:connect(unwrap(Address), Port, Opts, Timeout))).
 
 listen(Port, Options) ->
-  ?IO(return(gen_tcp:listen(Port, Options))).
+    Opts = ?TOFFIs(?HMod, isffiListenOptionTerm, Options),
+    ?IO(return(gen_tcp:listen(Port, Opts))).
 
-recv(Socket, Length) ->
-  ?IO(return(gen_tcp:recv(Socket, Length))).
+recv(_, Socket, Length) ->
+    ?IO(return(gen_tcp:recv(Socket, Length))).
 
 recvTimeout(Socket, Length, Timeout) ->
-  ?IO(return(gen_tcp:recv(Socket, Length, Timeout))).
+    ?IO(return(gen_tcp:recv(Socket, Length, Timeout))).
 
-send(Socket, Packet) ->
-  ?IO(return(gen_tcp:send(Socket, Packet))).
+send(_, Socket, Packet) ->
+    ?IO(return(gen_tcp:send(Socket, Packet))).
 
-shutdown(Socket, How) ->
-  ?IO(return(gen_tcp:shutdown(Socket, How))).
+shutdown(Socket, Method) ->
+    How = ?TOFFI(?HMod, isffiShutdownMethodAtom, Method),
+    ?IO(return(gen_tcp:shutdown(Socket, How))).
 
 unwrap({'Ip4Address', Addr}) -> Addr;
 unwrap({'Ip6Address', Addr}) -> Addr.

lib/Network/TCP.hm

@@ -14,17 +14,178 @@
 -----------------------------------------------------------------------------
 module Network.TCP where
 
-import Control.Monad (IO)
-import Network.Inet (IpAddress, PortNumber, Socket)
-import Data.Unit (Unit)
-import Foreign (ffiIO1)
+import Prelude
+import Network.Inet (IpAddress, PortNumber, Socket, Family, Backend)
+import Foreign (ffiIO1, class IsFFI, toFFI)
+import Data.Int (Int16, UInt16)
+import System.File (FileName)
+import Data.Timeout (Timeout)
+import Data.Term (Term, toTerm)
 
 type Length = Integer
-type Timeout = Integer
 
--- TODO: Fixme later
-foreign import data Options :: Type
-foreign import data Packet :: Type
+data Option
+  = Active Bool
+  | ActiveN Int16
+  | Buffer Integer
+  | DelaySend Bool
+  | Deliver Term
+  | DontRoute Bool
+  | ExitOnClose Bool
+  | Header Integer
+  | HighMsgqWatermark Integer
+  | HighWatermark Integer
+  | Keepalive Bool
+  | Linger Bool Integer
+  | LowMsgqWatermark Integer
+  | LowWatermark Integer
+  | Mode Mode
+  | NoDelay Bool
+  | Packet PacketHeader
+  | PacketSize Integer
+  | Priority Integer
+  | Raw Integer Integer Binary
+  | RecBuf Integer
+  | Reuseaddr Bool
+  | SendTimeout Timeout
+  | SendTimeoutClose Bool
+  | ShowEConnReset Bool
+  | SndBuf Integer
+  | TOS Integer
+  | TClass Integer
+  | TTL Integer
+  | RecvTOS Bool
+  | RecvTClass Bool
+  | RecvTTL Bool
+  | Ipv6Only Bool
+  | Backend Backend
+
+instance IsFFI Option Term where
+  toFFI (Active val) = toTerm (:active, val)
+  toFFI (ActiveN num) = toTerm (:active, num)
+  toFFI (Buffer num) = toTerm (:buffer, num)
+  toFFI (DelaySend val) = toTerm (:delay_send, val)
+  toFFI (Deliver term) = toTerm (:deliver, term)
+  toFFI (DontRoute val) = toTerm (:dontroute, val)
+  toFFI (ExitOnClose val) = toTerm (:exit_on_close, val)
+  toFFI (Header val) = toTerm val
+  toFFI (HighMsgqWatermark num) = toTerm (:high_msgq_watermark, num)
+  toFFI (HighWatermark num) = toTerm (:hight_watermark, num)
+  toFFI (Keepalive val) = toTerm (:keepalive, val)
+  toFFI (Linger val num) = toTerm (:linger, (val, num))
+  toFFI (LowMsgqWatermark num) = toTerm (:low_msgq_watermark, num)
+  toFFI (LowWatermark num) = toTerm (:low_watermark, num)
+  toFFI (Mode m) = toTerm $ toFFI m
+  toFFI (NoDelay val) = toTerm (:nodelay, val)
+  toFFI (Packet p) = toTerm (:packet, toFFI p)
+  toFFI (PacketSize num) = toTerm (:packet_size, num)
+  toFFI (Priority num) = toTerm (:priority, num)
+  toFFI (Raw proto option val) = toTerm (:raw, proto, option, val)
+  toFFI (RecBuf num) = toTerm (:recbuf, num)
+  toFFI (Reuseaddr val) = toTerm (:reuseaddr, val)
+  toFFI (SendTimeout val) = toTerm (:send_timeout, toFFI val)
+  toFFI (SendTimeoutClose val) = toTerm (:send_timeout_close, val)
+  toFFI (ShowEConnReset val) = toTerm (:show_econnreset, val)
+  toFFI (SndBuf num) = toTerm (:sndbuf, num)
+  toFFI (TOS num) = toTerm (:tos, num)
+  toFFI (TClass num) = toTerm (:tclas, num)
+  toFFI (TTL num) = toTerm (:ttl, num)
+  toFFI (RecvTOS val) = toTerm (:recvtos, val)
+  toFFI (RecvTClass val) = toTerm (:recvtclass, val)
+  toFFI (RecvTTL val) = toTerm (:recvttl, val)
+  toFFI (Ipv6Only val) = toTerm (:ipv6_v6only, val)
+  toFFI (Backend backend) = toTerm $ toFFI backend
+
+data PacketHeader
+ = Header0
+ | Header1
+ | Header2
+ | Header4
+ | RawHeader
+ | Sunrm
+ | ASN1
+ | CDR
+ | FCGI
+ | Line
+ | TPKT
+ | HTTP
+ | HTTPH
+ | HTTPBin
+ | HTTPHBin
+
+instance IsFFI PacketHeader Term where
+  toFFI Header0 = toTerm 0
+  toFFI Header1 = toTerm 1
+  toFFI Header2 = toTerm 2
+  toFFI Header4 = toTerm 4
+  toFFI RawHeader = toTerm :raw
+  toFFI Sunrm = toTerm :sumrm
+  toFFI ASN1 = toTerm :asn1
+  toFFI CDR = toTerm :cdr
+  toFFI FCGI = toTerm :fcgi
+  toFFI Line = toTerm :line
+  toFFI TPKT = toTerm :tpkt
+  toFFI HTTP = toTerm :http
+  toFFI HTTPH = toTerm :httph
+  toFFI HTTPBin = toTerm :http_bin
+  toFFI HTTPHBin = toTerm :httph_bin
+
+data Mode
+  = List
+  | Binary
+
+instance IsFFI Mode Atom where
+  toFFI List = :list
+  toFFI Binary = :binary
+
+data TcpOption
+  = Option Option
+  | IP IpAddress
+  | FD Integer
+  | IfAddr IpAddress
+  | Family Family
+  | Port UInt16
+  | TcpModule Atom
+  | Netns FileName
+  | BindToDevice Binary
+
+instance IsFFI TcpOption Term where
+  toFFI (Option opt) = toFFI opt
+  toFFI (IP addr) = toTerm (:ip, toFFI addr)
+  toFFI (FD num) = toTerm (:fd, num)
+  toFFI (IfAddr addr) = toTerm (:ifadr, toFFI addr)
+  toFFI (Family family) = toTerm (toFFI family)
+  toFFI (Port port) = toTerm (:port, port)
+  toFFI (TcpModule mod) = toTerm (:tcp_module, mod)
+  toFFI (Netns fileName) = toFFI fileName
+  toFFI (BindToDevice bin) = toTerm (:bind_to_device, bin)
+
+data ListenOption
+  = TcpOption TcpOption
+  | Backlog Integer
+
+instance IsFFI ListenOption Term where
+  toFFI (TcpOption opt) = toFFI opt
+  toFFI (Backlog num) = toTerm (:backlog, num)
+
+data ShutdownMethod
+  = Read
+  | Write
+  | ReadWrite
+
+instance IsFFI ShutdownMethod Atom where
+  toFFI Read = :read
+  toFFI Write = :write
+  toFFI ReadWrite = :read_write
+
+type ConnectOptions = [TcpOption]
+type ListenOptions = [ListenOption]
+
+class IsPacket a
+
+instance IsPacket [Char]
+
+instance IsPacket Binary
 
 foreign import accept :: Socket -> IO (Socket)
 
@@ -34,18 +195,18 @@ close :: Socket -> IO ()
 close = ffiIO1 :gen_tcp :close
 
 foreign import connect
-  :: IpAddress -> PortNumber -> Options -> IO Socket
+  :: IpAddress -> PortNumber -> ConnectOptions -> IO Socket
 
 foreign import connectTimeout
-  :: IpAddress -> PortNumber -> Options -> Timeout -> IO Socket
+  :: IpAddress -> PortNumber -> ConnectOptions -> Timeout -> IO Socket
 
-foreign import listen :: PortNumber -> Options -> IO Socket
+foreign import listen :: PortNumber -> ListenOptions -> IO Socket
 
-foreign import recv :: Socket -> Length -> IO Packet
+foreign import recv :: forall a. IsPacket a => Socket -> Length -> IO a
 
 foreign import recvTimeout
-  :: Socket -> Length -> Timeout -> IO Packet
+  :: forall a. IsPacket a => Socket -> Length -> Timeout ->  IO a
 
-foreign import send :: Socket -> Packet -> IO ()
+foreign import send :: forall a. (IsPacket a) => Socket -> a -> IO ()
 
-foreign import shutdown :: Socket -> Atom -> IO ()
+foreign import shutdown :: Socket -> ShutdownMethod -> IO ()