Merge pull request #4844 from unisonweb/kylegoetz-udp

Kylegoetz udp

CREDITS.md

@@ -15,7 +15,7 @@ be listed here, please [file a ticket](https://github.com/unisonweb/unison/issue
 
 This file was generated using [unisonweb/credits-generator](http://github.com/unisonweb/credits-generator).
 
-### Listing 
+### Listing
 These are listed in alphabetical order.
 
 | Package name | License  |
@@ -109,6 +109,7 @@ 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

@@ -246,7 +246,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
@@ -815,6 +818,17 @@ 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.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.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),
@@ -1055,6 +1069,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

@@ -356,6 +356,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,23 @@ 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,
+    clientSocket,
+    close,
+    recv,
+    recvFrom,
+    send,
+    sendTo,
+    serverSocket,
+    stop,
+  )
+
 import Network.TLS.Extra.Cipher as Cipher
 import System.Clock (Clock (..), getTime, nsec, sec)
 import System.Directory as SYS
@@ -1544,6 +1559,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 +1798,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 +1897,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 +2337,64 @@ 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" boxBoxToEF0
+    . mkForeignIOF
+    $ \(sock :: UDPSocket, bytes :: Bytes.Bytes) ->
+      UDP.send sock (Bytes.toArray bytes)
+
+  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
+
 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

scheme-libs/racket/unison-runtime.rkt

@@ -30,6 +30,7 @@
   unison/data-info
   unison/chunked-seq
   unison/primops
+  unison/builtin
   unison/primops-generated
   unison/builtin-generated)
 

scheme-libs/racket/unison/boot.ss

@@ -47,6 +47,10 @@
   builtin-tls.signedcert:typelink
   builtin-tls.version:typelink
 
+  builtin-udpsocket:typelink
+  builtin-listensocket:typelink
+  builtin-clientsockaddr:typelink
+
   bytevector
   bytes
   control

scheme-libs/racket/unison/builtin.rkt

@@ -0,0 +1,4 @@
+#lang racket/base
+(require unison/udp)
+
+(provide (all-from-out))

scheme-libs/racket/unison/data.ss

@@ -80,6 +80,9 @@
   builtin-timespec:typelink
   builtin-threadid:typelink
   builtin-value:typelink
+  builtin-udpsocket:typelink
+  builtin-listensocket:typelink
+  builtin-clientsockaddr:typelink
 
   builtin-crypto.hashalgorithm:typelink
   builtin-char.class:typelink
@@ -440,6 +443,9 @@
 (define builtin-timespec:typelink (unison-typelink-builtin "TimeSpec"))
 (define builtin-threadid:typelink (unison-typelink-builtin "ThreadId"))
 (define builtin-value:typelink (unison-typelink-builtin "Value"))
+(define builtin-udpsocket:typelink (unison-typelink-builtin "UDPSocket"))
+(define builtin-listensocket:typelink (unison-typelink-builtin "ListenSocket"))
+(define builtin-clientsockaddr:typelink (unison-typelink-builtin "ClientSockAddr"))
 
 (define builtin-crypto.hashalgorithm:typelink
   (unison-typelink-builtin "crypto.HashAlgorithm"))