tcp.tri (3769B)
1 !import io_v2 as IO 2 !import base as B 3 !import native_math as N 4 !import conversions as C 5 !import handlers as H 6 !export server 7 !export handledServer 8 !export supervisedHandledServer 9 !export client 10 !export namedClient 11 !export resolve 12 !export candidates 13 !export connectResult 14 !export invalidAddress 15 16 port ["ipv4" _ value] = value 17 port ["ipv6" _ _ value] = value 18 port _ = 0 19 announce listener = do IO.require 20 address <- IO.localAddress listener 21 output <- IO.stdout 22 IO.writeAll output (B.append (C.showNumber (port address)) [10]) 23 echo socket = IO.require (IO.copyStream socket socket) (_ : 24 IO.require (IO.shutdownWrite socket) (_ : IO.pure t)) 25 worker [socket] = echo socket 26 worker _ = IO.fail "Invalid connection handoff" 27 serve 0 _ _ = IO.pure t 28 serve count owner listener = IO.require (IO.acceptTCP listener owner) (socket : 29 IO.require (IO.spawn 0 0 [socket] worker) (_ : serve (N.predecessor count) owner listener)) 30 server address count = IO.io <| IO.scope (owner : do IO.require 31 listener <- IO.listenTCP owner address 128 32 announce listener 33 IO.bind (serve count owner listener) (_ : IO.pure t)) 34 35 -- Child routing is inherited through H.spawnV2, not raw IO.spawn. The banner 36 -- binding lives in source and is deliberately not a native networking service. 37 requireH action next = H.bind (H.liftIO (IO.require action IO.pure)) next 38 banner _ _ = H.pure [66 0 255 10] 39 handledWorker [socket] = H.bind (H.request "banner" "bytes" t) (bytes : 40 requireH (IO.writeAll socket bytes) (_ : H.liftIO (echo socket))) 41 handledWorker _ = H.liftIO (IO.fail "Invalid connection handoff") 42 handledServe _ 0 _ _ = H.pure t 43 handledServe supervised count owner listener = requireH (IO.acceptTCP listener owner) (socket : 44 H.bind (H.spawnV2 supervised 0 [socket] handledWorker) (reply : case reply of 45 ((t t), (_, t)) = handledServe supervised (N.predecessor count) owner listener 46 _ = H.liftIO (IO.fail "Failed connection spawn"))) 47 handledServer address count = handledServerWith 0 address count 48 -- Explicit containment probe: discarded child failures do not stop admission. 49 -- A production service should choose its own logging/outcome-observation policy. 50 supervisedHandledServer address count = handledServerWith 1 address count 51 handledServerWith supervised address count = IO.io <| H.runIOV2 52 (H.handle "banner" banner (H.scopeV2 (owner : 53 requireH (IO.listenTCP owner address 128) (listener : 54 requireH (announce listener) (_ : handledServe supervised count owner listener))))) 55 56 -- Read and write proceed concurrently to avoid duplex backpressure deadlock. 57 -- The source/destination files must differ, including aliases; output truncates. 58 client address source destination = IO.io <| IO.scope (owner : 59 IO.require (IO.connectTCP owner address) (socket : clientStreams owner socket source destination)) 60 namedClient host family port source destination = IO.io <| IO.scope (owner : 61 IO.require (IO.resolveTCP host family port 64) (resolved : case resolved of 62 [addresses _] = IO.require (IO.connectFirstTCP owner addresses) 63 (socket : clientStreams owner socket source destination) 64 _ = IO.fail "Invalid resolver reply")) 65 resolve host family port limit = IO.io (IO.resolveTCP host family port limit) 66 candidates addresses = IO.io <| IO.scope (owner : IO.connectFirstTCP owner addresses) 67 clientStreams owner socket source destination = do IO.require 68 input <- IO.openReader owner source 69 output <- IO.openWriter owner destination 70 IO.spawn 0 0 [] (_ : IO.require (IO.copyStream input socket) (_ : 71 IO.require (IO.shutdownWrite socket) (_ : IO.pure t))) 72 IO.require (IO.copyStream socket output) (_ : IO.pure t) 73 connectResult address = IO.io <| IO.scope (owner : IO.connectTCP owner address) 74 invalidAddress = connectResult ["ipv4" [127 0 0 256] 80]