0 | module System.UV.TCP
 1 |
 2 | import IO.Async.Event
 3 | import System.UV.Loop
 4 | import System.UV.Pointer
 5 | import System.UV.Stream
 6 | import System.UV.Raw.Handle
 7 | import System.UV.Raw.Stream
 8 | import System.UV.Raw.TCP
 9 |
10 | %default total
11 |
12 | export
13 | Resource (Ptr SockAddrIn) where
14 |   release = freePtr
15 |
16 | export %inline
17 | (cc : CloseCB) => Resource (Ptr Tcp) where
18 |   release h = uv_close h cc
19 |
20 | ||| Convert a binary structure containing an IPv4 address to a string.
21 | export
22 | ip4name : Ptr SockAddrIn -> IO String
23 | ip4name p = do
24 |   cs <- mallocPtrs Char 256
25 |   r  <- uv_ip4_name p cs 255
26 |   let res = getString cs
27 |   freePtr cs
28 |   pure res
29 |
30 | ||| Convert a binary structure containing an IPv6 address to a string.
31 | export
32 | ip6name : Ptr SockAddrIn6 -> IO String
33 | ip6name p = do
34 |   cs <- mallocPtrs Char 256
35 |   r  <- uv_ip6_name p cs 255
36 |   let res = getString cs
37 |   freePtr cs
38 |   pure res
39 |
40 | ||| Convert a binary structure containing an IPv4 address or an
41 | ||| IPv6 address to a string.
42 | export
43 | ipname : Ptr SockAddr -> IO String
44 | ipname p = do
45 |   cs <- mallocPtrs Char 256
46 |   r  <- uv_ip_name p cs 255
47 |   let res = getString cs
48 |   freePtr cs
49 |   pure res
50 |
51 | parameters {auto l : UVLoop}
52 |            {auto has : Has UVError es}
53 |
54 |   export
55 |   mkTcp : Async es (Ptr Tcp)
56 |   mkTcp = mallocPtr Tcp >>= uvAct (uv_tcp_init l.loop)
57 |
58 |   export
59 |   bindTcp : Ptr SockAddrIn -> Async es (Ptr Tcp)
60 |   bindTcp addr = mkTcp >>= uvAct (\x => uv_tcp_bind x addr 0)
61 |
62 |   export
63 |   acceptTcp : Ptr Stream -> Async es (Ptr Tcp)
64 |   acceptTcp server = mkTcp >>= uvAct (\x => uv_accept server x)
65 |
66 |   export covering
67 |   listenTcp :
68 |        (addresss : String)
69 |     -> (port     : Bits16)
70 |     -> (run      : Buffer (Either UVError (Ptr Stream)) -> Async es ())
71 |     -> Async es ()
72 |   listenTcp address port run =
73 |     useMany [mallocPtr SockAddrIn, closeWithoutUnlockingCB] $ \[addr,cc] => do
74 |       uv (uv_ip4_addr address port addr)
75 |       bracket (bindTcp addr) (\server => listen server run) (\p => uv_close p cc)
76 |