0 | module FS.Socket
 1 |
 2 | import public FS.Posix
 3 | import public IO.Async.Socket
 4 | import IO.Async.Loop.Posix
 5 |
 6 | %default total
 7 |
 8 | public export
 9 | record RFD (a : Type) where
10 |   constructor R
11 |   file : a
12 |   {auto isf : FileDesc a}
13 |
14 | export %inline
15 | Resource (Async e) (RFD a) where
16 |   cleanup (R f) = stdoutLn "Closing \{show $ fileDesc f}" >> close' f
17 |
18 | parameters {0    es  : List Type}
19 |            {auto ph  : PollH e}
20 |            {auto has : Has Errno es}
21 |
22 |   export
23 |   acceptOn : (d : Domain) -> SockType -> Addr d -> AsyncStream e es (Socket d)
24 |   acceptOn d tpe addr =
25 |     resource ((\x => Socket.R x) <$> socketnb d tpe) $ \(R sock) => do
26 |       bind sock addr
27 |       listen sock 2048
28 |       repeat $ eval (acceptnb sock)
29 |
30 |   acceptMany : Nat -> Socket d -> Async e es (List $ Socket d)
31 |   acceptMany n sock = do
32 |     c <- acceptnb sock
33 |     go [<c] n
34 |
35 |     where
36 |       go : SnocList (Socket d) -> Nat -> Async e es (List $ Socket d)
37 |       go ss 0     = pure (ss <>> [])
38 |       go ss (S k) =
39 |         attempt (accept {es = [Errno]} sock) >>= \case
40 |           Right peer    => go (ss :< peer) k
41 |           Left (Here x) =>
42 |             if x == EINPROGRESS || x == EAGAIN
43 |                then pure (ss <>> [])
44 |                else throw x
45 |
46 |   export
47 |   acceptN : Nat -> (d : Domain) -> SockType -> Addr d -> AsyncStream e es (List $ Socket d)
48 |   acceptN n d tpe addr =
49 |     resource ((\x => Socket.R x) <$> socketnb d tpe) $ \(R sock) => do
50 |       bind sock addr
51 |       listen sock 2048
52 |       repeat $ eval (acceptMany n sock)
53 |