Merge pull request #88 from ohad/network-ffi

libs/network: Port FFI calls from deprecated interface to `%foreign` pragma

libs/network/Network/FFI.idr

@@ -0,0 +1,149 @@
+||| FFI binding to the low-Level C Sockets bindings for Idris. 
+||| 
+||| Modified (C) The Idris Community, 2020
+module Network.FFI
+
+import Network.Socket.Data
+
+-- From sys/socket.h
+
+%foreign "C:close,idris_net"
+export
+socket_close : (sockdes : SocketDescriptor) -> PrimIO Int
+
+%foreign "C:listen,idris_net"
+export
+socket_listen : (sockfd : SocketDescriptor) -> (backlog : Int) -> PrimIO Int
+
+
+-- From idris_net.h
+
+%foreign "C:idrnet_socket,idris_net"
+export
+idrnet_socket : (domain, type, protocol : Int) -> PrimIO Int
+
+%foreign "C:idrnet_bind,idris_net"
+export
+idrnet_bind : (sockfd : SocketDescriptor) -> (family, socket_type : Int) -> (host : String) 
+            -> (port : Port) -> PrimIO Int
+            
+%foreign "C:idrnet_connect,idris_net"
+export
+idrnet_connect : (sockfd : SocketDescriptor) -> (family, socket_type : Int) -> (host : String) 
+               -> (port : Port) -> PrimIO Int
+
+%foreign "C:idrnet_sockaddr_family,idris_net"
+export
+idrnet_sockaddr_family : (sockaddr : AnyPtr) -> PrimIO Int
+
+%foreign "C:idrnet_sockaddr_ipv4,idris_net"
+export
+idrnet_sockaddr_ipv4 : (sockaddr : AnyPtr) -> PrimIO String
+
+%foreign "C:idrnet_sockaddr_ipv4_port,idris_net"
+export
+idrnet_sockaddr_ipv4_port : (sockaddr : AnyPtr) -> PrimIO Int
+
+%foreign "C:idrnet_sockaddr_port,idris_net"
+export
+idrnet_sockaddr_port : (sockfd : SocketDescriptor) -> PrimIO Int
+
+
+%foreign "C:idrnet_create_sockaddr,idris_net"
+export
+idrnet_create_sockaddr : PrimIO AnyPtr
+
+%foreign "C:idrnet_accept,idris_net"
+export
+idrnet_accept : (sockfd : SocketDescriptor) -> (sockaddr : AnyPtr) -> PrimIO Int
+
+%foreign "C:idrnet_send,idris_net"
+export
+idrnet_send : (sockfd : SocketDescriptor) -> (dataString : String) -> PrimIO Int
+
+%foreign "C:idrnet_send_buf,idris_net"
+export
+idrnet_send_buf : (sockfd : SocketDescriptor) -> (dataBuffer : AnyPtr) -> (len : Int) -> PrimIO Int
+
+
+%foreign "C:idrnet_recv,idris_net"
+export
+idrnet_recv : (sockfd : SocketDescriptor) -> (len : Int) -> PrimIO AnyPtr
+
+%foreign "C:idrnet_recv_buf,idris_net"
+export
+idrnet_recv_buf : (sockfd : SocketDescriptor) -> (buf : AnyPtr) -> (len : Int) 
+               -> PrimIO Int
+
+%foreign "C:idrnet_sendto,idris_net"
+export
+idrnet_sendto : (sockfd : SocketDescriptor) -> (dataString,host : String)
+             -> (port : Port) -> (family : Int) -> PrimIO Int
+
+%foreign "C:idrnet_sendto_buf,idris_net"
+export
+idrnet_sendto_buf : (sockfd : SocketDescriptor) -> (dataBuf : AnyPtr) -> (buf_len : Int) 
+                 -> (host : String) -> (port : Port) -> (family : Int) -> PrimIO Int
+                 
+%foreign "C:idrnet_recvfrom,idris_net"
+export
+idrnet_recvfrom : (sockfd : SocketDescriptor) -> (len : Int) -> PrimIO AnyPtr                 
+
+%foreign "C:idrnet_recvfrom_buf,idris_net"
+export
+idrnet_recvfrom_buf : (sockfd : SocketDescriptor) -> (buf : AnyPtr) -> (len : Int) 
+                   -> PrimIO AnyPtr                 
+
+%foreign "C:idrnet_get_recv_res,idris_net"
+export
+idrnet_get_recv_res : (res_struct : AnyPtr) -> PrimIO Int
+
+%foreign "C:idrnet_get_recv_payload,idris_net"
+export
+idrnet_get_recv_payload : (res_struct : AnyPtr) -> PrimIO String
+
+%foreign "C:idrnet_free_recv_struct,idris_net"
+export
+idrnet_free_recv_struct : (res_struct : AnyPtr) -> PrimIO ()
+
+%foreign "C:idrnet_get_recvfrom_res,idris_net"
+export
+idrnet_get_recvfrom_res : (res_struct : AnyPtr) -> PrimIO Int
+
+%foreign "C:idrnet_get_recvfrom_payload,idris_net"
+export
+idrnet_get_recvfrom_payload : (res_struct : AnyPtr) -> PrimIO String
+
+%foreign "C:idrnet_get_recvfrom_sockaddr,idris_net"
+export
+idrnet_get_recvfrom_sockaddr : (res_struct : AnyPtr) -> PrimIO AnyPtr
+
+%foreign "C:idrnet_free_recvfrom_struct,idris_net"
+export
+idrnet_free_recvfrom_struct : (res_struct : AnyPtr) -> PrimIO ()
+
+
+%foreign "C:idrnet_geteagain,idris_net"
+export
+idrnet_geteagain : PrimIO Int
+
+%foreign "C:idrnet_errno,idris_net"
+export
+idrnet_errno : PrimIO Int
+
+%foreign "C:idrnet_malloc,idris_net"
+export
+idrnet_malloc : (size : Int) -> PrimIO AnyPtr
+
+%foreign "C:idrnet_free,idris_net"
+export
+idrnet_free : (ptr : AnyPtr) -> PrimIO ()
+
+%foreign "C:idrnet_peek,idris_net"
+export
+idrnet_peek : (ptr : AnyPtr) -> (offset : {-Unsigned-} Int) -> PrimIO {-Unsigned-} Int
+
+%foreign "C:idrnet_poke,idris_net"
+export
+idrnet_poke : (ptr : AnyPtr) -> (offset : {-Unsigned-} Int) -> (val : Int {- should be Char? -}) 
+           -> PrimIO ()

