
   0 | module Node.Net.Socket
   1 | 
   2 | import Node
   3 | import public Node.Error
   4 | import Node.Event.Internal
   5 | import Node.Internal.Elab
   6 | import Node.Internal.Support
   7 | import public Node.Net.Socket.Address
   8 | import public Node.Net.Socket.Connect
   9 | import public Node.Net.Socket.Type
  10 | import public Node.Stream
  11 | 
  12 | %language ElabReflection
  13 | 
  14 | %foreign "node:lambda: (tys, s, cb) => s.on('close', (b) => cb(b ? _true() : _false())())"
  15 | ffi_onClose : s -> (Bool -> PrimIO ()) -> PrimIO ()
  16 | 
  17 | export
  18 | socketOnClose : HasIO io => s -> (Bool -> IO ()) -> io ()
  19 | socketOnClose s cb = primIO $ ffi_onClose s $ \b => toPrim $ cb b
  20 | 
  21 | %foreign nodeOn0 "connect"
  22 | ffi_onConnect : s -> PrimIO () -> PrimIO ()
  23 | 
  24 | export
  25 | socketOnConnect : HasIO io => s -> IO () -> io ()
  26 | socketOnConnect = on0 ffi_onConnect
  27 | 
  28 | %foreign nodeOn1 "error"
  29 | ffi_onError : s -> (e -> PrimIO ()) -> PrimIO ()
  30 | 
  31 | export
  32 | socketOnError : HasIO io => s -> (Error -> IO ()) -> io ()
  33 | socketOnError = on1 ffi_onError
  34 | 
  35 | %foreign """
  36 |   node:lambda:
  37 |   ( tys
  38 |   , s
  39 |   , cb) => s.on(
  40 |     'lookup',
  41 |     (err, addr, family, host) =>
  42 |       cb(err ? _just(err) : _nothing()
  43 |         , addr
  44 |         , family ? _just(family) : _nothing()
  45 |         , host)()
  46 |   )
  47 |   """
  48 | ffi_onLookup : s -> (Maybe Error -> (address : String) -> (family : Maybe String) -> (host : String) -> PrimIO ()) -> PrimIO ()
  49 | 
  50 | export
  51 | socketOnLookup : HasIO io => s -> (Maybe Error -> (address : String) -> (family : Maybe String) -> (host : String) -> IO ()) -> io ()
  52 | socketOnLookup s cb = primIO $ ffi_onLookup s $ \err, addr, family, host => toPrim $ cb err addr family host
  53 | 
  54 | %foreign nodeOn0 "ready"
  55 | ffi_onReady : s -> PrimIO () -> PrimIO ()
  56 | 
  57 | export
  58 | socketOnReady : HasIO io => s -> IO () -> io ()
  59 | socketOnReady = on0 ffi_onReady
  60 | 
  61 | %foreign nodeOn0 "timeout"
  62 | ffi_onTimeout : s -> PrimIO () -> PrimIO ()
  63 | 
  64 | export
  65 | socketOnTimeout : HasIO io => s -> IO () -> io ()
  66 | socketOnTimeout = on0 ffi_onTimeout
  67 | 
  68 | %foreign """
  69 |   node:lambda:
  70 |   (tys, s) => {
  71 |     const a = s.address()
  72 |     if (a === undefined || a.port === undefined || a.family === undefined || a.address === undefined) {
  73 |       return _nothing()
  74 |     }
  75 |     return _just(a)
  76 |   }
  77 |   """
  78 | ffi_address : s -> PrimIO $ Maybe $ Node Address
  79 | 
  80 | export
  81 | socketAddress : HasIO io => s -> io $ Maybe Address
  82 | socketAddress s = map fromNode <$> primIO (ffi_address s)
  83 | 
  84 | %runElab mkNodeFieldIO (basic "socketBytesRead") "bytesRead" `(Int)
  85 | %runElab mkNodeFieldIO (basic "socketBytesWritten") "bytesWritten" `(Int)
  86 | 
  87 | %foreign "node:lambda: (tys, s, opts) => s.connect(opts)"
  88 | ffi_connect : s -> AnyPtr -> PrimIO s
  89 | 
  90 | export
  91 | socketConnect : HasIO io => s -> {auto t : SocketType} -> Connect.options t -> io s
  92 | socketConnect s {t} opts = primIO $ ffi_connect s $ believe_me $ convertOptions t opts
  93 | 
  94 | %runElab mkNodeFieldIO (basic "socketConnecting") "connecting" `(Bool)
  95 | 
  96 | %foreign """
  97 |   node:lambda:
  98 |   (tys, s, e) => {
  99 |     const err = _maybe(e)
 100 |     return err ? s.destroy(err) : s.destroy()
 101 |   }
 102 |   """
 103 | ffi_destroy : s -> Maybe Error -> PrimIO s
 104 | 
 105 | export
 106 | socketDestroy : HasIO io => s -> Maybe Error -> io s
 107 | socketDestroy s e = primIO $ ffi_destroy s e
 108 | 
 109 | %runElab mkNodeFieldIO (basic "socketDestroyed") "destroyed" `(Bool)
 110 | %runElab mkNodeFieldIO (basic "socketLocalAddress") "localAddress" `(Maybe String)
 111 | %runElab mkNodeFieldIO (basic "socketLocalPort") "localPort" `(Maybe Int)
 112 | %runElab mkNodeFieldIO (basic "socketPending") "pending" `(Bool)
 113 | 
 114 | %foreign "node:lambda: (tys, s) => s.ref()"
 115 | ffi_ref : s -> PrimIO s
 116 | 
 117 | export
 118 | socketRef : HasIO io => s -> io s
 119 | socketRef s = primIO $ ffi_ref s
 120 | 
 121 | %runElab mkNodeFieldIO (basic "socketRemoteAddress") "remoteAddress" `(Maybe String)
 122 | %runElab mkNodeFieldIO (basic "socketRemoteFamily") "remoteFamily" `(Maybe String)
 123 | %runElab mkNodeFieldIO (basic "socketRemotePort") "remotePort" `(Maybe Int)
 124 | 
 125 | %foreign "node:lambda: (tys, s) => s.resetAndDestroy()"
 126 | ffi_resetAndDestroy : s -> PrimIO s
 127 | 
 128 | export
 129 | socketResetAndDestroy : HasIO io => s -> io s
 130 | socketResetAndDestroy s = primIO $ ffi_resetAndDestroy s
 131 | 
 132 | %foreign """
 133 |   node:lambda:
 134 |   (tys, s, initialDelay) => {
 135 |     const d = _maybe(initialDelay)
 136 |     if (d) {
 137 |        return s.setKeepAlive(true, d)
 138 |     }
 139 |     return s.setKeepAlive(false)
 140 |   }
 141 |   """
 142 | ffi_setKeepAlive : s -> Maybe Int -> PrimIO s
 143 | 
 144 | export
 145 | socketSetKeepAlive : HasIO io => s -> Maybe Int -> io s
 146 | socketSetKeepAlive s initialDelay = primIO $ ffi_setKeepAlive s initialDelay
 147 | 
 148 | %foreign "node:lambda: (tys, s, b) => s.setNoDelay(_bool(b))"
 149 | ffi_setNoDelay : s -> Bool -> PrimIO s
 150 | 
 151 | export
 152 | socketSetNoDelay : HasIO io => s -> Bool -> io s
 153 | socketSetNoDelay s b = primIO $ ffi_setNoDelay s b
 154 | 
 155 | %foreign """
 156 |   node:lambda:
 157 |   (tys, s, timeout) => {
 158 |     const t = _maybe(timeout)
 159 |     if (t) {
 160 |       return s.setTimeout(t)
 161 |     }
 162 |     return s.setTimeout(0)
 163 |   }
 164 |   """
 165 | ffi_setTimeout : s -> Maybe Int -> PrimIO s
 166 | 
 167 | export
 168 | socketSetTimeout : HasIO io => s -> Maybe Int -> io s
 169 | socketSetTimeout s timeout = primIO $ ffi_setTimeout s timeout
 170 | 
 171 | %foreign """
 172 |   node:lambda: (tys, s) => {
 173 |     const t = s.timeout
 174 |     if (t === undefined || t === null) {
 175 |       return _nothing()
 176 |     }
 177 |     return _just(t)
 178 |   }
 179 |   """
 180 | ffi_timeout : s -> PrimIO $ Maybe Int
 181 | 
 182 | export
 183 | socketTimeout : HasIO io => s -> io $ Maybe Int
 184 | socketTimeout s = primIO $ ffi_timeout s
 185 | 
 186 | %foreign "node:lambda: (tys, s) => s.unref()"
 187 | ffi_unref : s -> PrimIO s
 188 | 
 189 | export
 190 | socketUnref : HasIO io => s -> io s
 191 | socketUnref s = primIO $ ffi_unref s
 192 | 
 193 | %runElab mkNodeFieldIO (basic "socketReadyState") "readyState" `(String)
 194 | 
 195 | public export
 196 | interface
 197 |   ReadableClass d Error s =>
 198 |   WriteableClass d Error s =>
 199 |   SocketClass (t : SocketType) s | s
 200 |   where
 201 |   -- onClose is different from the onClose in ReadableClass and WriteableClass
 202 |   (.onClose) : HasIO io => s -> (Bool -> IO ()) -> io ()
 203 |   (.onClose) = socketOnClose
 204 |   (.onConnect) : HasIO io => s -> IO () -> io ()
 205 |   (.onConnect) = socketOnConnect
 206 |   -- onData from ReadableClass
 207 |   -- onDrain from WriteableClass
 208 |   -- onEnd  from ReadableClass
 209 |   (.onError) : HasIO io => s -> (Error -> IO ()) -> io ()
 210 |   (.onError) = socketOnError
 211 |   (.onLookup) : HasIO io => s -> (Maybe Error -> (address : String) -> (family : Maybe String) -> (host : String) -> IO ()) -> io ()
 212 |   (.onLookup) = socketOnLookup
 213 |   (.onReady) : HasIO io => s -> IO () -> io ()
 214 |   (.onReady) = socketOnReady
 215 |   (.onTimeout) : HasIO io => s -> IO () -> io ()
 216 |   (.onTimeout) = socketOnTimeout
 217 |   (.address) : HasIO io => s -> io $ Maybe Address
 218 |   (.address) = socketAddress
 219 |   (.bytesRead) : HasIO io => s -> io Int
 220 |   (.bytesRead) = socketBytesRead
 221 |   (.bytesWritten) : HasIO io => s -> io Int
 222 |   (.bytesWritten) = socketBytesWritten
 223 |   (.connect) : HasIO io => s -> Connect.options t -> io s
 224 |   (.connect) s opts = socketConnect s opts { t = t }
 225 |   (.connecting) : HasIO io => s -> io Bool
 226 |   (.connecting) = socketConnecting
 227 |   (.destroy) : HasIO io => s -> Maybe Error -> io s
 228 |   (.destroy) = socketDestroy
 229 |   (.destroyed) : HasIO io => s -> io Bool
 230 |   (.destroyed) = socketDestroyed
 231 |   -- end from WriteableClass
 232 |   (.localAddress) : HasIO io => s -> io $ Maybe String
 233 |   (.localAddress) = socketLocalAddress
 234 |   (.localPort) : HasIO io => s -> io $ Maybe Int
 235 |   (.localPort) = socketLocalPort
 236 |   -- -- pause from ReadableClass
 237 |   (.pending) : HasIO io => s -> io Bool
 238 |   (.pending) = socketPending
 239 |   (.ref) : HasIO io => s -> io s
 240 |   (.ref) = socketRef
 241 |   (.remoteAddress) : HasIO io => s -> io $ Maybe String
 242 |   (.remoteAddress) = socketRemoteAddress
 243 |   (.remoteFamily) : HasIO io => s -> io $ Maybe String
 244 |   (.remoteFamily) = socketRemoteFamily
 245 |   (.remotePort) : HasIO io => s -> io $ Maybe Int
 246 |   (.remotePort) = socketRemotePort
 247 |   (.resetAndDestroy) : HasIO io => s -> io s
 248 |   (.resetAndDestroy) = socketResetAndDestroy
 249 |   -- -- resume from ReadableClass
 250 |   -- -- setEncoding -- skipped, don't switch data type
 251 |   (.setKeepAlive) : HasIO io => s -> Maybe Int -> io s
 252 |   (.setKeepAlive) = socketSetKeepAlive
 253 |   (.setNoDelay) : HasIO io => s -> Bool -> io s
 254 |   (.setNoDelay) = socketSetNoDelay
 255 |   (.setTimeout) : HasIO io => s -> Maybe Int -> io s
 256 |   (.setTimeout) = socketSetTimeout
 257 |   (.timeout) : HasIO io => s -> io $ Maybe Int
 258 |   (.timeout) = socketTimeout
 259 |   (.unref) : HasIO io => s -> io s
 260 |   (.unref) = socketUnref
 261 |   -- -- write from WriteableClass
 262 |   (.readyState) : HasIO io => s -> io String
 263 |   (.readyState) = socketReadyState
 264 | 
 265 | export
 266 | data Socket : (t : SocketType) -> Type where [external]
 267 | 
 268 | export
 269 | implementation ReadableClass d Error (Socket t) where
 270 | 
 271 | export
 272 | implementation WriteableClass d Error (Socket t) where
 273 | 
 274 | export
 275 | implementation SocketClass TCP (Socket TCP) where
 276 | 
 277 | export
 278 | implementation SocketClass IPC (Socket IPC) where
 279 | 
 280 | public export
 281 | record Options where
 282 |   constructor MkOptions
 283 |   fd: Maybe Int
 284 |   allowHalfOpen: Maybe Bool
 285 |   readable: Maybe Bool
 286 |   writeable: Maybe Bool
 287 |   -- TODO: signal
 288 | 
 289 | export
 290 | defaultOptions : Options
 291 | defaultOptions = MkOptions
 292 |   { fd = Nothing
 293 |   , allowHalfOpen = Nothing
 294 |   , readable = Nothing
 295 |   , writeable = Nothing
 296 |   }
 297 | 
 298 | %foreign """
 299 |   node:lambda:
 300 |   ( fd
 301 |   , allowHalfOpen
 302 |   , readable
 303 |   , writeable
 304 |   ) => _keepDefined({
 305 |     fd: _maybe(fd),
 306 |     allowHalfOpen: _maybeBool(_maybe(allowHalfOpen)),
 307 |     readable: _maybeBool(_maybe(readable)),
 308 |     writeable: _maybeBool(_maybe(writeable))
 309 |   })
 310 |   """
 311 | ffi_convertOptions :
 312 |   ( fd : Maybe Int )
 313 |   -> ( allowHalfOpen : Maybe Bool )
 314 |   -> ( readable : Maybe Bool )
 315 |   -> ( writeable : Maybe Bool )
 316 |   -> Node Options
 317 | 
 318 | export
 319 | convertOptions : Options -> Node Options
 320 | convertOptions o = ffi_convertOptions
 321 |   o.fd
 322 |   o.allowHalfOpen
 323 |   o.readable
 324 |   o.writeable
 325 | 
 326 |