Kylegoetz udp

CREDITS.md

@@ -109,6 +109,9 @@ These are listed in alphabetical order.
 | [network-bsd-2.8.1.0](https://hackage.haskell.org/package/network-bsd-2.8.1.0) | [BSD3](https://hackage.haskell.org/package/network-bsd-2.8.1.0/src/LICENSE) |
 | [network-info-0.2.0.10](https://hackage.haskell.org/package/network-info-0.2.0.10) | [BSD3](https://hackage.haskell.org/package/network-info-0.2.0.10/src/LICENSE) |
 | [network-simple-0.4.5](https://hackage.haskell.org/package/network-simple-0.4.5) | [BSD3](https://hackage.haskell.org/package/network-simple-0.4.5/src/LICENSE) |
+
+| [network-udp-0.0.0](https://hackage.haskell.org/package/network-udp-0.0.0) | [BSD3](https://hackage.haskell.org/package/network-udp-0.0.0/src/LICENSE) |
+
 | [nonempty-containers-0.3.3.0](https://hackage.haskell.org/package/nonempty-containers-0.3.3.0) | [BSD3](https://hackage.haskell.org/package/nonempty-containers-0.3.3.0/src/LICENSE) |
 | [nonempty-vector-0.2.0.2](https://hackage.haskell.org/package/nonempty-vector-0.2.0.2) | [BSD3](https://hackage.haskell.org/package/nonempty-vector-0.2.0.2/src/LICENSE) |
 | [parallel-3.2.2.0](https://hackage.haskell.org/package/parallel-3.2.2.0) | [BSD3](https://hackage.haskell.org/package/parallel-3.2.2.0/src/LICENSE) |

parser-typechecker/package.yaml

@@ -60,6 +60,7 @@ dependencies:
   - http-media
   - http-types
   - IntervalMap
+  - iproute
   - lens
   - lucid
   - megaparsec
@@ -73,6 +74,7 @@ dependencies:
   - natural-transformation
   - network
   - network-simple
+  - network-udp
   - network-uri
   - nonempty-containers
   - open-browser

parser-typechecker/src/Unison/Builtin.hs

@@ -245,7 +245,10 @@ builtinTypesSrc =
     B' "MutableArray" CT.Data,
     B' "ImmutableByteArray" CT.Data,
     B' "MutableByteArray" CT.Data,
-    B' "Char.Class" CT.Data
+    B' "Char.Class" CT.Data,
+    B' "UDPSocket" CT.Data,
+    B' "ListenSocket" CT.Data,
+    B' "ClientSockAddr" CT.Data
   ]
 
 -- rename these to "builtin" later, when builtin means intrinsic as opposed to
@@ -810,6 +813,19 @@ ioBuiltins =
     ("IO.serverSocket.impl.v3", optionalt text --> text --> iof socket),
     ("IO.listen.impl.v3", socket --> iof unit),
     ("IO.clientSocket.impl.v3", text --> text --> iof socket),
+    ("IO.UDP.clientSocket.impl.v1", text --> text --> iof udpSocket),
+    ("IO.UDP.ClientSockAddr.toText.v1", udpClientSockAddr --> text),
+    ("IO.UDP.UDPSocket.toText.impl.v1", udpSocket --> text),
+    ("IO.UDP.UDPSocket.close.impl.v1", udpSocket --> iof unit),
+    ("IO.UDP.UDPSocket.socket.impl.v1", udpSocket --> socket),
+    ("IO.UDP.serverSocket.impl.v1", text --> text --> iof udpListenSocket),
+    ("IO.UDP.ListenSocket.recvFrom.impl.v1", udpListenSocket --> iof (tuple [bytes, udpClientSockAddr])),
+    ("IO.UDP.ListenSocket.sendTo.impl.v1", udpListenSocket --> bytes --> udpClientSockAddr --> iof unit),
+    ("IO.UDP.ListenSocket.toText.impl.v1", udpListenSocket --> text),
+    ("IO.UDP.ListenSocket.close.impl.v1", udpListenSocket --> iof unit),
+    ("IO.UDP.ListenSocket.socket.impl.v1", udpListenSocket --> socket),
+    ("IO.UDP.UDPSocket.recv.impl.v1", udpSocket --> iof bytes),
+    ("IO.UDP.UDPSocket.send.impl.v1", udpSocket --> bytes --> iof unit),
     ("IO.closeSocket.impl.v3", socket --> iof unit),
     ("IO.socketPort.impl.v3", socket --> iof nat),
     ("IO.socketAccept.impl.v3", socket --> iof socket),
@@ -1050,6 +1066,12 @@ handle = Type.fileHandle ()
 phandle = Type.processHandle ()
 unit = DD.unitType ()
 
+
+udpSocket, udpListenSocket, udpClientSockAddr :: Type
+udpSocket = Type.udpSocket ()
+udpListenSocket = Type.udpListenSocket ()
+udpClientSockAddr = Type.udpClientSockAddr ()
+
 tls, tlsClientConfig, tlsServerConfig, tlsSignedCert, tlsPrivateKey, tlsVersion, tlsCipher :: Type
 tls = Type.ref () Type.tlsRef
 tlsClientConfig = Type.ref () Type.tlsClientConfigRef

parser-typechecker/src/Unison/KindInference/Generate.hs

@@ -368,6 +368,9 @@ builtinConstraintTree =
           flip Type.ref Type.filePathRef,
           Type.threadId,
           Type.socket,
+          Type.udpSocket,
+          Type.udpListenSocket,
+          Type.udpClientSockAddr,
           Type.processHandle,
           Type.ibytearrayType,
           flip Type.ref Type.charClassRef,

parser-typechecker/src/Unison/Runtime/Builtin.hs

@@ -52,6 +52,7 @@ import Data.IORef as SYS
     readIORef,
     writeIORef,
   )
+import Data.IP (IP)
 import Data.Map qualified as Map
 import Data.PEM (PEM, pemContent, pemParseLBS)
 import Data.Set (insert)
@@ -81,9 +82,24 @@ import Network.Simple.TCP as SYS
 import Network.Socket as SYS
   ( Socket,
     accept,
-    socketPort,
+    socketPort, PortNumber,
   )
 import Network.TLS as TLS
+import Network.UDP as UDP
+  ( UDPSocket (..),
+    ClientSockAddr,
+    ListenSocket (listenSocket),
+    clientSocket,
+    close,
+    recv,
+    recvFrom,
+    send,
+    sendTo,
+    serverSocket,
+    stop,
+    udpSocket,
+  )
+
 import Network.TLS.Extra.Cipher as Cipher
 import System.Clock (Clock (..), getTime, nsec, sec)
 import System.Directory as SYS
@@ -1544,6 +1560,22 @@ outIoFailBool stack1 stack2 stack3 extra fail result =
         )
       ]
 
+outIoFailTup :: forall v . (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
+outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result =
+  TMatch result . MatchSum $
+    mapFromList
+      [ failureCase stack1 stack2 stack3 extra fail,
+        ( 1,
+          ([BX, BX],
+            TAbss [stack1, stack2]
+              . TLetD stack3 BX (TCon Ty.unitRef 0 [])
+              . TLetD stack4 BX (TCon Ty.pairRef 0 [stack2, stack3])
+              . TLetD stack5 BX (TCon Ty.pairRef 0 [stack1, stack4])
+              $ right stack5
+          )
+        )
+      ] 
+
 outIoFailG ::
   (Var v) =>
   v ->
@@ -1767,6 +1799,14 @@ boxToEFBox =
   where
     (arg, result, stack1, stack2, stack3, any, fail) = fresh
 
+-- a -> Either Failure (b, c)
+boxToEFTup :: ForeignOp
+boxToEFTup =
+  inBx arg result $
+    outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result
+  where
+    (arg, result, stack1, stack2, stack3, stack4, stack5, extra, fail) = fresh
+
 -- a -> Either Failure (Maybe b)
 boxToEFMBox :: ForeignOp
 boxToEFMBox =
@@ -1858,6 +1898,14 @@ boxBoxToEF0 =
   where
     (arg1, arg2, result, stack1, stack2, stack3, fail, unit) = fresh
 
+-- a -> b -> c -> Either Failure ()
+boxBoxBoxToEF0 :: ForeignOp
+boxBoxBoxToEF0 =
+  inBxBxBx arg1 arg2 arg3 result $
+    outIoFailUnit stack1 stack2 stack3 fail unit result
+  where
+    (arg1, arg2, arg3, result, stack1, stack2, stack3, fail, unit) = fresh
+
 -- a -> Either Failure Nat
 boxToEFNat :: ForeignOp
 boxToEFNat =
@@ -2290,8 +2338,77 @@ mkForeignTlsE f = mkForeign $ \a -> fmap flatten (tryIO2 (tryIO1 (f a)))
     flatten (Right (Right (Left e))) = Left e
     flatten (Right (Right (Right a))) = Right a
 
+declareUdpForeigns :: FDecl Symbol ()
+declareUdpForeigns = do
+  declareForeign Tracked "IO.UDP.clientSocket.impl.v1" boxBoxToEFBox
+    . mkForeignIOF
+    $ \(host :: Util.Text.Text, port :: Util.Text.Text) ->
+      let hostStr = Util.Text.toString host
+          portStr = Util.Text.toString port
+      in UDP.clientSocket hostStr portStr True
+
+  declareForeign Tracked "IO.UDP.UDPSocket.recv.impl.v1" boxToEFBox
+    . mkForeignIOF
+    $ \(sock :: UDPSocket) -> Bytes.fromArray <$> UDP.recv sock
+
+  -- declareForeign Tracked "IO.UDP.UDPSocket.send.impl.v1" boxBoxToExn0
+    -- . mkForeign $ fmap .uncurry UDP.send
+
+  declareForeign Tracked "IO.UDP.UDPSocket.send.impl.v1" boxBoxToEF0
+    . mkForeignIOF
+    $ \(sock :: UDPSocket, bytes :: Bytes.Bytes) ->
+      UDP.send sock (Bytes.toArray bytes)
+
+  declareForeign Tracked "IO.UDP.UDPSocket.socket.impl.v1" boxToEFBox
+    . mkForeignIOF 
+    $ \(socket:: UDPSocket) -> pure $ udpSocket socket
+
+  declareForeign Tracked "IO.UDP.UDPSocket.socket.impl.v1" boxDirect
+    . mkForeign $ pure . udpSocket
+
+  declareForeign Tracked "IO.UDP.UDPSocket.close.impl.v1" boxToEF0
+    . mkForeignIOF
+    $ \(sock :: UDPSocket) -> UDP.close sock
+
+  declareForeign Tracked "IO.UDP.ListenSocket.close.impl.v1" boxToEF0
+    . mkForeignIOF
+    $ \(sock :: ListenSocket) -> UDP.stop sock
+
+  declareForeign Tracked "IO.UDP.UDPSocket.toText.impl.v1" boxDirect
+    . mkForeign
+    $ \(sock :: UDPSocket) -> pure $ show sock
+
+  declareForeign Tracked "IO.UDP.serverSocket.impl.v1" boxBoxToEFBox
+    . mkForeignIOF
+    $ \(ip :: Util.Text.Text, port :: Util.Text.Text) ->
+      let maybeIp = readMaybe $ Util.Text.toString ip :: Maybe IP
+          maybePort = readMaybe $ Util.Text.toString port :: Maybe PortNumber
+      in case (maybeIp, maybePort) of
+        (Nothing, _) -> fail "Invalid IP Address"
+        (_, Nothing) -> fail "Invalid Port Number"
+        (Just ip, Just pt) -> UDP.serverSocket (ip, pt)
+
+  declareForeign Tracked "IO.UDP.ListenSocket.toText.impl.v1" boxDirect
+    . mkForeign
+    $ \(sock :: ListenSocket) -> pure $ show sock
+
+  declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" boxToEFTup .
+    mkForeignIOF $ fmap (first Bytes.fromArray) <$> UDP.recvFrom
+
+  declareForeign Tracked "IO.UDP.ClientSockAddr.toText.v1" boxDirect
+    . mkForeign
+    $ \(sock :: ClientSockAddr) -> pure $ show sock
+
+  declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" boxBoxBoxToEF0 .
+    mkForeignIOF $ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) ->
+        UDP.sendTo socket (Bytes.toArray bytes) addr
+
+  declareForeign Tracked "IO.UDP.ListenSocket.socket.impl.v1" boxDirect
+    . mkForeign $ pure . listenSocket
+
 declareForeigns :: FDecl Symbol ()
 declareForeigns = do
+  declareUdpForeigns
   declareForeign Tracked "IO.openFile.impl.v3" boxIomrToEFBox $
     mkForeignIOF $ \(fnameText :: Util.Text.Text, n :: Int) ->
       let fname = Util.Text.toString fnameText

parser-typechecker/src/Unison/Runtime/Foreign.hs

@@ -27,6 +27,7 @@ import Data.Primitive (ByteArray, MutableArray, MutableByteArray)
 import Data.Tagged (Tagged (..))
 import Data.X509 qualified as X509
 import Network.Socket (Socket)
+import Network.UDP (ListenSocket, UDPSocket, ClientSockAddr)
 import Network.TLS qualified as TLS (ClientParams, Context, ServerParams)
 import System.Clock (TimeSpec)
 import System.IO (Handle)
@@ -81,6 +82,10 @@ socketEq :: Socket -> Socket -> Bool
 socketEq l r = l == r
 {-# NOINLINE socketEq #-}
 
+udpSocketEq :: UDPSocket -> UDPSocket -> Bool
+udpSocketEq l r = l == r
+{-# NOINLINE udpSocketEq #-}
+
 refEq :: IORef () -> IORef () -> Bool
 refEq l r = l == r
 {-# NOINLINE refEq #-}
@@ -157,6 +162,7 @@ ref2eq r
   -- Ditto
   | r == Ty.tvarRef = Just $ promote tvarEq
   | r == Ty.socketRef = Just $ promote socketEq
+  | r == Ty.udpSocketRef = Just $ promote udpSocketEq
   | r == Ty.refRef = Just $ promote refEq
   | r == Ty.threadIdRef = Just $ promote tidEq
   | r == Ty.marrayRef = Just $ promote marrEq
@@ -230,6 +236,12 @@ instance BuiltinForeign Referent where foreignRef = Tagged Ty.termLinkRef
 
 instance BuiltinForeign Socket where foreignRef = Tagged Ty.socketRef
 
+instance BuiltinForeign ListenSocket where foreignRef = Tagged Ty.udpListenSocketRef
+
+instance BuiltinForeign ClientSockAddr where foreignRef = Tagged Ty.udpClientSockAddrRef
+
+instance BuiltinForeign UDPSocket where foreignRef = Tagged Ty.udpSocketRef
+
 instance BuiltinForeign ThreadId where foreignRef = Tagged Ty.threadIdRef
 
 instance BuiltinForeign TLS.ClientParams where foreignRef = Tagged Ty.tlsClientConfigRef

parser-typechecker/src/Unison/Runtime/Foreign/Function.hs

@@ -26,6 +26,7 @@ import Data.Time.Clock.POSIX (POSIXTime)
 import Data.Word (Word16, Word32, Word64, Word8)
 import GHC.IO.Exception (IOErrorType (..), IOException (..))
 import Network.Socket (Socket)
+import Network.UDP (UDPSocket)
 import System.IO (BufferMode (..), Handle, IOMode, SeekMode)
 import Unison.Builtin.Decls qualified as Ty
 import Unison.Reference (Reference)
@@ -139,6 +140,10 @@ instance ForeignConvention Socket where
   readForeign = readForeignBuiltin
   writeForeign = writeForeignBuiltin
 
+instance ForeignConvention UDPSocket where
+  readForeign = readForeignBuiltin
+  writeForeign = writeForeignBuiltin
+
 instance ForeignConvention ThreadId where
   readForeign = readForeignBuiltin
   writeForeign = writeForeignBuiltin

parser-typechecker/unison-parser-typechecker.cabal

@@ -268,6 +268,7 @@ library
     , http-client
     , http-media
     , http-types
+    , iproute
     , lens
     , lucid
     , megaparsec
@@ -281,6 +282,7 @@ library
     , natural-transformation
     , network
     , network-simple
+    , network-udp
     , network-uri
     , nonempty-containers
     , open-browser
@@ -462,6 +464,7 @@ test-suite parser-typechecker-tests
     , http-client
     , http-media
     , http-types
+    , iproute
     , lens
     , lucid
     , megaparsec
@@ -475,6 +478,7 @@ test-suite parser-typechecker-tests
     , natural-transformation
     , network
     , network-simple
+    , network-udp
     , network-uri
     , nonempty-containers
     , open-browser

stack.yaml

@@ -63,6 +63,7 @@ extra-deps:
 - lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550
 - lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421
 - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071
+- network-udp-0.0.0
 
 ghc-options:
  # All packages

stack.yaml.lock

@@ -82,6 +82,13 @@ packages:
       size: 1060
   original:
     hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071
+- completed:
+    hackage: network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075
+    pantry-tree:
+      sha256: ee19a66c9d420861c5cc1dfad3210e2a53cdc6088ff3dd90b44f7961f5caebee
+      size: 284
+  original:
+    hackage: network-udp-0.0.0
 snapshots:
 - completed:
     sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2

unison-cli/package.yaml

@@ -49,6 +49,7 @@ dependencies:
   - mtl
   - network-uri
   - network-simple
+  - network-udp
   - network
   - co-log-core
   - uri-encode