PageRenderTime 51ms CodeModel.GetById 24ms RepoModel.GetById 0ms app.codeStats 1ms

/libs/contrib/Network/Socket.idr

https://github.com/Heather/Idris-dev
Idris | 370 lines | 300 code | 59 blank | 11 comment | 41 complexity | 7449f3453f7b62a517de53bb2cbf30a5 MD5 | raw file
Possible License(s): BSD-3-Clause
  1. -- Time to do this properly.
  2. -- Low-Level C Sockets bindings for Idris. Used by higher-level, cleverer things.
  3. -- (C) SimonJF, MIT Licensed, 2014
  4. module IdrisNet.Socket
  5. %include C "idris_net.h"
  6. %include C "sys/types.h"
  7. %include C "sys/socket.h"
  8. %include C "netdb.h"
  9. %access public
  10. ByteLength : Type
  11. ByteLength = Int
  12. class ToCode a where
  13. toCode : a -> Int
  14. ||| Socket Families
  15. |||
  16. ||| The ones that people might actually use. We're not going to need US
  17. ||| Government proprietary ones.
  18. data SocketFamily =
  19. ||| Unspecified
  20. AF_UNSPEC |
  21. ||| IP / UDP etc. IPv4
  22. AF_INET |
  23. ||| IP / UDP etc. IPv6
  24. AF_INET6
  25. instance Show SocketFamily where
  26. show AF_UNSPEC = "AF_UNSPEC"
  27. show AF_INET = "AF_INET"
  28. show AF_INET6 = "AF_INET6"
  29. instance ToCode SocketFamily where
  30. toCode AF_UNSPEC = 0
  31. toCode AF_INET = 2
  32. toCode AF_INET6 = 10
  33. getSocketFamily : Int -> Maybe SocketFamily
  34. getSocketFamily i = Prelude.List.lookup i [(0, AF_UNSPEC), (2, AF_INET), (10, AF_INET6)]
  35. ||| Socket Types.
  36. data SocketType =
  37. ||| Not a socket, used in certain operations
  38. NotASocket |
  39. ||| TCP
  40. Stream |
  41. ||| UDP
  42. Datagram |
  43. ||| Raw sockets
  44. RawSocket
  45. instance Show SocketType where
  46. show NotASocket = "Not a socket"
  47. show Stream = "Stream"
  48. show Datagram = "Datagram"
  49. show RawSocket = "Raw"
  50. instance ToCode SocketType where
  51. toCode NotASocket = 0
  52. toCode Stream = 1
  53. toCode Datagram = 2
  54. toCode RawSocket = 3
  55. data RecvStructPtr = RSPtr Ptr
  56. data RecvfromStructPtr = RFPtr Ptr
  57. data BufPtr = BPtr Ptr
  58. data SockaddrPtr = SAPtr Ptr
  59. ||| Protocol Number.
  60. |||
  61. ||| Generally good enough to just set it to 0.
  62. ProtocolNumber : Type
  63. ProtocolNumber = Int
  64. ||| SocketError: Error thrown by a socket operation
  65. SocketError : Type
  66. SocketError = Int
  67. ||| SocketDescriptor: Native C Socket Descriptor
  68. SocketDescriptor : Type
  69. SocketDescriptor = Int
  70. data SocketAddress = IPv4Addr Int Int Int Int
  71. | IPv6Addr -- Not implemented (yet)
  72. | Hostname String
  73. | InvalidAddress -- Used when there's a parse error
  74. instance Show SocketAddress where
  75. show (IPv4Addr i1 i2 i3 i4) = concat $ Prelude.List.intersperse "." (map show [i1, i2, i3, i4])
  76. show IPv6Addr = "NOT IMPLEMENTED YET"
  77. show (Hostname host) = host
  78. show InvalidAddress = "Invalid"
  79. Port : Type
  80. Port = Int
  81. ||| Backlog used within listen() call -- number of incoming calls
  82. BACKLOG : Int
  83. BACKLOG = 20
  84. -- FIXME: This *must* be pulled in from C
  85. EAGAIN : Int
  86. EAGAIN = 11
  87. -- TODO: Expand to non-string payloads
  88. record UDPRecvData : Type where
  89. MkUDPRecvData :
  90. (remote_addr : SocketAddress) ->
  91. (remote_port : Port) ->
  92. (recv_data : String) ->
  93. (data_len : Int) ->
  94. UDPRecvData
  95. record UDPAddrInfo : Type where
  96. MkUDPAddrInfo :
  97. (remote_addr : SocketAddress) ->
  98. (remote_port : Port) ->
  99. UDPAddrInfo
  100. ||| Frees a given pointer
  101. public
  102. sock_free : BufPtr -> IO ()
  103. sock_free (BPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr
  104. public
  105. sockaddr_free : SockaddrPtr -> IO ()
  106. sockaddr_free (SAPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr
  107. ||| Allocates an amount of memory given by the ByteLength parameter.
  108. |||
  109. ||| Used to allocate a mutable pointer to be given to the Recv functions.
  110. public
  111. sock_alloc : ByteLength -> IO BufPtr
  112. sock_alloc bl = map BPtr $ foreign FFI_C "idrnet_malloc" (Int -> IO Ptr) bl
  113. ||| The metadata about a socket
  114. record Socket : Type where
  115. MkSocket : (descriptor : SocketDescriptor) ->
  116. (family : SocketFamily) ->
  117. (socketType : SocketType) ->
  118. (protocolNumber : ProtocolNumber) ->
  119. Socket
  120. ||| Get the C error number
  121. getErrno : IO Int
  122. getErrno = foreign FFI_C "idrnet_errno" (IO Int)
  123. ||| Creates a UNIX socket with the given family, socket type and protocol
  124. ||| number. Returns either a socket or an error.
  125. socket : SocketFamily -> SocketType -> ProtocolNumber -> IO (Either SocketError Socket)
  126. socket sf st pn = do
  127. socket_res <- foreign FFI_C "socket" (Int -> Int -> Int -> IO Int) (toCode sf) (toCode st) pn
  128. if socket_res == -1 then -- error
  129. map Left getErrno
  130. else
  131. return $ Right (MkSocket socket_res sf st pn)
  132. ||| Close a socket
  133. close : Socket -> IO ()
  134. close sock = foreign FFI_C "close" (Int -> IO ()) (descriptor sock)
  135. private
  136. saString : (Maybe SocketAddress) -> String
  137. saString (Just sa) = show sa
  138. saString Nothing = ""
  139. ||| Binds a socket to the given socket address and port.
  140. ||| Returns 0 on success, an error code otherwise.
  141. bind : Socket -> (Maybe SocketAddress) -> Port -> IO Int
  142. bind sock addr port = do
  143. bind_res <- foreign FFI_C "idrnet_bind"
  144. (Int -> Int -> Int -> String -> Int -> IO Int)
  145. (descriptor sock) (toCode $ family sock)
  146. (toCode $ socketType sock) (saString addr) port
  147. if bind_res == (-1) then -- error
  148. getErrno
  149. else return 0 -- Success
  150. ||| Connects to a given address and port.
  151. ||| Returns 0 on success, and an error number on error.
  152. connect : Socket -> SocketAddress -> Port -> IO Int
  153. connect sock addr port = do
  154. conn_res <- foreign FFI_C "idrnet_connect"
  155. (Int -> Int -> Int -> String -> Int -> IO Int)
  156. (descriptor sock) (toCode $ family sock) (toCode $ socketType sock) (show addr) port
  157. if conn_res == (-1) then
  158. getErrno
  159. else return 0
  160. ||| Listens on a bound socket.
  161. listen : Socket -> IO Int
  162. listen sock = do
  163. listen_res <- foreign FFI_C "listen" (Int -> Int -> IO Int)
  164. (descriptor sock) BACKLOG
  165. if listen_res == (-1) then
  166. getErrno
  167. else return 0
  168. ||| Parses a textual representation of an IPv4 address into a SocketAddress
  169. parseIPv4 : String -> SocketAddress
  170. parseIPv4 str = case splitted of
  171. (i1 :: i2 :: i3 :: i4 :: _) => IPv4Addr i1 i2 i3 i4
  172. _ => InvalidAddress
  173. where toInt' : String -> Integer
  174. toInt' = cast
  175. toInt : String -> Int
  176. toInt s = fromInteger $ toInt' s
  177. splitted : List Int
  178. splitted = map toInt (Prelude.Strings.split (\c => c == '.') str)
  179. ||| Retrieves a socket address from a sockaddr pointer
  180. getSockAddr : SockaddrPtr -> IO SocketAddress
  181. getSockAddr (SAPtr ptr) = do
  182. addr_family_int <- foreign FFI_C "idrnet_sockaddr_family" (Ptr -> IO Int) ptr
  183. -- putStrLn $ "Addr family int: " ++ (show addr_family_int)
  184. -- ASSUMPTION: Foreign call returns a valid int
  185. assert_total (case getSocketFamily addr_family_int of
  186. Just AF_INET => do
  187. ipv4_addr <- foreign FFI_C "idrnet_sockaddr_ipv4" (Ptr -> IO String) ptr
  188. return $ parseIPv4 ipv4_addr
  189. Just AF_INET6 => return IPv6Addr
  190. Just AF_UNSPEC => return InvalidAddress)
  191. accept : Socket -> IO (Either SocketError (Socket, SocketAddress))
  192. accept sock = do
  193. -- We need a pointer to a sockaddr structure. This is then passed into
  194. -- idrnet_accept and populated. We can then query it for the SocketAddr and free it.
  195. sockaddr_ptr <- foreign FFI_C "idrnet_create_sockaddr" (IO Ptr)
  196. accept_res <- foreign FFI_C "idrnet_accept" (Int -> Ptr -> IO Int) (descriptor sock) sockaddr_ptr
  197. if accept_res == (-1) then
  198. map Left getErrno
  199. else do
  200. let (MkSocket _ fam ty p_num) = sock
  201. sockaddr <- getSockAddr (SAPtr sockaddr_ptr)
  202. sockaddr_free (SAPtr sockaddr_ptr)
  203. return $ Right ((MkSocket accept_res fam ty p_num), sockaddr)
  204. send : Socket -> String -> IO (Either SocketError ByteLength)
  205. send sock dat = do
  206. send_res <- foreign FFI_C "idrnet_send" (Int -> String -> IO Int) (descriptor sock) dat
  207. if send_res == (-1) then
  208. map Left getErrno
  209. else
  210. return $ Right send_res
  211. freeRecvStruct : RecvStructPtr -> IO ()
  212. freeRecvStruct (RSPtr p) = foreign FFI_C "idrnet_free_recv_struct" (Ptr -> IO ()) p
  213. freeRecvfromStruct : RecvfromStructPtr -> IO ()
  214. freeRecvfromStruct (RFPtr p) = foreign FFI_C "idrnet_free_recvfrom_struct" (Ptr -> IO ()) p
  215. recv : Socket -> Int -> IO (Either SocketError (String, ByteLength))
  216. recv sock len = do
  217. -- Firstly make the request, get some kind of recv structure which
  218. -- contains the result of the recv and possibly the retrieved payload
  219. recv_struct_ptr <- foreign FFI_C "idrnet_recv" (Int -> Int -> IO Ptr) (descriptor sock) len
  220. recv_res <- foreign FFI_C "idrnet_get_recv_res" (Ptr -> IO Int) recv_struct_ptr
  221. if recv_res == (-1) then do
  222. errno <- getErrno
  223. freeRecvStruct (RSPtr recv_struct_ptr)
  224. return $ Left errno
  225. else
  226. if recv_res == 0 then do
  227. freeRecvStruct (RSPtr recv_struct_ptr)
  228. return $ Left 0
  229. else do
  230. payload <- foreign FFI_C "idrnet_get_recv_payload" (Ptr -> IO String) recv_struct_ptr
  231. freeRecvStruct (RSPtr recv_struct_ptr)
  232. return $ Right (payload, recv_res)
  233. ||| Sends the data in a given memory location
  234. sendBuf : Socket -> BufPtr -> ByteLength -> IO (Either SocketError ByteLength)
  235. sendBuf sock (BPtr ptr) len = do
  236. send_res <- foreign FFI_C "idrnet_send_buf" (Int -> Ptr -> Int -> IO Int) (descriptor sock) ptr len
  237. if send_res == (-1) then
  238. map Left getErrno
  239. else
  240. return $ Right send_res
  241. recvBuf : Socket -> BufPtr -> ByteLength -> IO (Either SocketError ByteLength)
  242. recvBuf sock (BPtr ptr) len = do
  243. recv_res <- foreign FFI_C "idrnet_recv_buf" (Int -> Ptr -> Int -> IO Int) (descriptor sock) ptr len
  244. if (recv_res == (-1)) then
  245. map Left getErrno
  246. else
  247. return $ Right recv_res
  248. sendTo : Socket -> SocketAddress -> Port -> String -> IO (Either SocketError ByteLength)
  249. sendTo sock addr p dat = do
  250. sendto_res <- foreign FFI_C "idrnet_sendto"
  251. (Int -> String -> String -> Int -> Int -> IO Int)
  252. (descriptor sock) dat (show addr) p (toCode $ family sock)
  253. if sendto_res == (-1) then
  254. map Left getErrno
  255. else
  256. return $ Right sendto_res
  257. sendToBuf : Socket -> SocketAddress -> Port -> BufPtr -> ByteLength -> IO (Either SocketError ByteLength)
  258. sendToBuf sock addr p (BPtr dat) len = do
  259. sendto_res <- foreign FFI_C "idrnet_sendto_buf"
  260. (Int -> Ptr -> Int -> String -> Int -> Int -> IO Int)
  261. (descriptor sock) dat len (show addr) p (toCode $ family sock)
  262. if sendto_res == (-1) then
  263. map Left getErrno
  264. else
  265. return $ Right sendto_res
  266. foreignGetRecvfromPayload : RecvfromStructPtr -> IO String
  267. foreignGetRecvfromPayload (RFPtr p)
  268. = foreign FFI_C "idrnet_get_recvfrom_payload" (Ptr -> IO String) p
  269. foreignGetRecvfromAddr : RecvfromStructPtr -> IO SocketAddress
  270. foreignGetRecvfromAddr (RFPtr p) = do
  271. sockaddr_ptr <- map SAPtr $ foreign FFI_C "idrnet_get_recvfrom_sockaddr" (Ptr -> IO Ptr) p
  272. getSockAddr sockaddr_ptr
  273. foreignGetRecvfromPort : RecvfromStructPtr -> IO Port
  274. foreignGetRecvfromPort (RFPtr p) = do
  275. sockaddr_ptr <- foreign FFI_C "idrnet_get_recvfrom_sockaddr" (Ptr -> IO Ptr) p
  276. port <- foreign FFI_C "idrnet_sockaddr_ipv4_port" (Ptr -> IO Int) sockaddr_ptr
  277. return port
  278. recvFrom : Socket -> ByteLength -> IO (Either SocketError (UDPAddrInfo, String, ByteLength))
  279. recvFrom sock bl = do
  280. recv_ptr <- foreign FFI_C "idrnet_recvfrom" (Int -> Int -> IO Ptr)
  281. (descriptor sock) bl
  282. let recv_ptr' = RFPtr recv_ptr
  283. if !(nullPtr recv_ptr) then
  284. map Left getErrno
  285. else do
  286. result <- foreign FFI_C "idrnet_get_recvfrom_res" (Ptr -> IO Int) recv_ptr
  287. if result == -1 then do
  288. freeRecvfromStruct recv_ptr'
  289. map Left getErrno
  290. else do
  291. payload <- foreignGetRecvfromPayload recv_ptr'
  292. port <- foreignGetRecvfromPort recv_ptr'
  293. addr <- foreignGetRecvfromAddr recv_ptr'
  294. freeRecvfromStruct recv_ptr'
  295. return $ Right (MkUDPAddrInfo addr port, payload, result)
  296. recvFromBuf : Socket -> BufPtr -> ByteLength -> IO (Either SocketError (UDPAddrInfo, ByteLength))
  297. recvFromBuf sock (BPtr ptr) bl = do
  298. recv_ptr <- foreign FFI_C "idrnet_recvfrom_buf" (Int -> Ptr -> Int -> IO Ptr) (descriptor sock) ptr bl
  299. let recv_ptr' = RFPtr recv_ptr
  300. if !(nullPtr recv_ptr) then
  301. map Left getErrno
  302. else do
  303. result <- foreign FFI_C "idrnet_get_recvfrom_res" (Ptr -> IO Int) recv_ptr
  304. if result == -1 then do
  305. freeRecvfromStruct recv_ptr'
  306. map Left getErrno
  307. else do
  308. port <- foreignGetRecvfromPort recv_ptr'
  309. addr <- foreignGetRecvfromAddr recv_ptr'
  310. freeRecvfromStruct recv_ptr'
  311. return $ Right (MkUDPAddrInfo addr port, result + 1)