libs/network/Network/Socket.idr

@@ -7,6 +7,7 @@ module Network.Socket
 import public Network.Socket.Data
 import Network.Socket.Raw
 import Data.List
+import Network.FFI
 
 -- ----------------------------------------------------- [ Network Socket API. ]
 
@@ -18,7 +19,7 @@ socket : (fam  : SocketFamily)
       -> (pnum : ProtocolNumber)
       -> IO (Either SocketError Socket)
 socket sf st pn = do
-  socket_res <- cCall Int "idrnet_socket" [toCode sf, toCode st, pn]
+  socket_res <- primIO $ idrnet_socket (toCode sf) (toCode st) pn
 
   if socket_res == -1
     then map Left getErrno
@@ -27,7 +28,8 @@ socket sf st pn = do
 ||| Close a socket
 export
 close : Socket -> IO ()
-close sock = cCall () "close" [descriptor sock]
+close sock = do _ <- primIO $ socket_close $ descriptor sock
+                pure ()
 
 ||| Binds a socket to the given socket address and port.
 ||| Returns 0 on success, an error code otherwise.
@@ -37,10 +39,13 @@ bind : (sock : Socket)
     -> (port : Port)
     -> IO Int
 bind sock addr port = do
-    bind_res <- cCall Int "idrnet_bind"
-                [ descriptor sock, toCode $ family sock
-                , toCode $ socketType sock, saString addr,  port
-                ]
+    bind_res <- primIO $ idrnet_bind
+                  (descriptor sock)
+                  (toCode $ family sock)
+                  (toCode $ socketType sock)
+                  (saString addr)
+                  port
+                
     if bind_res == (-1)
       then getErrno
       else pure 0
@@ -57,8 +62,8 @@ connect : (sock : Socket)
        -> (port : Port)
        -> IO ResultCode
 connect sock addr port = do
-  conn_res <- cCall Int "idrnet_connect"
-              [ descriptor sock, toCode $ family sock, toCode $ socketType sock, show addr, port]
+  conn_res <- primIO $ idrnet_connect
+              (descriptor sock) (toCode $ family sock) (toCode $ socketType sock) (show addr) port
 
   if conn_res == (-1)
     then getErrno
@@ -70,7 +75,7 @@ connect sock addr port = do
 export
 listen : (sock : Socket) -> IO Int
 listen sock = do
-  listen_res <- cCall Int "listen" [ descriptor sock, BACKLOG ]
+  listen_res <- primIO $ socket_listen (descriptor sock) BACKLOG 
   if listen_res == (-1)
     then getErrno
     else pure 0
@@ -91,9 +96,9 @@ accept sock = do
   -- We need a pointer to a sockaddr structure. This is then passed into
   -- idrnet_accept and populated. We can then query it for the SocketAddr and free it.
 
-  sockaddr_ptr <- cCall AnyPtr "idrnet_create_sockaddr" []
+  sockaddr_ptr <- primIO idrnet_create_sockaddr
 
-  accept_res <- cCall Int "idrnet_accept" [ descriptor sock, sockaddr_ptr ]
+  accept_res <- primIO $ idrnet_accept (descriptor sock) sockaddr_ptr 
   if accept_res == (-1)
     then map Left getErrno
     else do
@@ -114,7 +119,7 @@ send : (sock : Socket)
     -> (msg  : String)
     -> IO (Either SocketError ResultCode)
 send sock dat = do
-  send_res <- cCall Int "idrnet_send" [ descriptor sock, dat ]
+  send_res <- primIO $ idrnet_send (descriptor sock) dat 
 
   if send_res == (-1)
     then map Left getErrno
@@ -136,8 +141,8 @@ recv : (sock : Socket)
 recv sock len = do
   -- Firstly make the request, get some kind of recv structure which
   -- contains the result of the recv and possibly the retrieved payload
-  recv_struct_ptr <- cCall AnyPtr "idrnet_recv" [ descriptor sock, len]
-  recv_res <- cCall Int "idrnet_get_recv_res"  [ recv_struct_ptr ]
+  recv_struct_ptr <- primIO $ idrnet_recv (descriptor sock) len
+  recv_res <- primIO $ idrnet_get_recv_res recv_struct_ptr
 
   if recv_res == (-1)
     then do
@@ -150,7 +155,7 @@ recv sock len = do
            freeRecvStruct (RSPtr recv_struct_ptr)
            pure $ Left 0
         else do
-           payload <- cCall String "idrnet_get_recv_payload" [ recv_struct_ptr ]
+           payload <- primIO $ idrnet_get_recv_payload recv_struct_ptr
            freeRecvStruct (RSPtr recv_struct_ptr)
            pure $ Right (payload, recv_res)
 
@@ -189,8 +194,8 @@ sendTo : (sock : Socket)
       -> (msg  : String)
       -> IO (Either SocketError ByteLength)
 sendTo sock addr p dat = do
-  sendto_res <- cCall Int "idrnet_sendto"
-                [ descriptor sock, dat, show addr, p ,toCode $ family sock ]
+  sendto_res <- primIO $ idrnet_sendto
+                (descriptor sock) dat (show addr) p (toCode $ family sock)
 
   if sendto_res == (-1)
     then map Left getErrno
@@ -212,15 +217,15 @@ recvFrom : (sock : Socket)
         -> (len  : ByteLength)
         -> IO (Either SocketError (UDPAddrInfo, String, ResultCode))
 recvFrom sock bl = do
-  recv_ptr <- cCall AnyPtr "idrnet_recvfrom"
-              [ descriptor sock, bl ]
+  recv_ptr <- primIO $ idrnet_recvfrom
+                       (descriptor sock) bl 
 
   let recv_ptr' = RFPtr recv_ptr
   isNull <- (nullPtr recv_ptr)
   if isNull
     then map Left getErrno
     else do
-      result <- cCall Int "idrnet_get_recvfrom_res" [ recv_ptr ]
+      result <- primIO $ idrnet_get_recvfrom_res recv_ptr 
       if result == -1
         then do
           freeRecvfromStruct recv_ptr'

libs/network/Network/Socket/Data.idr

@@ -48,22 +48,36 @@ export
 BACKLOG : Int
 BACKLOG = 20
 
+-- Repeat to avoid a dependency cycle
+%foreign "C:idrnet_geteagain,idris_net"
+idrnet_geteagain : PrimIO Int
+
 export
 EAGAIN : Int
 EAGAIN =
   -- I'm sorry
   -- maybe
-  unsafePerformIO $ cCall Int "idrnet_geteagain" []
+  unsafePerformIO $ primIO $ idrnet_geteagain
 
 -- ---------------------------------------------------------------- [ Error Code ]
 
+-- repeat without export to avoid dependency cycles
+%foreign "C:idrnet_errno,idris_net"
+idrnet_errno : PrimIO Int
+
+%foreign "C:isNull,idris_net"
+idrnet_isNull : (ptr : AnyPtr) -> PrimIO Int
+
+
 export
 getErrno : IO SocketError
-getErrno = cCall Int "idrnet_errno" []
+getErrno = primIO $ idrnet_errno
 
 export
 nullPtr : AnyPtr -> IO Bool
-nullPtr p = cCall Bool "isNull" [p]
+nullPtr p = do 0 <- primIO  $ idrnet_isNull p
+               | _ => pure True
+               pure False
 
 -- -------------------------------------------------------------- [ Interfaces ]
 

libs/network/Network/Socket/Raw.idr

@@ -7,6 +7,8 @@ module Network.Socket.Raw
 
 import public Network.Socket.Data
 
+import Network.FFI
+
 -- ---------------------------------------------------------------- [ Pointers ]
 
 public export
@@ -26,45 +28,45 @@ data SockaddrPtr = SAPtr AnyPtr
 ||| Put a value in a buffer
 export
 sock_poke : BufPtr -> Int -> Int -> IO ()
-sock_poke (BPtr ptr) offset val = cCall () "idrnet_poke" [ptr, offset, val]
+sock_poke (BPtr ptr) offset val = primIO $ idrnet_poke ptr offset val
 
 ||| Take a value from a buffer
 export
 sock_peek : BufPtr -> Int -> IO Int
-sock_peek (BPtr ptr) offset = cCall Int "idrnet_peek" [ptr, offset]
+sock_peek (BPtr ptr) offset = primIO $ idrnet_peek ptr offset
 
 ||| Frees a given pointer
 export
 sock_free : BufPtr -> IO ()
-sock_free (BPtr ptr) = cCall () "idrnet_free" [ptr]
+sock_free (BPtr ptr) = primIO $ idrnet_free ptr
 
 export
 sockaddr_free : SockaddrPtr -> IO ()
-sockaddr_free (SAPtr ptr) = cCall () "idrnet_free" [ptr]
+sockaddr_free (SAPtr ptr) = primIO $ idrnet_free ptr
 
 ||| Allocates an amount of memory given by the ByteLength parameter.
 |||
 ||| Used to allocate a mutable pointer to be given to the Recv functions.
 export
 sock_alloc : ByteLength -> IO BufPtr
-sock_alloc bl = map BPtr $ cCall AnyPtr "idrnet_malloc" [bl]
+sock_alloc bl = map BPtr $ primIO $ idrnet_malloc bl
 
 ||| Retrieves the port the given socket is bound to
 export
 getSockPort : Socket -> IO Port
-getSockPort sock = cCall Int "idrnet_sockaddr_port" [descriptor sock]
+getSockPort sock = primIO $ idrnet_sockaddr_port $ descriptor sock
 
 
 ||| Retrieves a socket address from a sockaddr pointer
 export
 getSockAddr : SockaddrPtr -> IO SocketAddress
 getSockAddr (SAPtr ptr) = do
-  addr_family_int <- cCall Int "idrnet_sockaddr_family"  [ptr]
+  addr_family_int <- primIO $ idrnet_sockaddr_family ptr
 
   -- ASSUMPTION: Foreign call returns a valid int
   assert_total (case getSocketFamily addr_family_int of
     Just AF_INET => do
-      ipv4_addr <- cCall String "idrnet_sockaddr_ipv4" [ptr]
+      ipv4_addr <- primIO $ idrnet_sockaddr_ipv4 ptr
 
       pure $ parseIPv4 ipv4_addr
     Just AF_INET6 => pure IPv6Addr
@@ -72,12 +74,12 @@ getSockAddr (SAPtr ptr) = do
 
 export
 freeRecvStruct : RecvStructPtr -> IO ()
-freeRecvStruct (RSPtr p) = cCall () "idrnet_free_recv_struct" [p]
+freeRecvStruct (RSPtr p) = primIO $ idrnet_free_recv_struct p
 
 ||| Utility to extract data.
 export
 freeRecvfromStruct : RecvfromStructPtr -> IO ()
-freeRecvfromStruct (RFPtr p) = cCall () "idrnet_free_recvfrom_struct" [p]
+freeRecvfromStruct (RFPtr p) = primIO $ idrnet_free_recvfrom_struct p
 
 ||| Sends the data in a given memory location
 |||
@@ -93,7 +95,7 @@ sendBuf : (sock : Socket)
        -> (len  : ByteLength)
        -> IO (Either SocketError ResultCode)
 sendBuf sock (BPtr ptr) len = do
-  send_res <- cCall Int "idrnet_send_buf" [ descriptor sock, ptr, len]
+  send_res <- primIO $ idrnet_send_buf (descriptor sock) ptr len
 
   if send_res == (-1)
    then map Left getErrno
@@ -113,7 +115,7 @@ recvBuf : (sock : Socket)
        -> (len  : ByteLength)
        -> IO (Either SocketError ResultCode)
 recvBuf sock (BPtr ptr) len = do
-  recv_res <- cCall Int "idrnet_recv_buf" [ descriptor sock, ptr, len ]
+  recv_res <- primIO $ idrnet_recv_buf (descriptor sock) ptr len
 
   if (recv_res == (-1))
     then map Left getErrno
@@ -137,8 +139,8 @@ sendToBuf : (sock : Socket)
          -> (len  : ByteLength)
          -> IO (Either SocketError ResultCode)
 sendToBuf sock addr p (BPtr dat) len = do
-  sendto_res <- cCall Int "idrnet_sendto_buf"
-                [ descriptor sock, dat, len, show addr, p, toCode $ family sock ]
+  sendto_res <- primIO $ idrnet_sendto_buf
+                (descriptor sock) dat len (show addr) p (toCode $ family sock)
 
   if sendto_res == (-1)
     then map Left getErrno
@@ -147,21 +149,21 @@ sendToBuf sock addr p (BPtr dat) len = do
 ||| Utility function to get the payload of the sent message as a `String`.
 export
 foreignGetRecvfromPayload : RecvfromStructPtr -> IO String
-foreignGetRecvfromPayload (RFPtr p) = cCall String "idrnet_get_recvfrom_payload" [ p ]
+foreignGetRecvfromPayload (RFPtr p) = primIO $ idrnet_get_recvfrom_payload p 
 
 ||| Utility function to return senders socket address.
 export
 foreignGetRecvfromAddr : RecvfromStructPtr -> IO SocketAddress
 foreignGetRecvfromAddr (RFPtr p) = do
-  sockaddr_ptr <- map SAPtr $ cCall AnyPtr "idrnet_get_recvfrom_sockaddr" [p]
+  sockaddr_ptr <- map SAPtr $ primIO $ idrnet_get_recvfrom_sockaddr p
   getSockAddr sockaddr_ptr
 
 ||| Utility function to return sender's IPV4 port.
 export
 foreignGetRecvfromPort : RecvfromStructPtr -> IO Port
 foreignGetRecvfromPort (RFPtr p) = do
-  sockaddr_ptr <- cCall AnyPtr "idrnet_get_recvfrom_sockaddr" [p]
-  port         <- cCall Int "idrnet_sockaddr_ipv4_port" [sockaddr_ptr]
+  sockaddr_ptr <- primIO $ idrnet_get_recvfrom_sockaddr p
+  port         <- primIO $ idrnet_sockaddr_ipv4_port sockaddr_ptr
   pure port
 
 ||| Receive a message placed on a 'known' buffer.
@@ -181,7 +183,7 @@ recvFromBuf : (sock : Socket)
            -> (len  : ByteLength)
            -> IO (Either SocketError (UDPAddrInfo, ResultCode))
 recvFromBuf sock (BPtr ptr) bl = do
-  recv_ptr <- cCall AnyPtr "idrnet_recvfrom_buf" [ descriptor sock, ptr, bl]
+  recv_ptr <- primIO $ idrnet_recvfrom_buf (descriptor sock) ptr bl
 
   let recv_ptr' = RFPtr recv_ptr
 
@@ -190,7 +192,7 @@ recvFromBuf sock (BPtr ptr) bl = do
   if isnull
     then map Left getErrno
     else do
-      result <- cCall Int "idrnet_get_recvfrom_res" [recv_ptr]
+      result <- primIO $ idrnet_get_recvfrom_res recv_ptr
       if result == -1
         then do
           freeRecvfromStruct recv_ptr'

libs/network/network.ipkg

@@ -2,4 +2,5 @@ package network
 
 modules = Network.Socket,
           Network.Socket.Data,
-          Network.Socket.Raw
+          Network.Socket.Raw,
+          Network.FFI