unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-11-15 04:11:34 +03:00
Code Issues Projects Releases Wiki Activity

refactoring new-runtime-transcripts

Browse Source 
This adds a _base transcript which will be run as a prelude before the
other transcripts (not sure how yet). The goal is to cut down on the
boilerplate which has been creeping into the tests.

We also rename a few more of the builtin IO functions which return
Either Failure a
This commit is contained in:
Stew O'Connor 2021-02-23 23:56:04 -08:00
parent 2f01c8ca37
commit 7a2a8fb28b
24 changed files with 1029 additions and 1643 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
parser-typechecker/src/Unison/Builtin.hs
View File

@ -517,7 +517,7 @@ ioBuiltins =
, ("IO.putBytes.impl.v3", handle --> bytes --> iof unit) , ("IO.putBytes.impl.v3", handle --> bytes --> iof unit)
, ("IO.systemTime.impl.v3", unit --> iof nat) , ("IO.systemTime.impl.v3", unit --> iof nat)
, ("IO.getTempDirectory.impl.v3", unit --> iof text) , ("IO.getTempDirectory.impl.v3", unit --> iof text)
, ("IO.createTempDirectory", text --> iof text) , ("IO.createTempDirectory.impl.v3", text --> iof text)
, ("IO.getCurrentDirectory.impl.v3", unit --> iof text) , ("IO.getCurrentDirectory.impl.v3", unit --> iof text)
, ("IO.setCurrentDirectory.impl.v3", text --> iof unit) , ("IO.setCurrentDirectory.impl.v3", text --> iof unit)
, ("IO.fileExists.impl.v3", text --> iof boolean) , ("IO.fileExists.impl.v3", text --> iof boolean)
@ -533,7 +533,7 @@ ioBuiltins =
, ("IO.listen.impl.v3", socket --> iof unit) , ("IO.listen.impl.v3", socket --> iof unit)
, ("IO.clientSocket.impl.v3", text --> text --> iof socket) , ("IO.clientSocket.impl.v3", text --> text --> iof socket)
, ("IO.closeSocket.impl.v3", socket --> iof unit) , ("IO.closeSocket.impl.v3", socket --> iof unit)
, ("IO.socketPort", socket --> iof nat) , ("IO.socketPort.impl.v3", socket --> iof nat)
, ("IO.socketAccept.impl.v3", socket --> iof socket) , ("IO.socketAccept.impl.v3", socket --> iof socket)
, ("IO.socketSend.impl.v3", socket --> bytes --> iof unit) , ("IO.socketSend.impl.v3", socket --> bytes --> iof unit)
, ("IO.socketReceive.impl.v3", socket --> nat --> iof bytes) , ("IO.socketReceive.impl.v3", socket --> nat --> iof bytes)
@ -542,16 +542,16 @@ ioBuiltins =
, ("IO.delay.impl.v3", nat --> iof unit) , ("IO.delay.impl.v3", nat --> iof unit)
, ("IO.kill.impl.v3", threadId --> iof unit) , ("IO.kill.impl.v3", threadId --> iof unit)
, ("Tls.newClient", tlsClientConfig --> socket --> iof tls) , ("Tls.newClient.impl.v3", tlsClientConfig --> socket --> iof tls)
, ("Tls.newServer", tlsServerConfig --> socket --> iof tls) , ("Tls.newServer.impl.v3", tlsServerConfig --> socket --> iof tls)
, ("Tls.handshake", tls --> iof unit) , ("Tls.handshake.impl.v3", tls --> iof unit)
, ("Tls.send", tls --> bytes --> iof unit) , ("Tls.send.impl.v3", tls --> bytes --> iof unit)
, ("Tls.decodeCert", bytes --> eithert failure tlsSignedCert) , ("Tls.decodeCert.impl.v3", bytes --> eithert failure tlsSignedCert)
, ("Tls.encodeCert", tlsSignedCert --> bytes) , ("Tls.encodeCert", tlsSignedCert --> bytes)
, ("Tls.decodePrivateKey", bytes --> list tlsPrivateKey) , ("Tls.decodePrivateKey", bytes --> list tlsPrivateKey)
, ("Tls.encodePrivateKey", tlsPrivateKey --> bytes) , ("Tls.encodePrivateKey", tlsPrivateKey --> bytes)
, ("Tls.receive", tls --> iof bytes) , ("Tls.receive.impl.v3", tls --> iof bytes)
, ("Tls.terminate", tls --> iof unit) , ("Tls.terminate.impl.v3", tls --> iof unit)
, ("Tls.ClientConfig.default", text --> bytes --> tlsClientConfig) , ("Tls.ClientConfig.default", text --> bytes --> tlsClientConfig)
, ("Tls.ServerConfig.default", list tlsSignedCert --> tlsPrivateKey --> tlsServerConfig) , ("Tls.ServerConfig.default", list tlsSignedCert --> tlsPrivateKey --> tlsServerConfig)
, ("TLS.ClientConfig.ciphers.set", list tlsCipher --> tlsClientConfig --> tlsClientConfig) , ("TLS.ClientConfig.ciphers.set", list tlsCipher --> tlsClientConfig --> tlsClientConfig)
@ -570,11 +570,11 @@ mvarBuiltins =
, ("MVar.take.impl.v3", forall1 "a" $ \a -> mvar a --> iof a) , ("MVar.take.impl.v3", forall1 "a" $ \a -> mvar a --> iof a)
, ("MVar.tryTake", forall1 "a" $ \a -> mvar a --> io (optionalt a)) , ("MVar.tryTake", forall1 "a" $ \a -> mvar a --> io (optionalt a))
, ("MVar.put.impl.v3", forall1 "a" $ \a -> mvar a --> a --> iof unit) , ("MVar.put.impl.v3", forall1 "a" $ \a -> mvar a --> a --> iof unit)
, ("MVar.tryPut", forall1 "a" $ \a -> mvar a --> a --> io boolean) , ("MVar.tryPut.impl.v3", forall1 "a" $ \a -> mvar a --> a --> iof boolean)
, ("MVar.swap.impl.v3", forall1 "a" $ \a -> mvar a --> a --> iof a) , ("MVar.swap.impl.v3", forall1 "a" $ \a -> mvar a --> a --> iof a)
, ("MVar.isEmpty", forall1 "a" $ \a -> mvar a --> io boolean) , ("MVar.isEmpty", forall1 "a" $ \a -> mvar a --> io boolean)
, ("MVar.read.impl.v3", forall1 "a" $ \a -> mvar a --> iof a) , ("MVar.read.impl.v3", forall1 "a" $ \a -> mvar a --> iof a)
, ("MVar.tryRead", forall1 "a" $ \a -> mvar a --> io (optionalt a)) , ("MVar.tryRead.impl.v3", forall1 "a" $ \a -> mvar a --> iof (optionalt a))
] ]
where where
mvar :: Type v -> Type v mvar :: Type v -> Type v

24
parser-typechecker/src/Unison/Runtime/Builtin.hs
View File

@ -1358,7 +1358,7 @@ declareForeigns = do
declareForeign "IO.getTempDirectory.impl.v3" unitToEFBox declareForeign "IO.getTempDirectory.impl.v3" unitToEFBox
$ mkForeignIOF $ \() -> getTemporaryDirectory $ mkForeignIOF $ \() -> getTemporaryDirectory
declareForeign "IO.createTempDirectory" boxToEFBox declareForeign "IO.createTempDirectory.impl.v3" boxToEFBox
$ mkForeignIOF $ \prefix -> do $ mkForeignIOF $ \prefix -> do
temp <- getTemporaryDirectory temp <- getTemporaryDirectory
createTempDirectory temp prefix createTempDirectory temp prefix
@ -1402,7 +1402,7 @@ declareForeigns = do
, port) -> , port) ->
fst <$> SYS.bindSock (hostPreference mhst) port fst <$> SYS.bindSock (hostPreference mhst) port
declareForeign "IO.socketPort" boxToEFNat declareForeign "IO.socketPort.impl.v3" boxToEFNat
. mkForeignIOF $ \(handle :: Socket) -> do . mkForeignIOF $ \(handle :: Socket) -> do
n <- SYS.socketPort handle n <- SYS.socketPort handle
return (fromIntegral n :: Word64) return (fromIntegral n :: Word64)
@ -1452,7 +1452,7 @@ declareForeigns = do
declareForeign "MVar.put.impl.v3" boxBoxToEF0 declareForeign "MVar.put.impl.v3" boxBoxToEF0
. mkForeignIOF $ \(mv :: MVar Closure, x) -> putMVar mv x . mkForeignIOF $ \(mv :: MVar Closure, x) -> putMVar mv x
declareForeign "MVar.tryPut" boxBoxToEFBool declareForeign "MVar.tryPut.impl.v3" boxBoxToEFBool
. mkForeign $ \(mv :: MVar Closure, x) -> tryPutMVar mv x . mkForeign $ \(mv :: MVar Closure, x) -> tryPutMVar mv x
declareForeign "MVar.swap.impl.v3" boxBoxToEFBox declareForeign "MVar.swap.impl.v3" boxBoxToEFBox
@ -1464,8 +1464,8 @@ declareForeigns = do
declareForeign "MVar.read.impl.v3" boxBoxToEFBox declareForeign "MVar.read.impl.v3" boxBoxToEFBox
. mkForeignIOF $ \(mv :: MVar Closure) -> readMVar mv . mkForeignIOF $ \(mv :: MVar Closure) -> readMVar mv
declareForeign "MVar.tryRead" boxToMaybeBox declareForeign "MVar.tryRead.impl.v3" boxToEFBox
. mkForeign $ \(mv :: MVar Closure) -> tryReadMVar mv . mkForeignIOF $ \(mv :: MVar Closure) -> tryReadMVar mv
declareForeign "Text.toUtf8" boxDirect . mkForeign declareForeign "Text.toUtf8" boxDirect . mkForeign
$ pure . Bytes.fromArray . encodeUtf8 $ pure . Bytes.fromArray . encodeUtf8
@ -1535,18 +1535,18 @@ declareForeigns = do
declareForeign "Tls.Config.defaultServer" unitDirect . mkForeign $ \() -> do declareForeign "Tls.Config.defaultServer" unitDirect . mkForeign $ \() -> do
pure $ (def :: ServerParams) { TLS.serverSupported = defaultSupported } pure $ (def :: ServerParams) { TLS.serverSupported = defaultSupported }
declareForeign "Tls.newClient" boxBoxToEFBox . mkForeignTls $ declareForeign "Tls.newClient.impl.v3" boxBoxToEFBox . mkForeignTls $
\(config :: TLS.ClientParams, \(config :: TLS.ClientParams,
socket :: SYS.Socket) -> TLS.contextNew socket config socket :: SYS.Socket) -> TLS.contextNew socket config
declareForeign "Tls.newServer" boxBoxToEFBox . mkForeignTls $ declareForeign "Tls.newServer.impl.v3" boxBoxToEFBox . mkForeignTls $
\(config :: TLS.ServerParams, \(config :: TLS.ServerParams,
socket :: SYS.Socket) -> TLS.contextNew socket config socket :: SYS.Socket) -> TLS.contextNew socket config
declareForeign "Tls.handshake" boxToEFBox . mkForeignTls $ declareForeign "Tls.handshake.impl.v3" boxToEFBox . mkForeignTls $
\(tls :: TLS.Context) -> TLS.handshake tls \(tls :: TLS.Context) -> TLS.handshake tls
declareForeign "Tls.send" boxBoxToEFBox . mkForeignTls $ declareForeign "Tls.send.impl.v3" boxBoxToEFBox . mkForeignTls $
\(tls :: TLS.Context, \(tls :: TLS.Context,
bytes :: Bytes.Bytes) -> TLS.sendData tls (Bytes.toLazyByteString bytes) bytes :: Bytes.Bytes) -> TLS.sendData tls (Bytes.toLazyByteString bytes)
@ -1556,7 +1556,7 @@ declareForeigns = do
asCert :: PEM -> Either String X.SignedCertificate asCert :: PEM -> Either String X.SignedCertificate
asCert pem = X.decodeSignedCertificate $ pemContent pem asCert pem = X.decodeSignedCertificate $ pemContent pem
in in
declareForeign "Tls.decodeCert" boxToEFBox . mkForeign $ declareForeign "Tls.decodeCert.impl.v3" boxToEFBox . mkForeign $
\(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes \(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes
declareForeign "Tls.encodeCert" boxDirect . mkForeign $ declareForeign "Tls.encodeCert" boxDirect . mkForeign $
@ -1568,12 +1568,12 @@ declareForeigns = do
declareForeign "Tls.encodePrivateKey" boxDirect . mkForeign $ declareForeign "Tls.encodePrivateKey" boxDirect . mkForeign $
\(privateKey :: X.PrivKey) -> pure $ pack $ show privateKey \(privateKey :: X.PrivKey) -> pure $ pack $ show privateKey
declareForeign "Tls.receive" boxToEFBox . mkForeignTls $ declareForeign "Tls.receive.impl.v3" boxToEFBox . mkForeignTls $
\(tls :: TLS.Context) -> do \(tls :: TLS.Context) -> do
bs <- TLS.recvData tls bs <- TLS.recvData tls
pure $ Bytes.fromArray bs pure $ Bytes.fromArray bs
declareForeign "Tls.terminate" boxToEFBox . mkForeignTls $ declareForeign "Tls.terminate.impl.v3" boxToEFBox . mkForeignTls $
\(tls :: TLS.Context) -> TLS.bye tls \(tls :: TLS.Context) -> TLS.bye tls
declareForeign "Code.dependencies" boxDirect declareForeign "Code.dependencies" boxDirect

267
unison-src/new-runtime-transcripts/_base.md Normal file
View File

@ -0,0 +1,267 @@
# Base transcript
## Overview
This transcript is meant to be a transcript which can be run as a
prelude to other transcripts, creating helper functions, and including
a minimal subset of base in order to facilitate write nicer
transcripts which contain less boilerplate.
## Usage
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
```
```unison:hide
a |> f = f a
compose f g = a -> f (g a)
compose2 f g = a -> b -> f (g a b)
compose3 f g = a -> b -> c -> f (g a b c)
id a = a
ability Exception where
raise: io2.Failure -> anything
Exception.reraise : Either Failure a ->{Exception} a
Exception.reraise = cases
Left e -> Exception.raise e
Right a -> a
Exception.toEither.handler : Request {Exception} a -> Either Failure a
Exception.toEither.handler = cases
{ a } -> Right a
{Exception.raise f -> _} -> Left f
Exception.toEither : '{ε, Exception} a -> {ε} Either Failure a
Exception.toEither a = handle !a with Exception.toEither.handler
ability Throw e where
throw : e -> a
List.all : (a ->{ε} Boolean) -> [a] ->{ε} Boolean
List.all f = cases
[] -> true
h +: t -> f h && all f t
List.map : (a ->{m} b) -> [a] ->{m} [b]
List.map f xs =
go acc = cases
[] -> acc
h +: t -> go (acc :+ f h) t
go [] xs
List.filter: (a -> Boolean) -> [a] -> [a]
List.filter f all =
go acc = cases
[] -> acc
a +: as -> if (f a) then go (cons a acc) as else go acc as
go [] all
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
checks : [Boolean] -> [Result]
checks bs =
if all id bs then [Ok "Passed"]
else [Fail "Failed"]
hex : Bytes -> Text
hex b =
match Bytes.toBase16 b |> fromUtf8.impl
with Left e -> bug e
Right t -> t
ascii : Text -> Bytes
ascii = toUtf8
fromHex : Text -> Bytes
fromHex txt =
match toUtf8 txt |> Bytes.fromBase16
with Left e -> bug e
Right bs -> bs
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- An ability that facilitates creating temoporary directories that can be
-- automatically cleaned up
ability TempDirs where
newTempDir: Text -> Text
removeDir: Text -> ()
-- A handler for TempDirs which cleans up temporary directories
-- This will be useful for IO tests which need to interact with
-- the filesystem
autoCleaned.handler: '{io2.IO} (Request {TempDirs} r -> r)
autoCleaned.handler _ =
remover : [Text] -> {io2.IO} ()
remover = cases
a +: as -> match removeDirectory.impl a with
Left (Failure _ e _) -> watch e ()
_ -> ()
remover as
[] -> ()
go : [Text] -> {io2.IO} Request {TempDirs} r -> r
go dirs = cases
{ a } -> remover dirs
a
{ TempDirs.newTempDir prefix -> k } ->
dir = createTempDirectory prefix
handle k dir with go (dir +: dirs)
{ TempDirs.removeDir dir -> k } ->
removeDirectory dir
handle !k with go (filter (d -> not (d == dir)) dirs)
go []
autoCleaned: '{io2.IO, TempDirs} r -> r
autoCleaned comp = handle !comp with !autoCleaned.handler
stdout = IO.stdHandle StdOut
printText : Text -> {io2.IO} Either Failure ()
printText t = putBytes.impl stdout (toUtf8 t)
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, TempDirs, io2.IO, Exception} a ->{io2.IO, Exception}([Result], a)
evalTest a = handle (handle !a with Stream.collect.handler) with !autoCleaned.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception, TempDirs, Exception, io2.IO} a -> {io2.IO}[Result]
runTest t = handle evalTest t with cases
{ Exception.raise (Failure _ f _) -> _ } -> [ Fail ("Error running test: " ++ f) ]
{ (a, _) } -> a
expect : Text -> (a -> a -> Boolean) -> a -> a -> {Stream Result} ()
expect msg compare expected actual = if compare expected actual then emit (Ok msg) else emit (Fail msg)
expectU : Text -> a -> a -> {Stream Result} ()
expectU msg expected actual = expect msg (==) expected actual
startsWith: Text -> Text -> Boolean
startsWith prefix text = (eq (Text.take (size prefix) text) prefix)
contains : Text -> Text -> Boolean
contains needle haystack = if (size haystack) == 0 then false else
if startsWith needle haystack then true else
contains needle (drop 1 haystack)
isDirectory = compose reraise isDirectory.impl
createTempDirectory = compose reraise createTempDirectory.impl
removeDirectory = compose reraise removeDirectory.impl
fileExists = compose reraise fileExists.impl
renameDirectory = compose2 reraise renameDirectory.impl
openFile = compose2 reraise openFile.impl
isFileOpen = compose reraise isFileOpen.impl
closeFile = compose reraise closeFile.impl
isSeekable = compose reraise isSeekable.impl
isFileEOF = compose reraise isFileEOF.impl
Text.fromUtf8 = compose reraise fromUtf8.impl
getBytes = compose2 reraise getBytes.impl
handlePosition = compose reraise handlePosition.impl
seekHandle = compose3 reraise seekHandle.impl
putBytes = compose2 reraise putBytes.impl
systemTime = compose reraise systemTime.impl
decodeCert = compose reraise decodeCert.impl
serverSocket = compose2 reraise serverSocket.impl
listen = compose reraise listen.impl
handshake = compose reraise handshake.impl
send = compose2 reraise send.impl
closeSocket = compose reraise closeSocket.impl
clientSocket = compose2 reraise clientSocket.impl
receive = compose reraise receive.impl
terminate = compose reraise terminate.impl
newServer = compose2 reraise newServer.impl
socketAccept = compose reraise socketAccept.impl
socketPort = compose reraise socketPort.impl
newClient = compose2 reraise newClient.impl
MVar.take = compose reraise take.impl
MVar.put = compose2 reraise put.impl
MVar.swap = compose2 reraise MVar.swap.impl
```
```ucm:hide
.> add
```
The test shows that `hex (fromHex str) == str` as expected.
```unison:hide
test> hex.tests.ex1 = checks let
s = "3984af9b"
[hex (fromHex s) == s]
```
```ucm:hide
.scratch> test
```
Lets do some basic testing of our test harness to make sure its
working.
```unison
testAutoClean : '{io2.IO}[Result]
testAutoClean _ =
go: '{Stream Result, Exception, io2.IO, TempDirs} Text
go _ =
dir = newTempDir "autoclean"
check "our temporary directory should exist" (isDirectory dir)
dir
handle (evalTest go) with cases
{ Exception.raise (Failure _ t _) -> _ } -> [Fail t]
{ (results, dir) } ->
match io2.IO.isDirectory.impl dir with
Right b -> if b
then results :+ (Fail "our temporary directory should no longer exist")
else results :+ (Ok "our temporary directory should no longer exist")
Left (Failure _ t _) -> results :+ (Fail t)
```
```ucm
.> add
.> io.test testAutoClean
```

276
unison-src/new-runtime-transcripts/_base.output.md Normal file
View File

@ -0,0 +1,276 @@
# Base transcript
## Overview
This transcript is meant to be a transcript which can be run as a
prelude to other transcripts, creating helper functions, and including
a minimal subset of base in order to facilitate write nicer
transcripts which contain less boilerplate.
## Usage
```unison
a |> f = f a
compose f g = a -> f (g a)
compose2 f g = a -> b -> f (g a b)
compose3 f g = a -> b -> c -> f (g a b c)
id a = a
ability Exception where
raise: io2.Failure -> anything
Exception.reraise : Either Failure a ->{Exception} a
Exception.reraise = cases
Left e -> Exception.raise e
Right a -> a
Exception.toEither.handler : Request {Exception} a -> Either Failure a
Exception.toEither.handler = cases
{ a } -> Right a
{Exception.raise f -> _} -> Left f
Exception.toEither : '{ε, Exception} a -> {ε} Either Failure a
Exception.toEither a = handle !a with Exception.toEither.handler
ability Throw e where
throw : e -> a
List.all : (a ->{ε} Boolean) -> [a] ->{ε} Boolean
List.all f = cases
[] -> true
h +: t -> f h && all f t
List.map : (a ->{m} b) -> [a] ->{m} [b]
List.map f xs =
go acc = cases
[] -> acc
h +: t -> go (acc :+ f h) t
go [] xs
List.filter: (a -> Boolean) -> [a] -> [a]
List.filter f all =
go acc = cases
[] -> acc
a +: as -> if (f a) then go (cons a acc) as else go acc as
go [] all
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
checks : [Boolean] -> [Result]
checks bs =
if all id bs then [Ok "Passed"]
else [Fail "Failed"]
hex : Bytes -> Text
hex b =
match Bytes.toBase16 b |> fromUtf8.impl
with Left e -> bug e
Right t -> t
ascii : Text -> Bytes
ascii = toUtf8
fromHex : Text -> Bytes
fromHex txt =
match toUtf8 txt |> Bytes.fromBase16
with Left e -> bug e
Right bs -> bs
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- An ability that facilitates creating temoporary directories that can be
-- automatically cleaned up
ability TempDirs where
newTempDir: Text -> Text
removeDir: Text -> ()
-- A handler for TempDirs which cleans up temporary directories
-- This will be useful for IO tests which need to interact with
-- the filesystem
autoCleaned.handler: '{io2.IO} (Request {TempDirs} r -> r)
autoCleaned.handler _ =
remover : [Text] -> {io2.IO} ()
remover = cases
a +: as -> match removeDirectory.impl a with
Left (Failure _ e _) -> watch e ()
_ -> ()
remover as
[] -> ()
go : [Text] -> {io2.IO} Request {TempDirs} r -> r
go dirs = cases
{ a } -> remover dirs
a
{ TempDirs.newTempDir prefix -> k } ->
dir = createTempDirectory prefix
handle k dir with go (dir +: dirs)
{ TempDirs.removeDir dir -> k } ->
removeDirectory dir
handle !k with go (filter (d -> not (d == dir)) dirs)
go []
autoCleaned: '{io2.IO, TempDirs} r -> r
autoCleaned comp = handle !comp with !autoCleaned.handler
stdout = IO.stdHandle StdOut
printText : Text -> {io2.IO} Either Failure ()
printText t = putBytes.impl stdout (toUtf8 t)
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, TempDirs, io2.IO, Exception} a ->{io2.IO, Exception}([Result], a)
evalTest a = handle (handle !a with Stream.collect.handler) with !autoCleaned.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception, TempDirs, Exception, io2.IO} a -> {io2.IO}[Result]
runTest t = handle evalTest t with cases
{ Exception.raise (Failure _ f _) -> _ } -> [ Fail ("Error running test: " ++ f) ]
{ (a, _) } -> a
expect : Text -> (a -> a -> Boolean) -> a -> a -> {Stream Result} ()
expect msg compare expected actual = if compare expected actual then emit (Ok msg) else emit (Fail msg)
expectU : Text -> a -> a -> {Stream Result} ()
expectU msg expected actual = expect msg (==) expected actual
startsWith: Text -> Text -> Boolean
startsWith prefix text = (eq (Text.take (size prefix) text) prefix)
contains : Text -> Text -> Boolean
contains needle haystack = if (size haystack) == 0 then false else
if startsWith needle haystack then true else
contains needle (drop 1 haystack)
isDirectory = compose reraise isDirectory.impl
createTempDirectory = compose reraise createTempDirectory.impl
removeDirectory = compose reraise removeDirectory.impl
fileExists = compose reraise fileExists.impl
renameDirectory = compose2 reraise renameDirectory.impl
openFile = compose2 reraise openFile.impl
isFileOpen = compose reraise isFileOpen.impl
closeFile = compose reraise closeFile.impl
isSeekable = compose reraise isSeekable.impl
isFileEOF = compose reraise isFileEOF.impl
Text.fromUtf8 = compose reraise fromUtf8.impl
getBytes = compose2 reraise getBytes.impl
handlePosition = compose reraise handlePosition.impl
seekHandle = compose3 reraise seekHandle.impl
putBytes = compose2 reraise putBytes.impl
systemTime = compose reraise systemTime.impl
decodeCert = compose reraise decodeCert.impl
serverSocket = compose2 reraise serverSocket.impl
listen = compose reraise listen.impl
handshake = compose reraise handshake.impl
send = compose2 reraise send.impl
closeSocket = compose reraise closeSocket.impl
clientSocket = compose2 reraise clientSocket.impl
receive = compose reraise receive.impl
terminate = compose reraise terminate.impl
newServer = compose2 reraise newServer.impl
socketAccept = compose reraise socketAccept.impl
socketPort = compose reraise socketPort.impl
newClient = compose2 reraise newClient.impl
MVar.take = compose reraise take.impl
MVar.put = compose2 reraise put.impl
MVar.swap = compose2 reraise MVar.swap.impl
```
The test shows that `hex (fromHex str) == str` as expected.
```unison
test> hex.tests.ex1 = checks let
s = "3984af9b"
[hex (fromHex s) == s]
```
Lets do some basic testing of our test harness to make sure its
working.
```unison
testAutoClean : '{io2.IO}[Result]
testAutoClean _ =
go: '{Stream Result, Exception, io2.IO, TempDirs} Text
go _ =
dir = newTempDir "autoclean"
check "our temporary directory should exist" (isDirectory dir)
dir
handle (evalTest go) with cases
{ Exception.raise (Failure _ t _) -> _ } -> [Fail t]
{ (results, dir) } ->
match io2.IO.isDirectory.impl dir with
Right b -> if b
then results :+ (Fail "our temporary directory should no longer exist")
else results :+ (Ok "our temporary directory should no longer exist")
Left (Failure _ t _) -> results :+ (Fail t)
```
```ucm
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
testAutoClean : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
testAutoClean : '{io2.IO} [Result]
.> io.test testAutoClean
New test results:
◉ testAutoClean our temporary directory should exist
◉ testAutoClean our temporary directory should no longer exist
✅ 2 test(s) passing
Tip: Use view testAutoClean to view the source of a test.
```

40
unison-src/new-runtime-transcripts/builtins.md
View File

@ -2,42 +2,6 @@
This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail.
## Setup
```ucm:hide
.> builtins.merge
```
You can skip this section, which just defines setup functions we'll use for testing.
```unison:hide
check : Boolean -> [Result]
check b = if b then [Ok "Passed"] else [Fail "Failed"]
id x = x
checks : [Boolean] -> [Result]
checks bs =
if all id bs then [Ok "Passed"]
else [Fail "Failed"]
all : (a ->{m} Boolean) -> [a] ->{m} Boolean
all f = cases
[] -> true
h +: t -> f h && all f t
map : (a ->{m} b) -> [a] ->{m} [b]
map f xs =
go acc = cases
[] -> acc
h +: t -> go (acc :+ f h) t
go [] xs
```
```ucm:hide
.> add
```
## `Int` functions ## `Int` functions
```unison:hide ```unison:hide
@ -186,8 +150,8 @@ test> Nat.tests.conversions =
```unison ```unison
> [Any "hi", Any (41 + 1)] > [Any "hi", Any (41 + 1)]
test> Any.test1 = check (Any "hi" == Any "hi") test> Any.test1 = checks [(Any "hi" == Any "hi")]
test> Any.test2 = check (not (Any "hi" == Any 42)) test> Any.test2 = checks [(not (Any "hi" == Any 42))]
``` ```
```ucm:hide ```ucm:hide

36
unison-src/new-runtime-transcripts/builtins.output.md
View File

@ -2,34 +2,6 @@
This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. This transcript defines unit tests for builtin functions. There's a single `.> test` execution at the end that will fail the transcript with a nice report if any of the tests fail.
## Setup
You can skip this section, which just defines setup functions we'll use for testing.
```unison
check : Boolean -> [Result]
check b = if b then [Ok "Passed"] else [Fail "Failed"]
id x = x
checks : [Boolean] -> [Result]
checks bs =
if all id bs then [Ok "Passed"]
else [Fail "Failed"]
all : (a ->{m} Boolean) -> [a] ->{m} Boolean
all f = cases
[] -> true
h +: t -> f h && all f t
map : (a ->{m} b) -> [a] ->{m} [b]
map f xs =
go acc = cases
[] -> acc
h +: t -> go (acc :+ f h) t
go [] xs
```
## `Int` functions ## `Int` functions
```unison ```unison
@ -170,8 +142,8 @@ test> Nat.tests.conversions =
```unison ```unison
> [Any "hi", Any (41 + 1)] > [Any "hi", Any (41 + 1)]
test> Any.test1 = check (Any "hi" == Any "hi") test> Any.test1 = checks [(Any "hi" == Any "hi")]
test> Any.test2 = check (not (Any "hi" == Any 42)) test> Any.test2 = checks [(not (Any "hi" == Any 42))]
``` ```
```ucm ```ucm
@ -192,11 +164,11 @@ test> Any.test2 = check (not (Any "hi" == Any 42))
⧩ ⧩
[Any "hi", Any 42] [Any "hi", Any 42]
3 | test> Any.test1 = check (Any "hi" == Any "hi") 3 | test> Any.test1 = checks [(Any "hi" == Any "hi")]
✅ Passed Passed ✅ Passed Passed
4 | test> Any.test2 = check (not (Any "hi" == Any 42)) 4 | test> Any.test2 = checks [(not (Any "hi" == Any 42))]
✅ Passed Passed ✅ Passed Passed

24
unison-src/new-runtime-transcripts/codeops.md
View File

@ -10,30 +10,27 @@ Define a function, serialize it, then deserialize it back to an actual
function. Also ask for its dependencies for display later. function. Also ask for its dependencies for display later.
```unison ```unison
ability Err where
throw : Text -> a
save : a -> Bytes save : a -> Bytes
save x = Value.serialize (Value.value x) save x = Value.serialize (Value.value x)
load : Bytes ->{io2.IO, Err} a load : Bytes ->{io2.IO, Throw Text} a
load b = match Value.deserialize b with load b = match Value.deserialize b with
Left _ -> throw "could not deserialize value" Left _ -> throw "could not deserialize value"
Right v -> match Value.load v with Right v -> match Value.load v with
Left _ -> throw "could not load value" Left _ -> throw "could not load value"
Right x -> x Right x -> x
roundtrip : a ->{io2.IO, Err} a roundtrip : a ->{io2.IO, Throw Text} a
roundtrip x = load (save x) roundtrip x = load (save x)
handleTest : Text -> Request {Err} a -> Result handleTest : Text -> Request {Throw Text} a -> Result
handleTest t = let handleTest t = let
pfx = "(" ++ t ++ ") " pfx = "(" ++ t ++ ") "
cases cases
{ _ } -> Ok (pfx ++ "passed") { _ } -> Ok (pfx ++ "passed")
{ throw s -> _ } -> Fail (pfx ++ s) { Throw.throw s -> _ } -> Fail (pfx ++ s)
identical : Text -> a -> a ->{Err} () identical : Text -> a -> a ->{Throw Text} ()
identical err x y = identical err x y =
if x == y if x == y
then () then ()
@ -47,11 +44,6 @@ showThree = cases
one n -> "one " ++ toText n one n -> "one " ++ toText n
two n -> "two " ++ toText n two n -> "two " ++ toText n
map : (a -> b) -> [a] -> [b]
map f = cases
[] -> []
x +: xs -> f x +: map f xs
concatMap : (a -> [b]) -> [a] -> [b] concatMap : (a -> [b]) -> [a] -> [b]
concatMap f = cases concatMap f = cases
[] -> [] [] -> []
@ -69,7 +61,7 @@ extensionals
: (a -> b -> Text) : (a -> b -> Text)
-> (a -> b -> c) -> (a -> b -> c)
-> (a -> b -> c) -> (a -> b -> c)
-> [(a,b)] ->{Err} () -> [(a,b)] ->{Throw Text} ()
extensionals sh f g = cases extensionals sh f g = cases
[] -> () [] -> ()
(x,y) +: xs -> (x,y) +: xs ->
@ -79,7 +71,7 @@ extensionals sh f g = cases
fib10 : [Nat] fib10 : [Nat]
fib10 = [1,2,3,5,8,13,21,34,55,89] fib10 = [1,2,3,5,8,13,21,34,55,89]
extensionality : Text -> (Three Nat Nat Nat -> Nat -> b) ->{IO} Result extensionality : Text -> (Three Nat Nat Nat -> Nat -> b) ->{io2.IO} Result
extensionality t f = let extensionality t f = let
sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")" sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")"
handle handle
@ -87,7 +79,7 @@ extensionality t f = let
extensionals sh f g (prod threes fib10) extensionals sh f g (prod threes fib10)
with handleTest t with handleTest t
identicality : Text -> a ->{IO} Result identicality : Text -> a ->{io2.IO} Result
identicality t x identicality t x
= handle identical "" x (roundtrip x) with handleTest t = handle identical "" x (roundtrip x) with handleTest t
``` ```

92
unison-src/new-runtime-transcripts/codeops.output.md
View File

@ -5,30 +5,27 @@ Define a function, serialize it, then deserialize it back to an actual
function. Also ask for its dependencies for display later. function. Also ask for its dependencies for display later.
```unison ```unison
ability Err where
throw : Text -> a
save : a -> Bytes save : a -> Bytes
save x = Value.serialize (Value.value x) save x = Value.serialize (Value.value x)
load : Bytes ->{io2.IO, Err} a load : Bytes ->{io2.IO, Throw Text} a
load b = match Value.deserialize b with load b = match Value.deserialize b with
Left _ -> throw "could not deserialize value" Left _ -> throw "could not deserialize value"
Right v -> match Value.load v with Right v -> match Value.load v with
Left _ -> throw "could not load value" Left _ -> throw "could not load value"
Right x -> x Right x -> x
roundtrip : a ->{io2.IO, Err} a roundtrip : a ->{io2.IO, Throw Text} a
roundtrip x = load (save x) roundtrip x = load (save x)
handleTest : Text -> Request {Err} a -> Result handleTest : Text -> Request {Throw Text} a -> Result
handleTest t = let handleTest t = let
pfx = "(" ++ t ++ ") " pfx = "(" ++ t ++ ") "
cases cases
{ _ } -> Ok (pfx ++ "passed") { _ } -> Ok (pfx ++ "passed")
{ throw s -> _ } -> Fail (pfx ++ s) { Throw.throw s -> _ } -> Fail (pfx ++ s)
identical : Text -> a -> a ->{Err} () identical : Text -> a -> a ->{Throw Text} ()
identical err x y = identical err x y =
if x == y if x == y
then () then ()
@ -42,11 +39,6 @@ showThree = cases
one n -> "one " ++ toText n one n -> "one " ++ toText n
two n -> "two " ++ toText n two n -> "two " ++ toText n
map : (a -> b) -> [a] -> [b]
map f = cases
[] -> []
x +: xs -> f x +: map f xs
concatMap : (a -> [b]) -> [a] -> [b] concatMap : (a -> [b]) -> [a] -> [b]
concatMap f = cases concatMap f = cases
[] -> [] [] -> []
@ -64,7 +56,7 @@ extensionals
: (a -> b -> Text) : (a -> b -> Text)
-> (a -> b -> c) -> (a -> b -> c)
-> (a -> b -> c) -> (a -> b -> c)
-> [(a,b)] ->{Err} () -> [(a,b)] ->{Throw Text} ()
extensionals sh f g = cases extensionals sh f g = cases
[] -> () [] -> ()
(x,y) +: xs -> (x,y) +: xs ->
@ -74,7 +66,7 @@ extensionals sh f g = cases
fib10 : [Nat] fib10 : [Nat]
fib10 = [1,2,3,5,8,13,21,34,55,89] fib10 = [1,2,3,5,8,13,21,34,55,89]
extensionality : Text -> (Three Nat Nat Nat -> Nat -> b) ->{IO} Result extensionality : Text -> (Three Nat Nat Nat -> Nat -> b) ->{io2.IO} Result
extensionality t f = let extensionality t f = let
sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")" sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")"
handle handle
@ -82,7 +74,7 @@ extensionality t f = let
extensionals sh f g (prod threes fib10) extensionals sh f g (prod threes fib10)
with handleTest t with handleTest t
identicality : Text -> a ->{IO} Result identicality : Text -> a ->{io2.IO} Result
identicality t x identicality t x
= handle identical "" x (roundtrip x) with handleTest t = handle identical "" x (roundtrip x) with handleTest t
``` ```
@ -95,27 +87,29 @@ identicality t x
⍟ These new definitions are ok to `add`: ⍟ These new definitions are ok to `add`:
ability Err
type Three a b c type Three a b c
concatMap : (a ->{g} [b]) ->{g} [a] ->{g} [b] concatMap : (a ->{g} [b]) ->{g} [a] ->{g} [b]
extensionality : Text extensionality : Text
-> (Three Nat Nat Nat -> (Three Nat Nat Nat
->{Err} Nat ->{Throw Text} Nat
->{Err} b) ->{Throw Text} b)
->{IO} Result ->{io2.IO} Result
extensionals : (a ->{Err} b ->{Err} Text) extensionals : (a ->{Throw Text} b ->{Throw Text} Text)
->{Err} (a ->{Err} b ->{Err} c) ->{Throw Text} (a
->{Err} (a ->{Err} b ->{Err} c) ->{Throw Text} b
->{Err} [(a, b)] ->{Throw Text} c)
->{Err} () ->{Throw Text} (a
->{Throw Text} b
->{Throw Text} c)
->{Throw Text} [(a, b)]
->{Throw Text} ()
fib10 : [Nat] fib10 : [Nat]
handleTest : Text -> Request {Err} a -> Result handleTest : Text -> Request {Throw Text} a -> Result
identical : Text -> a -> a ->{Err} () identical : Text -> a -> a ->{Throw Text} ()
identicality : Text -> a ->{IO} Result identicality : Text -> a ->{io2.IO} Result
load : Bytes ->{IO, Err} a load : Bytes ->{io2.IO, Throw Text} a
map : (a ->{g} b) ->{g} [a] ->{g} [b]
prod : [a] ->{g} [b] ->{g} [(a, b)] prod : [a] ->{g} [b] ->{g} [(a, b)]
roundtrip : a ->{IO, Err} a roundtrip : a ->{io2.IO, Throw Text} a
save : a -> Bytes save : a -> Bytes
showThree : Three Nat Nat Nat -> Text showThree : Three Nat Nat Nat -> Text
threes : [Three Nat Nat Nat] threes : [Three Nat Nat Nat]
@ -126,27 +120,29 @@ identicality t x
⍟ I've added these definitions: ⍟ I've added these definitions:
ability Err
type Three a b c type Three a b c
concatMap : (a ->{g} [b]) ->{g} [a] ->{g} [b] concatMap : (a ->{g} [b]) ->{g} [a] ->{g} [b]
extensionality : Text extensionality : Text
-> (Three Nat Nat Nat -> (Three Nat Nat Nat
->{Err} Nat ->{Throw Text} Nat
->{Err} b) ->{Throw Text} b)
->{IO} Result ->{io2.IO} Result
extensionals : (a ->{Err} b ->{Err} Text) extensionals : (a ->{Throw Text} b ->{Throw Text} Text)
->{Err} (a ->{Err} b ->{Err} c) ->{Throw Text} (a
->{Err} (a ->{Err} b ->{Err} c) ->{Throw Text} b
->{Err} [(a, b)] ->{Throw Text} c)
->{Err} () ->{Throw Text} (a
->{Throw Text} b
->{Throw Text} c)
->{Throw Text} [(a, b)]
->{Throw Text} ()
fib10 : [Nat] fib10 : [Nat]
handleTest : Text -> Request {Err} a -> Result handleTest : Text -> Request {Throw Text} a -> Result
identical : Text -> a -> a ->{Err} () identical : Text -> a -> a ->{Throw Text} ()
identicality : Text -> a ->{IO} Result identicality : Text -> a ->{io2.IO} Result
load : Bytes ->{IO, Err} a load : Bytes ->{io2.IO, Throw Text} a
map : (a ->{g} b) ->{g} [a] ->{g} [b]
prod : [a] ->{g} [b] ->{g} [(a, b)] prod : [a] ->{g} [b] ->{g} [(a, b)]
roundtrip : a ->{IO, Err} a roundtrip : a ->{io2.IO, Throw Text} a
save : a -> Bytes save : a -> Bytes
showThree : Three Nat Nat Nat -> Text showThree : Three Nat Nat Nat -> Text
threes : [Three Nat Nat Nat] threes : [Three Nat Nat Nat]
@ -218,7 +214,7 @@ tests =
fVal : Value fVal : Value
h : Three Nat Nat Nat -> Nat -> Nat h : Three Nat Nat Nat -> Nat -> Nat
rotate : Three Nat Nat Nat -> Three Nat Nat Nat rotate : Three Nat Nat Nat -> Three Nat Nat Nat
tests : '{IO} [Result] tests : '{io2.IO} [Result]
zapper : Three Nat Nat Nat ->{g} Request {Zap} r ->{g} r zapper : Three Nat Nat Nat ->{g} Request {Zap} r ->{g} r
``` ```
@ -238,7 +234,7 @@ to actual show that the serialization works.
fVal : Value fVal : Value
h : Three Nat Nat Nat -> Nat -> Nat h : Three Nat Nat Nat -> Nat -> Nat
rotate : Three Nat Nat Nat -> Three Nat Nat Nat rotate : Three Nat Nat Nat -> Three Nat Nat Nat
tests : '{IO} [Result] tests : '{io2.IO} [Result]
zapper : Three Nat Nat Nat ->{g} Request {Zap} r ->{g} r zapper : Three Nat Nat Nat ->{g} Request {Zap} r ->{g} r
.> display fDeps .> display fDeps

3
unison-src/new-runtime-transcripts/fix1709.output.md
View File

@ -12,9 +12,10 @@ id2 x =
do an `add` or `update`, here's how your codebase would do an `add` or `update`, here's how your codebase would
change: change:
⊡ Previously added definitions will be ignored: id
⍟ These new definitions are ok to `add`: ⍟ These new definitions are ok to `add`:
id : x -> x
id2 : x -> x id2 : x -> x
``` ```

59
unison-src/new-runtime-transcripts/hashing.md
View File

@ -7,53 +7,11 @@
Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases.
## Setup
You can skip this section, which is just needed to make the transcript self-contained. In order to print out and test these hashes we will be using some builtins for base16 (aka hexidecimal) encoding and decoding.
```ucm ```ucm
.builtin> ls Bytes .builtin> ls Bytes
``` ```
Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`. Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`.
```unison:hide
a |> f = f a
hex : Bytes -> Text
hex b =
match Bytes.toBase16 b |> fromUtf8.impl
with Left e -> bug e
Right t -> t
ascii : Text -> Bytes
ascii = toUtf8
fromHex : Text -> Bytes
fromHex txt =
match toUtf8 txt |> Bytes.fromBase16
with Left e -> bug e
Right bs -> bs
check : Boolean -> [Result]
check b = if b then [Result.Ok "Passed."]
else [Result.Fail "Failed."]
test> hex.tests.ex1 = check let
s = "3984af9b"
hex (fromHex s) == s
```
```ucm:hide
.scratch> add
```
The test shows that `hex (fromHex str) == str` as expected.
```ucm
.scratch> test
```
## API overview ## API overview
Here's a few usage examples: Here's a few usage examples:
@ -71,7 +29,7 @@ mysecret : Bytes
mysecret = fromHex "237be2" mysecret = fromHex "237be2"
ex3 = fromHex "50d3ab" ex3 = fromHex "50d3ab"
|> crypto.hmacBytes Sha2_256 mysecret |> (crypto.hmacBytes Sha2_256 mysecret)
|> hex |> hex
f x = x f x = x
@ -104,9 +62,7 @@ Note that the universal versions of `hash` and `hmac` are currently unimplemente
Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms: Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms:
```unison:hide ```unison:hide
ex alg input expected = check let ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected]
hashBytes alg (ascii input) ==
fromHex expected
test> sha3_512.tests.ex1 = test> sha3_512.tests.ex1 =
ex Sha3_512 ex Sha3_512
@ -222,16 +178,13 @@ test> blake2b_512.tests.ex3 =
These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3). These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3).
```unison ```unison
ex' alg secret msg expected = check let ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected]
hmacBytes alg (fromHex secret) (ascii msg) ==
fromHex expected
test> hmac_sha2_256.tests.ex1 = test> hmac_sha2_256.tests.ex1 =
ex' Sha2_256 ex' Sha2_256
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
"Hi There" "Hi There"
"b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7"
test> hmac_sha2_512.tests.ex1 = test> hmac_sha2_512.tests.ex1 =
ex' Sha2_512 ex' Sha2_512
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"

172
unison-src/new-runtime-transcripts/hashing.output.md
View File

@ -2,10 +2,6 @@
Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases. Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases.
## Setup
You can skip this section, which is just needed to make the transcript self-contained. In order to print out and test these hashes we will be using some builtins for base16 (aka hexidecimal) encoding and decoding.
```ucm ```ucm
.builtin> ls Bytes .builtin> ls Bytes
@ -30,47 +26,6 @@ You can skip this section, which is just needed to make the transcript self-cont
``` ```
Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`. Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`.
```unison
a |> f = f a
hex : Bytes -> Text
hex b =
match Bytes.toBase16 b |> fromUtf8.impl
with Left e -> bug e
Right t -> t
ascii : Text -> Bytes
ascii = toUtf8
fromHex : Text -> Bytes
fromHex txt =
match toUtf8 txt |> Bytes.fromBase16
with Left e -> bug e
Right bs -> bs
check : Boolean -> [Result]
check b = if b then [Result.Ok "Passed."]
else [Result.Fail "Failed."]
test> hex.tests.ex1 = check let
s = "3984af9b"
hex (fromHex s) == s
```
The test shows that `hex (fromHex str) == str` as expected.
```ucm
.scratch> test
Cached test results (`help testcache` to learn more)
◉ hex.tests.ex1 Passed.
✅ 1 test(s) passing
Tip: Use view hex.tests.ex1 to view the source of a test.
```
## API overview ## API overview
Here's a few usage examples: Here's a few usage examples:
@ -88,7 +43,7 @@ mysecret : Bytes
mysecret = fromHex "237be2" mysecret = fromHex "237be2"
ex3 = fromHex "50d3ab" ex3 = fromHex "50d3ab"
|> crypto.hmacBytes Sha2_256 mysecret |> (crypto.hmacBytes Sha2_256 mysecret)
|> hex |> hex
f x = x f x = x
@ -176,9 +131,7 @@ Note that the universal versions of `hash` and `hmac` are currently unimplemente
Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms: Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms:
```unison ```unison
ex alg input expected = check let ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected]
hashBytes alg (ascii input) ==
fromHex expected
test> sha3_512.tests.ex1 = test> sha3_512.tests.ex1 =
ex Sha3_512 ex Sha3_512
@ -286,29 +239,28 @@ test> blake2b_512.tests.ex3 =
Cached test results (`help testcache` to learn more) Cached test results (`help testcache` to learn more)
◉ blake2b_512.tests.ex1 Passed. ◉ blake2b_512.tests.ex1 Passed
◉ blake2b_512.tests.ex2 Passed. ◉ blake2b_512.tests.ex2 Passed
◉ blake2b_512.tests.ex3 Passed. ◉ blake2b_512.tests.ex3 Passed
◉ blake2s_256.tests.ex1 Passed. ◉ blake2s_256.tests.ex1 Passed
◉ hex.tests.ex1 Passed. ◉ sha2_256.tests.ex1 Passed
◉ sha2_256.tests.ex1 Passed. ◉ sha2_256.tests.ex2 Passed
◉ sha2_256.tests.ex2 Passed. ◉ sha2_256.tests.ex3 Passed
◉ sha2_256.tests.ex3 Passed. ◉ sha2_256.tests.ex4 Passed
◉ sha2_256.tests.ex4 Passed. ◉ sha2_512.tests.ex1 Passed
◉ sha2_512.tests.ex1 Passed. ◉ sha2_512.tests.ex2 Passed
◉ sha2_512.tests.ex2 Passed. ◉ sha2_512.tests.ex3 Passed
◉ sha2_512.tests.ex3 Passed. ◉ sha2_512.tests.ex4 Passed
◉ sha2_512.tests.ex4 Passed. ◉ sha3_256.tests.ex1 Passed
◉ sha3_256.tests.ex1 Passed. ◉ sha3_256.tests.ex2 Passed
◉ sha3_256.tests.ex2 Passed. ◉ sha3_256.tests.ex3 Passed
◉ sha3_256.tests.ex3 Passed. ◉ sha3_256.tests.ex4 Passed
◉ sha3_256.tests.ex4 Passed. ◉ sha3_512.tests.ex1 Passed
◉ sha3_512.tests.ex1 Passed. ◉ sha3_512.tests.ex2 Passed
◉ sha3_512.tests.ex2 Passed. ◉ sha3_512.tests.ex3 Passed
◉ sha3_512.tests.ex3 Passed. ◉ sha3_512.tests.ex4 Passed
◉ sha3_512.tests.ex4 Passed.
✅ 21 test(s) passing ✅ 20 test(s) passing
Tip: Use view blake2b_512.tests.ex1 to view the source of a Tip: Use view blake2b_512.tests.ex1 to view the source of a
test. test.
@ -319,16 +271,13 @@ test> blake2b_512.tests.ex3 =
These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3). These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3).
```unison ```unison
ex' alg secret msg expected = check let ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected]
hmacBytes alg (fromHex secret) (ascii msg) ==
fromHex expected
test> hmac_sha2_256.tests.ex1 = test> hmac_sha2_256.tests.ex1 =
ex' Sha2_256 ex' Sha2_256
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
"Hi There" "Hi There"
"b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7"
test> hmac_sha2_512.tests.ex1 = test> hmac_sha2_512.tests.ex1 =
ex' Sha2_512 ex' Sha2_512
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
@ -369,21 +318,21 @@ test> hmac_sha2_512.tests.ex2 =
Now evaluating any watch expressions (lines starting with Now evaluating any watch expressions (lines starting with
`>`)... Ctrl+C cancels. `>`)... Ctrl+C cancels.
6 | ex' Sha2_256 4 | ex' Sha2_256
✅ Passed Passed. ✅ Passed Passed
12 | ex' Sha2_512 9 | ex' Sha2_512
✅ Passed Passed. ✅ Passed Passed
18 | ex' Sha2_256 15 | ex' Sha2_256
✅ Passed Passed. ✅ Passed Passed
24 | ex' Sha2_512 21 | ex' Sha2_512
✅ Passed Passed. ✅ Passed Passed
``` ```
```ucm ```ucm
@ -391,33 +340,32 @@ test> hmac_sha2_512.tests.ex2 =
Cached test results (`help testcache` to learn more) Cached test results (`help testcache` to learn more)
◉ blake2b_512.tests.ex1 Passed. ◉ blake2b_512.tests.ex1 Passed
◉ blake2b_512.tests.ex2 Passed. ◉ blake2b_512.tests.ex2 Passed
◉ blake2b_512.tests.ex3 Passed. ◉ blake2b_512.tests.ex3 Passed
◉ blake2s_256.tests.ex1 Passed. ◉ blake2s_256.tests.ex1 Passed
◉ hex.tests.ex1 Passed. ◉ hmac_sha2_256.tests.ex1 Passed
◉ hmac_sha2_256.tests.ex1 Passed. ◉ hmac_sha2_256.tests.ex2 Passed
◉ hmac_sha2_256.tests.ex2 Passed. ◉ hmac_sha2_512.tests.ex1 Passed
◉ hmac_sha2_512.tests.ex1 Passed. ◉ hmac_sha2_512.tests.ex2 Passed
◉ hmac_sha2_512.tests.ex2 Passed. ◉ sha2_256.tests.ex1 Passed
◉ sha2_256.tests.ex1 Passed. ◉ sha2_256.tests.ex2 Passed
◉ sha2_256.tests.ex2 Passed. ◉ sha2_256.tests.ex3 Passed
◉ sha2_256.tests.ex3 Passed. ◉ sha2_256.tests.ex4 Passed
◉ sha2_256.tests.ex4 Passed. ◉ sha2_512.tests.ex1 Passed
◉ sha2_512.tests.ex1 Passed. ◉ sha2_512.tests.ex2 Passed
◉ sha2_512.tests.ex2 Passed. ◉ sha2_512.tests.ex3 Passed
◉ sha2_512.tests.ex3 Passed. ◉ sha2_512.tests.ex4 Passed
◉ sha2_512.tests.ex4 Passed. ◉ sha3_256.tests.ex1 Passed
◉ sha3_256.tests.ex1 Passed. ◉ sha3_256.tests.ex2 Passed
◉ sha3_256.tests.ex2 Passed. ◉ sha3_256.tests.ex3 Passed
◉ sha3_256.tests.ex3 Passed. ◉ sha3_256.tests.ex4 Passed
◉ sha3_256.tests.ex4 Passed. ◉ sha3_512.tests.ex1 Passed
◉ sha3_512.tests.ex1 Passed. ◉ sha3_512.tests.ex2 Passed
◉ sha3_512.tests.ex2 Passed. ◉ sha3_512.tests.ex3 Passed
◉ sha3_512.tests.ex3 Passed. ◉ sha3_512.tests.ex4 Passed
◉ sha3_512.tests.ex4 Passed.
✅ 25 test(s) passing ✅ 24 test(s) passing
Tip: Use view blake2b_512.tests.ex1 to view the source of a Tip: Use view blake2b_512.tests.ex1 to view the source of a
test. test.

243
unison-src/new-runtime-transcripts/io.md
View File

@ -1,4 +1,4 @@
# tests for IO / MVar # tests for built-in IO functions
```ucm:hide ```ucm:hide
.> builtins.merge .> builtins.merge
@ -15,126 +15,6 @@ TempDirs/autoCleaned is an ability/hanlder which allows you to easily
create a scratch directory which will automatically get cleaned up. create a scratch directory which will automatically get cleaned up.
```unison:hide ```unison:hide
use .builtin.io2 Failure
filter: (a -> Boolean) -> [a] -> [a]
filter f all =
go acc = cases
a +: as -> if (f a) then go (cons a acc) as else go acc as
[] -> acc
go [] all
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
-- An ability that facilitates creating temoporary directories that can be
-- automatically cleaned up
ability TempDirs where
newTempDir: Text -> Either Failure Text
removeDir: Text -> Either Failure ()
-- A handler for TempDirs which cleans up temporary directories
-- This will be useful for IO tests which need to interact with
-- the filesystem
autoCleaned.handler: '{io2.IO} (Request {TempDirs} r -> r)
autoCleaned.handler _ =
remover : [Text] -> {io2.IO} ()
remover = cases
a +: as -> removeDirectory.impl a
remover as
[] -> ()
go : [Text] -> {io2.IO} Request {TempDirs} r -> r
go dirs = cases
{ a } -> remover dirs
a
{ TempDirs.newTempDir prefix -> k } ->
dir = createTempDirectory prefix
match dir with
Right dir' -> handle k dir with go (dir' +: dirs)
Left _ -> handle k dir with go dirs
{ TempDirs.removeDir dir -> k } ->
handle k (removeDirectory.impl dir) with go (filter (d -> not (d == dir)) dirs)
go []
autoCleaned: '{io2.IO, TempDirs} r -> r
autoCleaned comp = handle !comp with !autoCleaned.handler
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
stdout = IO.stdHandle StdErr
printText : Text -> {io2.IO} Either Failure ()
printText t = putBytes.impl stdout (toUtf8 t)
expect : Text -> (a -> a -> Boolean) -> a -> a -> {Stream Result} ()
expect msg compare expected actual = if compare expected actual then emit (Ok msg) else emit (Fail msg)
expectU : Text -> a -> a -> {Stream Result} ()
expectU msg expected actual = expect msg (==) expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO, TempDirs} a -> ([Result], Either Failure a)
evalTest a = handle
(handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler)
with !autoCleaned.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO, TempDirs} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
``` ```
@ -142,34 +22,6 @@ runTest t = match evalTest t with
.> add .> add
``` ```
## Who watches the watchers?
First lets do some basic testing of our test harness to make sure its
working.
```unison
testAutoClean : '{io2.IO}[Result]
testAutoClean _ =
go: '{Stream Result, Exception Failure, io2.IO, TempDirs} Text
go _ =
dir = toException (newTempDir "autoclean")
check "our temporary directory should exist" (toException (isDirectory.impl dir))
dir
match evalTest go with
(results, Left (Failure _ t _)) -> results :+ (Fail t)
(results, Right dir) ->
match isDirectory.impl dir with
Right b -> if b
then results :+ (Fail "our temporary directory should no longer exist")
else results :+ (Ok "our temporary directory should no longer exist")
Left (Failure _ t _) -> results :+ (Fail t)
```
```ucm
.> add
.> io.test testAutoClean
```
## Basic File Functions ## Basic File Functions
@ -185,23 +37,23 @@ Tests: createDirectory,
testCreateRename : '{io2.IO} [Result] testCreateRename : '{io2.IO} [Result]
testCreateRename _ = testCreateRename _ =
test = 'let test = 'let
tempDir = toException (newTempDir "fileio") tempDir = newTempDir "fileio"
fooDir = tempDir ++ "/foo" fooDir = tempDir ++ "/foo"
barDir = tempDir ++ "/bar" barDir = tempDir ++ "/bar"
toException let createDirectory.impl fooDir createDirectory.impl fooDir
check "create a foo directory" (toException (isDirectory.impl fooDir)) check "create a foo directory" (isDirectory fooDir)
check "directory should exist" (toException (fileExists.impl fooDir)) check "directory should exist" (fileExists fooDir)
toException let renameDirectory.impl fooDir barDir renameDirectory fooDir barDir
check "foo should no longer exist" (not (toException (fileExists.impl fooDir))) check "foo should no longer exist" (not (fileExists fooDir))
check "directory should no longer exist" (not (toException (fileExists.impl fooDir))) check "directory should no longer exist" (not (fileExists fooDir))
check "bar should now exist" (toException (fileExists.impl barDir)) check "bar should now exist" (fileExists barDir)
bazDir = barDir ++ "/baz" bazDir = barDir ++ "/baz"
toException let createDirectory.impl bazDir createDirectory.impl bazDir
toException let removeDirectory.impl barDir removeDirectory.impl barDir
check "removeDirectory works recursively" (not (toException (isDirectory.impl barDir))) check "removeDirectory works recursively" (not (isDirectory barDir))
check "removeDirectory works recursively" (not (toException (isDirectory.impl bazDir))) check "removeDirectory works recursively" (not (isDirectory bazDir))
runTest test runTest test
``` ```
@ -220,12 +72,12 @@ Tests: openFile
testOpenClose : '{io2.IO} [Result] testOpenClose : '{io2.IO} [Result]
testOpenClose _ = testOpenClose _ =
test = 'let test = 'let
tempDir = toException (newTempDir "seek") tempDir = (newTempDir "seek")
fooFile = tempDir ++ "/foo" fooFile = tempDir ++ "/foo"
handle1 = toException (openFile.impl fooFile FileMode.Write) handle1 = openFile fooFile FileMode.Write
check "file should be open" (toException (isFileOpen.impl handle1)) check "file should be open" (isFileOpen handle1)
toException (closeFile.impl handle1) closeFile handle1
check "file should be closed" (not (toException (isFileOpen.impl handle1))) check "file should be closed" (not (isFileOpen handle1))
runTest test runTest test
``` ```
@ -248,48 +100,47 @@ Tests: openFile
testSeek : '{io2.IO} [Result] testSeek : '{io2.IO} [Result]
testSeek _ = testSeek _ =
test = 'let test = 'let
tempDir = toException (newTempDir "seek") tempDir = newTempDir "seek"
emit (Ok "seeked") emit (Ok "seeked")
fooFile = tempDir ++ "/foo" fooFile = tempDir ++ "/foo"
handle1 = toException (openFile.impl fooFile FileMode.Append) handle1 = openFile fooFile FileMode.Append
putBytes.impl handle1 (toUtf8 "12345678") putBytes handle1 (toUtf8 "12345678")
closeFile.impl handle1 closeFile handle1
handle3 = toException (openFile.impl fooFile FileMode.Read) handle3 = openFile fooFile FileMode.Read
check "readable file should be seekable" (toException (isSeekable.impl handle3)) check "readable file should be seekable" (isSeekable handle3)
check "shouldn't be the EOF" (not (toException (isFileEOF.impl handle3))) check "shouldn't be the EOF" (not (isFileEOF handle3))
expectU "we should be at position 0" 0 (toException (handlePosition.impl handle3)) expectU "we should be at position 0" 0 (handlePosition handle3)
toException (seekHandle.impl handle3 AbsoluteSeek +1) seekHandle handle3 AbsoluteSeek +1
expectU "we should be at position 1" 1 (toException (handlePosition.impl handle3)) expectU "we should be at position 1" 1 (handlePosition handle3)
bytes3a = toException (getBytes.impl handle3 1000) bytes3a = getBytes handle3 1000
text3a = toException (Text.fromUtf8.impl bytes3a) text3a = Text.fromUtf8 bytes3a
expectU "should be able to read our temporary file after seeking" "2345678" text3a expectU "should be able to read our temporary file after seeking" "2345678" text3a
closeFile.impl handle3 closeFile handle3
runTest test runTest test
testAppend : '{io2.IO} [Result] testAppend : '{io2.IO} [Result]
testAppend _ = testAppend _ =
test = 'let test = 'let
tempDir = toException (newTempDir "openFile") tempDir = newTempDir "openFile"
fooFile = tempDir ++ "/foo" fooFile = tempDir ++ "/foo"
handle1 = toException (openFile.impl fooFile FileMode.Write) handle1 = openFile fooFile FileMode.Write
toException (putBytes.impl handle1 (toUtf8 "test1")) putBytes handle1 (toUtf8 "test1")
toException (closeFile.impl handle1) closeFile handle1
handle2 = toException (openFile.impl fooFile FileMode.Append) handle2 = openFile fooFile FileMode.Append
toException (putBytes.impl handle2 (toUtf8 "test2")) putBytes handle2 (toUtf8 "test2")
toException (closeFile.impl handle2) closeFile handle2
handle3 = toException (openFile.impl fooFile FileMode.Read) handle3 = openFile fooFile FileMode.Read
bytes3 = toException (getBytes.impl handle3 1000) bytes3 = getBytes handle3 1000
text3 = toException (Text.fromUtf8.impl bytes3) text3 = Text.fromUtf8 bytes3
expectU "should be able to read our temporary file" "test1test2" text3 expectU "should be able to read our temporary file" "test1test2" text3
closeFile.impl handle3 closeFile handle3
runTest test runTest test
``` ```
@ -304,7 +155,7 @@ testAppend _ =
testSystemTime : '{io2.IO} [Result] testSystemTime : '{io2.IO} [Result]
testSystemTime _ = testSystemTime _ =
test = 'let test = 'let
t = toException !io2.IO.systemTime.impl t = !systemTime
check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000)) check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000))
runTest test runTest test
@ -313,11 +164,3 @@ testSystemTime _ =
.> add .> add
.> io.test testSystemTime .> io.test testSystemTime
``` ```
## MVars
MVars are threadsafe mutable locations which at any time may or may not
contain a signle typed value. They are a building block on which many
concurrency primitives can be built that allow multiple threads to
synchronize and share data.

269
unison-src/new-runtime-transcripts/io.output.md
View File

@ -1,4 +1,4 @@
# tests for IO / MVar # tests for built-in IO functions
Tests for IO builtins which wired to foreign haskell calls. Tests for IO builtins which wired to foreign haskell calls.
@ -10,183 +10,8 @@ TempDirs/autoCleaned is an ability/hanlder which allows you to easily
create a scratch directory which will automatically get cleaned up. create a scratch directory which will automatically get cleaned up.
```unison ```unison
use .builtin.io2 Failure
filter: (a -> Boolean) -> [a] -> [a]
filter f all =
go acc = cases
a +: as -> if (f a) then go (cons a acc) as else go acc as
[] -> acc
go [] all
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
-- An ability that facilitates creating temoporary directories that can be
-- automatically cleaned up
ability TempDirs where
newTempDir: Text -> Either Failure Text
removeDir: Text -> Either Failure ()
-- A handler for TempDirs which cleans up temporary directories
-- This will be useful for IO tests which need to interact with
-- the filesystem
autoCleaned.handler: '{io2.IO} (Request {TempDirs} r -> r)
autoCleaned.handler _ =
remover : [Text] -> {io2.IO} ()
remover = cases
a +: as -> removeDirectory.impl a
remover as
[] -> ()
go : [Text] -> {io2.IO} Request {TempDirs} r -> r
go dirs = cases
{ a } -> remover dirs
a
{ TempDirs.newTempDir prefix -> k } ->
dir = createTempDirectory prefix
match dir with
Right dir' -> handle k dir with go (dir' +: dirs)
Left _ -> handle k dir with go dirs
{ TempDirs.removeDir dir -> k } ->
handle k (removeDirectory.impl dir) with go (filter (d -> not (d == dir)) dirs)
go []
autoCleaned: '{io2.IO, TempDirs} r -> r
autoCleaned comp = handle !comp with !autoCleaned.handler
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
stdout = IO.stdHandle StdErr
printText : Text -> {io2.IO} Either Failure ()
printText t = putBytes.impl stdout (toUtf8 t)
expect : Text -> (a -> a -> Boolean) -> a -> a -> {Stream Result} ()
expect msg compare expected actual = if compare expected actual then emit (Ok msg) else emit (Fail msg)
expectU : Text -> a -> a -> {Stream Result} ()
expectU msg expected actual = expect msg (==) expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO, TempDirs} a -> ([Result], Either Failure a)
evalTest a = handle
(handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler)
with !autoCleaned.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO, TempDirs} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
``` ```
## Who watches the watchers?
First lets do some basic testing of our test harness to make sure its
working.
```unison
testAutoClean : '{io2.IO}[Result]
testAutoClean _ =
go: '{Stream Result, Exception Failure, io2.IO, TempDirs} Text
go _ =
dir = toException (newTempDir "autoclean")
check "our temporary directory should exist" (toException (isDirectory.impl dir))
dir
match evalTest go with
(results, Left (Failure _ t _)) -> results :+ (Fail t)
(results, Right dir) ->
match isDirectory.impl dir with
Right b -> if b
then results :+ (Fail "our temporary directory should no longer exist")
else results :+ (Ok "our temporary directory should no longer exist")
Left (Failure _ t _) -> results :+ (Fail t)
```
```ucm
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
testAutoClean : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
testAutoClean : '{io2.IO} [Result]
.> io.test testAutoClean
New test results:
◉ testAutoClean our temporary directory should exist
◉ testAutoClean our temporary directory should no longer exist
✅ 2 test(s) passing
Tip: Use view testAutoClean to view the source of a test.
```
## Basic File Functions ## Basic File Functions
### Creating/Deleting/Renaming Directories ### Creating/Deleting/Renaming Directories
@ -201,23 +26,23 @@ Tests: createDirectory,
testCreateRename : '{io2.IO} [Result] testCreateRename : '{io2.IO} [Result]
testCreateRename _ = testCreateRename _ =
test = 'let test = 'let
tempDir = toException (newTempDir "fileio") tempDir = newTempDir "fileio"
fooDir = tempDir ++ "/foo" fooDir = tempDir ++ "/foo"
barDir = tempDir ++ "/bar" barDir = tempDir ++ "/bar"
toException let createDirectory.impl fooDir createDirectory.impl fooDir
check "create a foo directory" (toException (isDirectory.impl fooDir)) check "create a foo directory" (isDirectory fooDir)
check "directory should exist" (toException (fileExists.impl fooDir)) check "directory should exist" (fileExists fooDir)
toException let renameDirectory.impl fooDir barDir renameDirectory fooDir barDir
check "foo should no longer exist" (not (toException (fileExists.impl fooDir))) check "foo should no longer exist" (not (fileExists fooDir))
check "directory should no longer exist" (not (toException (fileExists.impl fooDir))) check "directory should no longer exist" (not (fileExists fooDir))
check "bar should now exist" (toException (fileExists.impl barDir)) check "bar should now exist" (fileExists barDir)
bazDir = barDir ++ "/baz" bazDir = barDir ++ "/baz"
toException let createDirectory.impl bazDir createDirectory.impl bazDir
toException let removeDirectory.impl barDir removeDirectory.impl barDir
check "removeDirectory works recursively" (not (toException (isDirectory.impl barDir))) check "removeDirectory works recursively" (not (isDirectory barDir))
check "removeDirectory works recursively" (not (toException (isDirectory.impl bazDir))) check "removeDirectory works recursively" (not (isDirectory bazDir))
runTest test runTest test
``` ```
@ -267,12 +92,12 @@ Tests: openFile
testOpenClose : '{io2.IO} [Result] testOpenClose : '{io2.IO} [Result]
testOpenClose _ = testOpenClose _ =
test = 'let test = 'let
tempDir = toException (newTempDir "seek") tempDir = (newTempDir "seek")
fooFile = tempDir ++ "/foo" fooFile = tempDir ++ "/foo"
handle1 = toException (openFile.impl fooFile FileMode.Write) handle1 = openFile fooFile FileMode.Write
check "file should be open" (toException (isFileOpen.impl handle1)) check "file should be open" (isFileOpen handle1)
toException (closeFile.impl handle1) closeFile handle1
check "file should be closed" (not (toException (isFileOpen.impl handle1))) check "file should be closed" (not (isFileOpen handle1))
runTest test runTest test
``` ```
@ -321,48 +146,47 @@ Tests: openFile
testSeek : '{io2.IO} [Result] testSeek : '{io2.IO} [Result]
testSeek _ = testSeek _ =
test = 'let test = 'let
tempDir = toException (newTempDir "seek") tempDir = newTempDir "seek"
emit (Ok "seeked") emit (Ok "seeked")
fooFile = tempDir ++ "/foo" fooFile = tempDir ++ "/foo"
handle1 = toException (openFile.impl fooFile FileMode.Append) handle1 = openFile fooFile FileMode.Append
putBytes.impl handle1 (toUtf8 "12345678") putBytes handle1 (toUtf8 "12345678")
closeFile.impl handle1 closeFile handle1
handle3 = toException (openFile.impl fooFile FileMode.Read) handle3 = openFile fooFile FileMode.Read
check "readable file should be seekable" (toException (isSeekable.impl handle3)) check "readable file should be seekable" (isSeekable handle3)
check "shouldn't be the EOF" (not (toException (isFileEOF.impl handle3))) check "shouldn't be the EOF" (not (isFileEOF handle3))
expectU "we should be at position 0" 0 (toException (handlePosition.impl handle3)) expectU "we should be at position 0" 0 (handlePosition handle3)
toException (seekHandle.impl handle3 AbsoluteSeek +1) seekHandle handle3 AbsoluteSeek +1
expectU "we should be at position 1" 1 (toException (handlePosition.impl handle3)) expectU "we should be at position 1" 1 (handlePosition handle3)
bytes3a = toException (getBytes.impl handle3 1000) bytes3a = getBytes handle3 1000
text3a = toException (Text.fromUtf8.impl bytes3a) text3a = Text.fromUtf8 bytes3a
expectU "should be able to read our temporary file after seeking" "2345678" text3a expectU "should be able to read our temporary file after seeking" "2345678" text3a
closeFile.impl handle3 closeFile handle3
runTest test runTest test
testAppend : '{io2.IO} [Result] testAppend : '{io2.IO} [Result]
testAppend _ = testAppend _ =
test = 'let test = 'let
tempDir = toException (newTempDir "openFile") tempDir = newTempDir "openFile"
fooFile = tempDir ++ "/foo" fooFile = tempDir ++ "/foo"
handle1 = toException (openFile.impl fooFile FileMode.Write) handle1 = openFile fooFile FileMode.Write
toException (putBytes.impl handle1 (toUtf8 "test1")) putBytes handle1 (toUtf8 "test1")
toException (closeFile.impl handle1) closeFile handle1
handle2 = toException (openFile.impl fooFile FileMode.Append) handle2 = openFile fooFile FileMode.Append
toException (putBytes.impl handle2 (toUtf8 "test2")) putBytes handle2 (toUtf8 "test2")
toException (closeFile.impl handle2) closeFile handle2
handle3 = toException (openFile.impl fooFile FileMode.Read) handle3 = openFile fooFile FileMode.Read
bytes3 = toException (getBytes.impl handle3 1000) bytes3 = getBytes handle3 1000
text3 = toException (Text.fromUtf8.impl bytes3) text3 = Text.fromUtf8 bytes3
expectU "should be able to read our temporary file" "test1test2" text3 expectU "should be able to read our temporary file" "test1test2" text3
closeFile.impl handle3 closeFile handle3
runTest test runTest test
``` ```
@ -418,7 +242,7 @@ testAppend _ =
testSystemTime : '{io2.IO} [Result] testSystemTime : '{io2.IO} [Result]
testSystemTime _ = testSystemTime _ =
test = 'let test = 'let
t = toException !io2.IO.systemTime.impl t = !systemTime
check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000)) check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000))
runTest test runTest test
@ -453,10 +277,3 @@ testSystemTime _ =
Tip: Use view testSystemTime to view the source of a test. Tip: Use view testSystemTime to view the source of a test.
``` ```
## MVars
MVars are threadsafe mutable locations which at any time may or may not
contain a signle typed value. They are a building block on which many
concurrency primitives can be built that allow multiple threads to
synchronize and share data.

106
unison-src/new-runtime-transcripts/mvar.md
View File

@ -1,103 +1,5 @@
# tests for io2.MVar # tests for io2.MVar
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```unison:hide
use .builtin.io2 Failure
filter: (a -> Boolean) -> [a] -> [a]
filter f all =
go acc = cases
a +: as -> if (f a) then go (cons a acc) as else go acc as
[] -> acc
go [] all
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
stdout = IO.stdHandle StdErr
printText : Text -> {io2.IO} Either Failure ()
printText t = putBytes stdout (toUtf8 t)
expect : Text -> (a -> a -> Boolean) -> a -> a -> {Stream Result} ()
expect msg compare expected actual = if compare expected actual then emit (Ok msg) else emit (Fail msg)
expectU : Text -> a -> a -> {Stream Result} ()
expectU msg expected actual = expect msg (==) expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO, TempDirs} a -> ([Result], Either Failure a)
evalTest a = handle
(handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler)
with !autoCleaned.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO, TempDirs} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t)) -> results :+ (Fail t)
```
```ucm:hide
.> add
```
`MVar`s are mutable, sharable storage for a single value, which may or `MVar`s are mutable, sharable storage for a single value, which may or
may not be present at any given time. It is sharable in the sense that may not be present at any given time. It is sharable in the sense that
it is safe for multiple threads to attempt simultaneous reading and it is safe for multiple threads to attempt simultaneous reading and
@ -116,13 +18,13 @@ testMvars _ =
test2 = "test2" test2 = "test2"
ma = MVar.new test ma = MVar.new test
check "ma should not be empty" (not (isEmpty ma)) check "ma should not be empty" (not (isEmpty ma))
test' = toException (take ma) test' = take ma
expectU "should reap what you sow" test test' expectU "should reap what you sow" test test'
check "ma should be empty" (isEmpty ma) check "ma should be empty" (isEmpty ma)
toException (put ma test) put ma test
test'' = toException (swap ma test2) test'' = swap ma test2
expectU "swap returns old contents" test test'' expectU "swap returns old contents" test test''
test''' = toException (swap ma test) test''' = swap ma test
expectU "swap returns old contents" test2 test''' expectU "swap returns old contents" test2 test'''
ma2 = !MVar.newEmpty ma2 = !MVar.newEmpty

77
unison-src/new-runtime-transcripts/mvar.output.md Normal file
View File

@ -0,0 +1,77 @@
# tests for io2.MVar
`MVar`s are mutable, sharable storage for a single value, which may or
may not be present at any given time. It is sharable in the sense that
it is safe for multiple threads to attempt simultaneous reading and
writing to and from the same MVar safely.
MVars are the building block on which many other concurrency
primitives can be built, such as Futures, Run at most once initializer
blocks, Queues, etc.
```unison
testMvars: '{io2.IO}[Result]
testMvars _ =
test = 'let
test = "test"
test2 = "test2"
ma = MVar.new test
check "ma should not be empty" (not (isEmpty ma))
test' = take ma
expectU "should reap what you sow" test test'
check "ma should be empty" (isEmpty ma)
put ma test
test'' = swap ma test2
expectU "swap returns old contents" test test''
test''' = swap ma test
expectU "swap returns old contents" test2 test'''
ma2 = !MVar.newEmpty
check "tryTake should succeed when not empty" (not (isNone (tryTake ma)))
check "tryTake should not succeed when empty" (isNone (tryTake ma))
check "ma2 should be empty" (isEmpty ma2)
check "tryTake should fail when empty" (isNone (tryTake ma2))
runTest test
```
```ucm
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
testMvars : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
testMvars : '{io2.IO} [Result]
.> io.test testMvars
New test results:
◉ testMvars ma should not be empty
◉ testMvars should reap what you sow
◉ testMvars ma should be empty
◉ testMvars swap returns old contents
◉ testMvars swap returns old contents
◉ testMvars tryTake should succeed when not empty
◉ testMvars tryTake should not succeed when empty
◉ testMvars ma2 should be empty
◉ testMvars tryTake should fail when empty
✅ 9 test(s) passing
Tip: Use view testMvars to view the source of a test.
```

152
unison-src/new-runtime-transcripts/net.md
View File

@ -1,100 +1,20 @@
# Tests for network related builtins
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
```
```unison:hide ```unison:hide
use .builtin.io2 Failure serverSocket = compose2 reraise serverSocket.impl
ability Exception e where raise : e ->{Exception e} a socketPort = compose reraise socketPort.impl
listen = compose reraise listen.impl
toException : Either e a ->{Exception e} a closeSocket = compose reraise closeSocket.impl
toException = cases clientSocket = compose2 reraise clientSocket.impl
Left e -> raise e socketSend = compose2 reraise socketSend.impl
Right a -> a socketReceive = compose2 reraise socketReceive.impl
socketAccept = compose reraise socketAccept.impl
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO} a -> ([Result], Either Failure a)
evalTest a = handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
--
-- convenience functions for emitting test results
--
expect : (a -> Text) -> (a -> a -> Boolean) -> Text -> a -> a -> {Stream Result} ()
expect toText compare msg expected actual = let
if (compare expected actual) then
emit (Ok msg)
else let
failMsg = msg ++ "expected : " ++ (toText expected) ++ " actual: " ++ (toText actual)
emit (Fail failMsg)
expectU : (a -> Text) -> Text -> a -> a -> {Stream Result} ()
expectU toText msg expected actual = expect toText (==) msg expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
``` ```
```ucm:hide ```ucm:hide
.> add .> add
``` ```
# Tests for network related builtins
### Creating server sockets ### Creating server sockets
This section tests functions in the IO builtin related to binding to This section tests functions in the IO builtin related to binding to
@ -140,32 +60,32 @@ Below shows different examples of how we might specify the server coordinates.
testExplicitHost : '{io2.IO} [Result] testExplicitHost : '{io2.IO} [Result]
testExplicitHost _ = testExplicitHost _ =
test = 'let test = 'let
sock = toException (io2.IO.serverSocket.impl (Some "127.0.0.1") "1028") sock = serverSocket (Some "127.0.0.1") "1028"
emit (Ok "successfully created socket") emit (Ok "successfully created socket")
port = toException (socketPort sock) port = socketPort sock
putBytes.impl (stdHandle StdOut) (toUtf8 (toText port)) putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port expectU "should have bound to port 1028" 1028 port
runTest test runTest test
testDefaultHost : '{io2.IO} [Result] testDefaultHost : '{io2.IO} [Result]
testDefaultHost _ = testDefaultHost _ =
test = 'let test = 'let
sock = toException (io2.IO.serverSocket.impl None "1028") sock = serverSocket None "1028"
emit (Ok "successfully created socket") emit (Ok "successfully created socket")
port = toException (socketPort sock) port = socketPort sock
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port))) putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port expectU "should have bound to port 1028" 1028 port
runTest test runTest test
testDefaultPort : '{io2.IO} [Result] testDefaultPort : '{io2.IO} [Result]
testDefaultPort _ = testDefaultPort _ =
test = 'let test = 'let
sock = toException (io2.IO.serverSocket.impl None "0") sock = serverSocket None "0"
emit (Ok "successfully created socket") emit (Ok "successfully created socket")
port = toException (socketPort sock) port = socketPort sock
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port))) putBytes (stdHandle StdOut) (toUtf8 (toText port))
check "port should be > 1024" (1024 < port) check "port should be > 1024" (1024 < port)
check "port should be < 65536" (65536 > port) check "port should be < 65536" (65536 > port)
@ -183,14 +103,15 @@ This example demonstrates connecting a TCP client socket to a TCP server socket.
serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let serverThread portVar toSend = 'let
go : '{io2.IO, Exception}()
go = 'let go = 'let
sock = toException (serverSocket.impl (Some "127.0.0.1") "0") sock = serverSocket (Some "127.0.0.1") "0"
port = toException (socketPort sock) port = socketPort sock
toException (put.impl portVar port) put portVar port
toException (listen.impl sock) listen sock
sock' = toException (socketAccept.impl sock) sock' = socketAccept sock
toException (socketSend.impl sock' (toUtf8 toSend)) socketSend sock' (toUtf8 toSend)
toException (closeSocket.impl sock') closeSocket sock'
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -198,12 +119,11 @@ serverThread portVar toSend = 'let
clientThread : MVar Nat -> MVar Text -> '{io2.IO}() clientThread : MVar Nat -> MVar Text -> '{io2.IO}()
clientThread portVar resultVar = 'let clientThread portVar resultVar = 'let
go : '{io2.IO, Exception Failure}()
go = 'let go = 'let
port = toException (take.impl portVar) port = take portVar
sock = toException (clientSocket.impl "127.0.0.1" (Nat.toText port)) sock = clientSocket "127.0.0.1" (Nat.toText port)
msg = toException (fromUtf8.impl (toException (socketReceive.impl sock 100))) msg = fromUtf8 (socketReceive sock 100)
toException (put.impl resultVar msg) put resultVar msg
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -220,9 +140,9 @@ testTcpConnect = 'let
forkComp (serverThread portVar toSend) forkComp (serverThread portVar toSend)
forkComp (clientThread portVar resultVar) forkComp (clientThread portVar resultVar)
received = toException (take.impl resultVar) received = take resultVar
expectU (a->a) "should have reaped what we've sown" toSend received expectU "should have reaped what we've sown" toSend received
runTest test runTest test

145
unison-src/new-runtime-transcripts/net.output.md
View File

@ -1,91 +1,16 @@
# Tests for network related builtins
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```unison ```unison
use .builtin.io2 Failure serverSocket = compose2 reraise serverSocket.impl
ability Exception e where raise : e ->{Exception e} a socketPort = compose reraise socketPort.impl
listen = compose reraise listen.impl
toException : Either e a ->{Exception e} a closeSocket = compose reraise closeSocket.impl
toException = cases clientSocket = compose2 reraise clientSocket.impl
Left e -> raise e socketSend = compose2 reraise socketSend.impl
Right a -> a socketReceive = compose2 reraise socketReceive.impl
socketAccept = compose reraise socketAccept.impl
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO} a -> ([Result], Either Failure a)
evalTest a = handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
--
-- convenience functions for emitting test results
--
expect : (a -> Text) -> (a -> a -> Boolean) -> Text -> a -> a -> {Stream Result} ()
expect toText compare msg expected actual = let
if (compare expected actual) then
emit (Ok msg)
else let
failMsg = msg ++ "expected : " ++ (toText expected) ++ " actual: " ++ (toText actual)
emit (Fail failMsg)
expectU : (a -> Text) -> Text -> a -> a -> {Stream Result} ()
expectU toText msg expected actual = expect toText (==) msg expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
``` ```
# Tests for network related builtins
### Creating server sockets ### Creating server sockets
This section tests functions in the IO builtin related to binding to This section tests functions in the IO builtin related to binding to
@ -133,32 +58,32 @@ Below shows different examples of how we might specify the server coordinates.
testExplicitHost : '{io2.IO} [Result] testExplicitHost : '{io2.IO} [Result]
testExplicitHost _ = testExplicitHost _ =
test = 'let test = 'let
sock = toException (io2.IO.serverSocket.impl (Some "127.0.0.1") "1028") sock = serverSocket (Some "127.0.0.1") "1028"
emit (Ok "successfully created socket") emit (Ok "successfully created socket")
port = toException (socketPort sock) port = socketPort sock
putBytes.impl (stdHandle StdOut) (toUtf8 (toText port)) putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port expectU "should have bound to port 1028" 1028 port
runTest test runTest test
testDefaultHost : '{io2.IO} [Result] testDefaultHost : '{io2.IO} [Result]
testDefaultHost _ = testDefaultHost _ =
test = 'let test = 'let
sock = toException (io2.IO.serverSocket.impl None "1028") sock = serverSocket None "1028"
emit (Ok "successfully created socket") emit (Ok "successfully created socket")
port = toException (socketPort sock) port = socketPort sock
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port))) putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port expectU "should have bound to port 1028" 1028 port
runTest test runTest test
testDefaultPort : '{io2.IO} [Result] testDefaultPort : '{io2.IO} [Result]
testDefaultPort _ = testDefaultPort _ =
test = 'let test = 'let
sock = toException (io2.IO.serverSocket.impl None "0") sock = serverSocket None "0"
emit (Ok "successfully created socket") emit (Ok "successfully created socket")
port = toException (socketPort sock) port = socketPort sock
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port))) putBytes (stdHandle StdOut) (toUtf8 (toText port))
check "port should be > 1024" (1024 < port) check "port should be > 1024" (1024 < port)
check "port should be < 65536" (65536 > port) check "port should be < 65536" (65536 > port)
@ -206,14 +131,15 @@ This example demonstrates connecting a TCP client socket to a TCP server socket.
```unison ```unison
serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let serverThread portVar toSend = 'let
go : '{io2.IO, Exception}()
go = 'let go = 'let
sock = toException (serverSocket.impl (Some "127.0.0.1") "0") sock = serverSocket (Some "127.0.0.1") "0"
port = toException (socketPort sock) port = socketPort sock
toException (put.impl portVar port) put portVar port
toException (listen.impl sock) listen sock
sock' = toException (socketAccept.impl sock) sock' = socketAccept sock
toException (socketSend.impl sock' (toUtf8 toSend)) socketSend sock' (toUtf8 toSend)
toException (closeSocket.impl sock') closeSocket sock'
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -221,12 +147,11 @@ serverThread portVar toSend = 'let
clientThread : MVar Nat -> MVar Text -> '{io2.IO}() clientThread : MVar Nat -> MVar Text -> '{io2.IO}()
clientThread portVar resultVar = 'let clientThread portVar resultVar = 'let
go : '{io2.IO, Exception Failure}()
go = 'let go = 'let
port = toException (take.impl portVar) port = take portVar
sock = toException (clientSocket.impl "127.0.0.1" (Nat.toText port)) sock = clientSocket "127.0.0.1" (Nat.toText port)
msg = toException (fromUtf8.impl (toException (socketReceive.impl sock 100))) msg = fromUtf8 (socketReceive sock 100)
toException (put.impl resultVar msg) put resultVar msg
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -243,9 +168,9 @@ testTcpConnect = 'let
forkComp (serverThread portVar toSend) forkComp (serverThread portVar toSend)
forkComp (clientThread portVar resultVar) forkComp (clientThread portVar resultVar)
received = toException (take.impl resultVar) received = take resultVar
expectU (a->a) "should have reaped what we've sown" toSend received expectU "should have reaped what we've sown" toSend received
runTest test runTest test

42
unison-src/new-runtime-transcripts/stm.md
View File

@ -1,51 +1,19 @@
```ucm
.> builtins.merge
```
Standard helpful definitions
```unison
use io2
stdout : Handle
stdout = stdHandle StdOut
putLn : Text ->{IO} ()
putLn t =
putBytes.impl stdout (toUtf8 (t ++ "\n"))
()
map : (a ->{e} b) -> [a] ->{e} [b]
map f l = let
go acc = cases
[] -> acc
x +: xs -> go (acc :+ f x) xs
go [] l
```
```ucm
.> add
```
Loops that access a shared counter variable, accessed in transactions. Loops that access a shared counter variable, accessed in transactions.
Some thread delaying is just accomplished by counting in a loop. Some thread delaying is just accomplished by counting in a loop.
```unison ```unison
use io2
count : Nat -> () count : Nat -> ()
count = cases count = cases
0 -> () 0 -> ()
n -> count (drop n 1) n -> count (drop n 1)
inc : TVar Nat ->{IO} Nat inc : TVar Nat ->{io2.IO} Nat
inc v = inc v =
atomically 'let atomically 'let
x = TVar.read v x = TVar.read v
TVar.write v (x+1) TVar.write v (x+1)
x x
loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat loop : '{io2.IO} Nat -> Nat -> Nat ->{io2.IO} Nat
loop grab acc = cases loop grab acc = cases
0 -> acc 0 -> acc
n -> n ->
@ -53,7 +21,7 @@ loop grab acc = cases
count (m*10) count (m*10)
loop grab (acc+m) (drop n 1) loop grab (acc+m) (drop n 1)
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} () body : Nat -> TVar (Optional Nat) -> TVar Nat ->{io2.IO} ()
body k out v = body k out v =
n = loop '(inc v) 0 k n = loop '(inc v) 0 k
atomically '(TVar.write out (Some n)) atomically '(TVar.write out (Some n))
@ -66,7 +34,7 @@ body k out v =
Test case. Test case.
```unison ```unison
spawn : Nat ->{IO} Result spawn : Nat ->{io2.IO} Result
spawn k = let spawn k = let
out1 = TVar.newIO None out1 = TVar.newIO None
out2 = TVar.newIO None out2 = TVar.newIO None
@ -94,7 +62,7 @@ display m n s =
nats : [Nat] nats : [Nat]
nats = [89,100,116,144,169,188,200,233,256,300] nats = [89,100,116,144,169,188,200,233,256,300]
tests : '{IO} [Result] tests : '{io2.IO} [Result]
tests = '(map spawn nats) tests = '(map spawn nats)
``` ```

92
unison-src/new-runtime-transcripts/stm.output.md
View File

@ -1,72 +1,19 @@
```ucm
.> builtins.merge
Done.
```
Standard helpful definitions
```unison
use io2
stdout : Handle
stdout = stdHandle StdOut
putLn : Text ->{IO} ()
putLn t =
putBytes.impl stdout (toUtf8 (t ++ "\n"))
()
map : (a ->{e} b) -> [a] ->{e} [b]
map f l = let
go acc = cases
[] -> acc
x +: xs -> go (acc :+ f x) xs
go [] l
```
```ucm
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
map : (a ->{e} b) -> [a] ->{e} [b]
putLn : Text ->{IO} ()
stdout : Handle
```
```ucm
.> add
⍟ I've added these definitions:
map : (a ->{e} b) -> [a] ->{e} [b]
putLn : Text ->{IO} ()
stdout : Handle
```
Loops that access a shared counter variable, accessed in transactions. Loops that access a shared counter variable, accessed in transactions.
Some thread delaying is just accomplished by counting in a loop. Some thread delaying is just accomplished by counting in a loop.
```unison ```unison
use io2
count : Nat -> () count : Nat -> ()
count = cases count = cases
0 -> () 0 -> ()
n -> count (drop n 1) n -> count (drop n 1)
inc : TVar Nat ->{IO} Nat inc : TVar Nat ->{io2.IO} Nat
inc v = inc v =
atomically 'let atomically 'let
x = TVar.read v x = TVar.read v
TVar.write v (x+1) TVar.write v (x+1)
x x
loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat loop : '{io2.IO} Nat -> Nat -> Nat ->{io2.IO} Nat
loop grab acc = cases loop grab acc = cases
0 -> acc 0 -> acc
n -> n ->
@ -74,7 +21,7 @@ loop grab acc = cases
count (m*10) count (m*10)
loop grab (acc+m) (drop n 1) loop grab (acc+m) (drop n 1)
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} () body : Nat -> TVar (Optional Nat) -> TVar Nat ->{io2.IO} ()
body k out v = body k out v =
n = loop '(inc v) 0 k n = loop '(inc v) 0 k
atomically '(TVar.write out (Some n)) atomically '(TVar.write out (Some n))
@ -88,10 +35,16 @@ body k out v =
⍟ These new definitions are ok to `add`: ⍟ These new definitions are ok to `add`:
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} () body : Nat
-> TVar (Optional Nat)
-> TVar Nat
->{io2.IO} ()
count : Nat -> () count : Nat -> ()
inc : TVar Nat ->{IO} Nat inc : TVar Nat ->{io2.IO} Nat
loop : '{IO} Nat ->{IO} Nat ->{IO} Nat ->{IO} Nat loop : '{io2.IO} Nat
->{io2.IO} Nat
->{io2.IO} Nat
->{io2.IO} Nat
``` ```
```ucm ```ucm
@ -99,16 +52,19 @@ body k out v =
⍟ I've added these definitions: ⍟ I've added these definitions:
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} () body : Nat -> TVar (Optional Nat) -> TVar Nat ->{io2.IO} ()
count : Nat -> () count : Nat -> ()
inc : TVar Nat ->{IO} Nat inc : TVar Nat ->{io2.IO} Nat
loop : '{IO} Nat ->{IO} Nat ->{IO} Nat ->{IO} Nat loop : '{io2.IO} Nat
->{io2.IO} Nat
->{io2.IO} Nat
->{io2.IO} Nat
``` ```
Test case. Test case.
```unison ```unison
spawn : Nat ->{IO} Result spawn : Nat ->{io2.IO} Result
spawn k = let spawn k = let
out1 = TVar.newIO None out1 = TVar.newIO None
out2 = TVar.newIO None out2 = TVar.newIO None
@ -136,7 +92,7 @@ display m n s =
nats : [Nat] nats : [Nat]
nats = [89,100,116,144,169,188,200,233,256,300] nats = [89,100,116,144,169,188,200,233,256,300]
tests : '{IO} [Result] tests : '{io2.IO} [Result]
tests = '(map spawn nats) tests = '(map spawn nats)
``` ```
@ -150,8 +106,8 @@ tests = '(map spawn nats)
display : Nat -> Nat -> Nat -> Text display : Nat -> Nat -> Nat -> Text
nats : [Nat] nats : [Nat]
spawn : Nat ->{IO} Result spawn : Nat ->{io2.IO} Result
tests : '{IO} [Result] tests : '{io2.IO} [Result]
``` ```
```ucm ```ucm
@ -161,8 +117,8 @@ tests = '(map spawn nats)
display : Nat -> Nat -> Nat -> Text display : Nat -> Nat -> Nat -> Text
nats : [Nat] nats : [Nat]
spawn : Nat ->{IO} Result spawn : Nat ->{io2.IO} Result
tests : '{IO} [Result] tests : '{io2.IO} [Result]
.> io.test tests .> io.test tests

116
unison-src/new-runtime-transcripts/thread.md
View File

@ -1,97 +1,3 @@
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
```
```unison:hide
use .builtin.io2 Failure
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO} a -> ([Result], Either Failure a)
evalTest a = handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
--
-- convenience functions for emitting test results
--
expect : (a -> Text) -> (a -> a -> Boolean) -> Text -> a -> a -> {Stream Result} ()
expect toText compare msg expected actual = let
if (compare expected actual) then
emit (Ok msg)
else let
failMsg = msg ++ "expected : " ++ (toText expected) ++ " actual: " ++ (toText actual)
emit (Fail failMsg)
expectU : (a -> Text) -> Text -> a -> a -> {Stream Result} ()
expectU toText msg expected actual = expect toText (==) msg expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
```
```ucm:hide
.> add
```
Lets just make sure we can start a thread Lets just make sure we can start a thread
@ -121,10 +27,9 @@ See if we can get another thread to stuff a value into a MVar
```unison ```unison
thread1 : MVar Nat -> '{io2.IO}() thread1 : MVar Nat -> '{io2.IO}()
thread1 mv = 'let thread1 mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let go = 'let
x = toException (take.impl mv) x = take mv
toException (put.impl mv (increment x)) put mv (increment x)
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -133,12 +38,11 @@ thread1 mv = 'let
testBasicMultiThreadMVar : '{io2.IO} [Result] testBasicMultiThreadMVar : '{io2.IO} [Result]
testBasicMultiThreadMVar = 'let testBasicMultiThreadMVar = 'let
test: '{io2.IO, Exception Failure, Stream Result} ()
test = 'let test = 'let
mv = new 10 mv = new 10
.builtin.io2.IO.forkComp (thread1 mv) .builtin.io2.IO.forkComp (thread1 mv)
next = toException (take.impl mv) next = take mv
expectU Nat.toText "other thread should have incremented" 11 next expectU "other thread should have incremented" 11 next
runTest test runTest test
@ -153,9 +57,8 @@ testBasicMultiThreadMVar = 'let
```unison ```unison
sendingThread: Nat -> MVar Nat -> '{io2.IO}() sendingThread: Nat -> MVar Nat -> '{io2.IO}()
sendingThread toSend mv = 'let sendingThread toSend mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let go = 'let
toException (put.impl mv (increment toSend)) put mv (increment toSend)
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -164,10 +67,9 @@ sendingThread toSend mv = 'let
receivingThread: MVar Nat -> MVar Text -> '{io2.IO}() receivingThread: MVar Nat -> MVar Text -> '{io2.IO}()
receivingThread recv send = 'let receivingThread recv send = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let go = 'let
recvd = toException (take.impl recv) recvd = take recv
toException (put.impl send (toText recvd)) put send (toText recvd)
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -182,9 +84,9 @@ testTwoThreads = 'let
.builtin.io2.IO.forkComp (sendingThread 6 send) .builtin.io2.IO.forkComp (sendingThread 6 send)
.builtin.io2.IO.forkComp (receivingThread send recv) .builtin.io2.IO.forkComp (receivingThread send recv)
recvd = toException (take.impl recv) recvd = take recv
expectU (x->x) "" "7" recvd expectU "" "7" recvd
runTest test runTest test

107
unison-src/new-runtime-transcripts/thread.output.md
View File

@ -1,88 +1,3 @@
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```unison
use .builtin.io2 Failure
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO} a -> ([Result], Either Failure a)
evalTest a = handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
--
-- convenience functions for emitting test results
--
expect : (a -> Text) -> (a -> a -> Boolean) -> Text -> a -> a -> {Stream Result} ()
expect toText compare msg expected actual = let
if (compare expected actual) then
emit (Ok msg)
else let
failMsg = msg ++ "expected : " ++ (toText expected) ++ " actual: " ++ (toText actual)
emit (Fail failMsg)
expectU : (a -> Text) -> Text -> a -> a -> {Stream Result} ()
expectU toText msg expected actual = expect toText (==) msg expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
```
Lets just make sure we can start a thread Lets just make sure we can start a thread
@ -119,10 +34,9 @@ See if we can get another thread to stuff a value into a MVar
```unison ```unison
thread1 : MVar Nat -> '{io2.IO}() thread1 : MVar Nat -> '{io2.IO}()
thread1 mv = 'let thread1 mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let go = 'let
x = toException (take.impl mv) x = take mv
toException (put.impl mv (increment x)) put mv (increment x)
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -131,12 +45,11 @@ thread1 mv = 'let
testBasicMultiThreadMVar : '{io2.IO} [Result] testBasicMultiThreadMVar : '{io2.IO} [Result]
testBasicMultiThreadMVar = 'let testBasicMultiThreadMVar = 'let
test: '{io2.IO, Exception Failure, Stream Result} ()
test = 'let test = 'let
mv = new 10 mv = new 10
.builtin.io2.IO.forkComp (thread1 mv) .builtin.io2.IO.forkComp (thread1 mv)
next = toException (take.impl mv) next = take mv
expectU Nat.toText "other thread should have incremented" 11 next expectU "other thread should have incremented" 11 next
runTest test runTest test
@ -178,9 +91,8 @@ testBasicMultiThreadMVar = 'let
```unison ```unison
sendingThread: Nat -> MVar Nat -> '{io2.IO}() sendingThread: Nat -> MVar Nat -> '{io2.IO}()
sendingThread toSend mv = 'let sendingThread toSend mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let go = 'let
toException (put.impl mv (increment toSend)) put mv (increment toSend)
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -189,10 +101,9 @@ sendingThread toSend mv = 'let
receivingThread: MVar Nat -> MVar Text -> '{io2.IO}() receivingThread: MVar Nat -> MVar Text -> '{io2.IO}()
receivingThread recv send = 'let receivingThread recv send = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let go = 'let
recvd = toException (take.impl recv) recvd = take recv
toException (put.impl send (toText recvd)) put send (toText recvd)
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch t () Left (Failure _ t _) -> watch t ()
@ -207,9 +118,9 @@ testTwoThreads = 'let
.builtin.io2.IO.forkComp (sendingThread 6 send) .builtin.io2.IO.forkComp (sendingThread 6 send)
.builtin.io2.IO.forkComp (receivingThread send recv) .builtin.io2.IO.forkComp (receivingThread send recv)
recvd = toException (take.impl recv) recvd = take recv
expectU (x->x) "" "7" recvd expectU "" "7" recvd
runTest test runTest test

150
unison-src/new-runtime-transcripts/tls.md
View File

@ -1,120 +1,13 @@
# Tests for TLS builtins # Tests for TLS builtins
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
```
```unison:hide ```unison:hide
use .builtin.io2 Failure
a |> f = f a
startsWith : Text -> Text -> Boolean
startsWith prefix text = (eq (Text.take (size prefix) text) prefix)
contains : Text -> Text -> Boolean
contains needle haystack = if (size haystack) == 0 then false else
if startsWith needle haystack then true else
contains needle (drop 1 haystack)
filter: (a -> Boolean) -> [a] -> [a]
filter f all =
go acc = cases
a +: as -> if (f a) then go (cons a acc) as else go acc as
[] -> acc
go [] all
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO} a -> ([Result], Either Failure a)
evalTest a = handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
--
-- convenience functions for emitting test results
--
expect : (a -> Text) -> (a -> a -> Boolean) -> Text -> a -> a -> {Stream Result} ()
expect toText compare msg expected actual = let
if (compare expected actual) then
emit (Ok msg)
else let
failMsg = msg ++ "expected : " ++ (toText expected) ++ " actual: " ++ (toText actual)
emit (Fail failMsg)
expectU : (a -> Text) -> Text -> a -> a -> {Stream Result} ()
expectU toText msg expected actual = expect toText (==) msg expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
-- generated with: -- generated with:
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 365 -out cert.pem -- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 365 -out cert.pem
self_signed_key_pem = "-----BEGIN PRIVATE KEY-----\nMIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQDBrpp+SxjCz/aQ\nQXT2hKXrT3lZ3Ek1VT/kgNre3J/RUyNZjZnZXCMyNjZ4IxYKxcCAIgGtfFpgvkzT\n5NRGZKLlSX4Y8HayV3gdEXO9hq4w/i/s+I0tOAJkVtHolXrrziZ7/4NZwMTbbqhO\n5hHHhbtBIpvNSw8el3AY3APkQ37+wM3fbvyeuG0ekoLqTa371W+/Z7pOi7QXYGEa\n8YHSNkuRKY46C4Y8oeWHOlSbQKu151GLuyQu74bnecGDN4KBdz9nyyKCCTpBsJpU\ni9Ozq3cps5L8dnN1zUNgaTyWp9kO3vbaTU8MY7p/dc7hNJ8pmGtSiiSs1xvni4Xl\nCBXBesxTAgMBAAECggEAAUtfcPSjh7nIFhK562PbkAUJ9JXKT3bwZGCQFek3kDiU\nBecyXgeFnLJMDuV9IjlMHg8cH8Ky/+6FqOzglk/Z3tps41HIGU0IWnlhYqThySYJ\nv/WxS9oR+gWyhXFqTuUj0LRWdmUZa7YDnfNfrwuvwrGuhOK5iSTN9PyTchUZZi50\ntxcNS/C3rk63c7TZLfuwxwGoUCeJvZZ/rmeVchhsuoo3QdSW0Aee7UtFtnvBfLCK\nXKdz+3q49fLZlDyx9/olJh+TY7GuF+G/LSfyQGi85beQhkXUH8/gIQIRI8INIEPB\n0XeTlv7Sgw5upqplJvHCXjAa+jz/Mo87znXBTMoIIQKBgQDorAlZCjzKxGDIaZoD\nDBXYzhSnnIhthThW4edCQ9/ZnJpX4vdTw4FngW504d8SPStMCYeBeMt8iwTczI4W\nHfK+AlVTlPfH/9NnIVADqqr9kobJW6782MYSW2/758d+L5bq8NGATyh8nPll9joN\nYAk7tNO2bGO2bEk2DbZMf3qnOQKBgQDVGdD005kUT3D+DfgeLTGzwk/2wCCPjoJ5\n6fsjsFAeZWU/qioIB3xHt1w8NsT6O+7XOKp/GRbsvsJR9Z/zmA3Ii5yrHYn48UzM\n+UyGLv+2HCpO+8A3szz/aDhKIxNFpXyZzvOXdtqBwTQbICOW2WRWOOgDrS2W1i9l\nD69xRLqj6wKBgBW0xwJ5hAZen7DSuT2DiR46y45/efLNtN3WIV77OgzxIS0FzZEQ\n8ieX2Zgp4kevUTS8xtl7TXCG/6MhqjfB/31edltf0GXmJfC/GNneuCkD3HM4jHCm\nQIRB54aWrvPEuM2ePc08lUha1KGAgRXyWaoqSn4ASqUgIQxb5x/n3KdxAoGAXlD0\nyMc2Q2T9r5PjMwfxrYvc9GsIfkEmwmqqupr4etuJumnH/JHDkcI30nazK8WG6j6s\nR2CFYvby7m92AcxUnWQdTSbfwAycX0QfeGwoxSMmHpsR8hUkdC5ea4Gmr/aUdUbB\nTVJPV4p5U2AgIE3LONYq6iWlvdLCW0pb7hfrO00CgYAb8bXz9BNow4soEkSbQysg\n4sGAr1+iSPY+ErffKRDpcFRnWcQdnTfI4xd8bgnC6OZwVpLbRZaZf3opDJ+axWqa\nEgAeHErTDY4R8aMecvyQj780sQ35kVq4VK0rSQyiKRBcjEust8UEzwYsUog2ysN0\n3zLHVEvFTfwOSctnEQRw1w==\n-----END PRIVATE KEY-----\n" self_signed_key_pem = "-----BEGIN PRIVATE KEY-----\nMIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQDBrpp+SxjCz/aQ\nQXT2hKXrT3lZ3Ek1VT/kgNre3J/RUyNZjZnZXCMyNjZ4IxYKxcCAIgGtfFpgvkzT\n5NRGZKLlSX4Y8HayV3gdEXO9hq4w/i/s+I0tOAJkVtHolXrrziZ7/4NZwMTbbqhO\n5hHHhbtBIpvNSw8el3AY3APkQ37+wM3fbvyeuG0ekoLqTa371W+/Z7pOi7QXYGEa\n8YHSNkuRKY46C4Y8oeWHOlSbQKu151GLuyQu74bnecGDN4KBdz9nyyKCCTpBsJpU\ni9Ozq3cps5L8dnN1zUNgaTyWp9kO3vbaTU8MY7p/dc7hNJ8pmGtSiiSs1xvni4Xl\nCBXBesxTAgMBAAECggEAAUtfcPSjh7nIFhK562PbkAUJ9JXKT3bwZGCQFek3kDiU\nBecyXgeFnLJMDuV9IjlMHg8cH8Ky/+6FqOzglk/Z3tps41HIGU0IWnlhYqThySYJ\nv/WxS9oR+gWyhXFqTuUj0LRWdmUZa7YDnfNfrwuvwrGuhOK5iSTN9PyTchUZZi50\ntxcNS/C3rk63c7TZLfuwxwGoUCeJvZZ/rmeVchhsuoo3QdSW0Aee7UtFtnvBfLCK\nXKdz+3q49fLZlDyx9/olJh+TY7GuF+G/LSfyQGi85beQhkXUH8/gIQIRI8INIEPB\n0XeTlv7Sgw5upqplJvHCXjAa+jz/Mo87znXBTMoIIQKBgQDorAlZCjzKxGDIaZoD\nDBXYzhSnnIhthThW4edCQ9/ZnJpX4vdTw4FngW504d8SPStMCYeBeMt8iwTczI4W\nHfK+AlVTlPfH/9NnIVADqqr9kobJW6782MYSW2/758d+L5bq8NGATyh8nPll9joN\nYAk7tNO2bGO2bEk2DbZMf3qnOQKBgQDVGdD005kUT3D+DfgeLTGzwk/2wCCPjoJ5\n6fsjsFAeZWU/qioIB3xHt1w8NsT6O+7XOKp/GRbsvsJR9Z/zmA3Ii5yrHYn48UzM\n+UyGLv+2HCpO+8A3szz/aDhKIxNFpXyZzvOXdtqBwTQbICOW2WRWOOgDrS2W1i9l\nD69xRLqj6wKBgBW0xwJ5hAZen7DSuT2DiR46y45/efLNtN3WIV77OgzxIS0FzZEQ\n8ieX2Zgp4kevUTS8xtl7TXCG/6MhqjfB/31edltf0GXmJfC/GNneuCkD3HM4jHCm\nQIRB54aWrvPEuM2ePc08lUha1KGAgRXyWaoqSn4ASqUgIQxb5x/n3KdxAoGAXlD0\nyMc2Q2T9r5PjMwfxrYvc9GsIfkEmwmqqupr4etuJumnH/JHDkcI30nazK8WG6j6s\nR2CFYvby7m92AcxUnWQdTSbfwAycX0QfeGwoxSMmHpsR8hUkdC5ea4Gmr/aUdUbB\nTVJPV4p5U2AgIE3LONYq6iWlvdLCW0pb7hfrO00CgYAb8bXz9BNow4soEkSbQysg\n4sGAr1+iSPY+ErffKRDpcFRnWcQdnTfI4xd8bgnC6OZwVpLbRZaZf3opDJ+axWqa\nEgAeHErTDY4R8aMecvyQj780sQ35kVq4VK0rSQyiKRBcjEust8UEzwYsUog2ysN0\n3zLHVEvFTfwOSctnEQRw1w==\n-----END PRIVATE KEY-----\n"
self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk1rv2Sx5XSK17BZSV4t7gwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjEwMTIyMDkxMTE3WhcNMjIwMTIyMDkxMTE3WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMGumn5L\nGMLP9pBBdPaEpetPeVncSTVVP+SA2t7cn9FTI1mNmdlcIzI2NngjFgrFwIAiAa18\nWmC+TNPk1EZkouVJfhjwdrJXeB0Rc72GrjD+L+z4jS04AmRW0eiVeuvOJnv/g1nA\nxNtuqE7mEceFu0Eim81LDx6XcBjcA+RDfv7Azd9u/J64bR6SgupNrfvVb79nuk6L\ntBdgYRrxgdI2S5EpjjoLhjyh5Yc6VJtAq7XnUYu7JC7vhud5wYM3goF3P2fLIoIJ\nOkGwmlSL07Ordymzkvx2c3XNQ2BpPJan2Q7e9tpNTwxjun91zuE0nymYa1KKJKzX\nG+eLheUIFcF6zFMCAwEAAaNTMFEwHQYDVR0OBBYEFFE3RQYASDWtwSdXL+qtQrjy\nH4SZMB8GA1UdIwQYMBaAFFE3RQYASDWtwSdXL+qtQrjyH4SZMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAH7D8W68cR0QvNNPugCY7lPvA/F94Qam\nwCC2A55edcagfjqFy77xx4Ljrd2TC19yiSzyeeJ+YuohbcipLce90BaaaiYq9aah\n5DICDCUhm1qbhJzqNB2Lqgl4aN+jRMeRVC+rpQBYBNmdPBqdv/k+T2uyghwmLWXe\n/AxCjCLA0zoYzOMytS86veD6CQbF5DpSTZx5dyZTeGhk2izhoM8cgiu+/7YncAbJ\nt7b7UT5Yu3+z1hAdUF5Q21bkEksGBC8UW0G0PMy8XNRMuMsz+2LC39u3u7QyX/+e\nuQGST3aCreV27zd0lrF8LHjwD2XcjVVzHy46VYQvf1r+6gatedDBjqc=\n-----END CERTIFICATE-----\n" self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk1rv2Sx5XSK17BZSV4t7gwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjEwMTIyMDkxMTE3WhcNMjIwMTIyMDkxMTE3WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMGumn5L\nGMLP9pBBdPaEpetPeVncSTVVP+SA2t7cn9FTI1mNmdlcIzI2NngjFgrFwIAiAa18\nWmC+TNPk1EZkouVJfhjwdrJXeB0Rc72GrjD+L+z4jS04AmRW0eiVeuvOJnv/g1nA\nxNtuqE7mEceFu0Eim81LDx6XcBjcA+RDfv7Azd9u/J64bR6SgupNrfvVb79nuk6L\ntBdgYRrxgdI2S5EpjjoLhjyh5Yc6VJtAq7XnUYu7JC7vhud5wYM3goF3P2fLIoIJ\nOkGwmlSL07Ordymzkvx2c3XNQ2BpPJan2Q7e9tpNTwxjun91zuE0nymYa1KKJKzX\nG+eLheUIFcF6zFMCAwEAAaNTMFEwHQYDVR0OBBYEFFE3RQYASDWtwSdXL+qtQrjy\nH4SZMB8GA1UdIwQYMBaAFFE3RQYASDWtwSdXL+qtQrjyH4SZMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAH7D8W68cR0QvNNPugCY7lPvA/F94Qam\nwCC2A55edcagfjqFy77xx4Ljrd2TC19yiSzyeeJ+YuohbcipLce90BaaaiYq9aah\n5DICDCUhm1qbhJzqNB2Lqgl4aN+jRMeRVC+rpQBYBNmdPBqdv/k+T2uyghwmLWXe\n/AxCjCLA0zoYzOMytS86veD6CQbF5DpSTZx5dyZTeGhk2izhoM8cgiu+/7YncAbJ\nt7b7UT5Yu3+z1hAdUF5Q21bkEksGBC8UW0G0PMy8XNRMuMsz+2LC39u3u7QyX/+e\nuQGST3aCreV27zd0lrF8LHjwD2XcjVVzHy46VYQvf1r+6gatedDBjqc=\n-----END CERTIFICATE-----\n"
``` ```
```ucm:hide ```ucm:hide
@ -126,7 +19,7 @@ self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk
First lets make sure we can load our cert and private key First lets make sure we can load our cert and private key
```unison ```unison
test> match (decodeCert (toUtf8 self_signed_cert_pem) with test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
Left (Failure _ t _) -> [Fail t] Left (Failure _ t _) -> [Fail t]
Right _ -> [Ok "succesfully decoded self_signed_pem"] Right _ -> [Ok "succesfully decoded self_signed_pem"]
@ -143,9 +36,10 @@ the client can read.
```unison ```unison
serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let serverThread portVar toSend = 'let
go: '{io2.IO, Exception}()
go = 'let go = 'let
-- load our self signed cert -- load our self signed cert
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException cert = decodeCert (toUtf8 self_signed_cert_pem)
-- assume there is exactly one key decoded from our Bytes -- assume there is exactly one key decoded from our Bytes
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
@ -155,38 +49,38 @@ serverThread portVar toSend = 'let
-- Open a TCP server port: -- Open a TCP server port:
-- we pass the special port "0" to mean "please find us an open port" -- we pass the special port "0" to mean "please find us an open port"
sock = serverSocket.impl (Some "127.0.0.1") "0" |> toException sock = serverSocket (Some "127.0.0.1") "0"
-- find out what port we got -- find out what port we got
port = socketPort sock |> toException port = socketPort sock
-- report the port back so that the client knows where to connect -- report the port back so that the client knows where to connect
MVar.put.impl portVar port |> toException put portVar port
-- start listening to the socket so that it starts accepting connections -- start listening to the socket so that it starts accepting connections
listen.impl sock |> toException listen sock
watch ("server listening on port: " ++ (toText port)) () watch ("server listening on port: " ++ (toText port)) ()
-- accept a single connection on this socket -- accept a single connection on this socket
sock' = socketAccept.impl sock |> toException sock' = socketAccept sock
-- attach TLS to our TCP connection -- attach TLS to our TCP connection
tls = newServer tlsconfig sock' |> toException tls = newServer tlsconfig sock'
-- try to handshake the TLS connection with the client -- try to handshake the TLS connection with the client
handshake tls |> toException handshake tls
-- send our message over our tls channel -- send our message over our tls channel
send tls (toUtf8 toSend) |> toException send tls (toUtf8 toSend)
terminate tls |> toException terminate tls
closeSocket.impl sock' |> toException closeSocket sock'
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch ("error in server: " ++ t) () Left (Failure _ t _) -> watch ("error in server: " ++ t) ()
_ -> watch "server finished" () _ -> watch "server finished" ()
testClient : Optional SignedCert -> Text -> MVar Nat -> '{io2.IO, Exception Failure} Text testClient : Optional SignedCert -> Text -> MVar Nat -> '{io2.IO, Exception} Text
testClient cert hostname portVar _ = testClient cert hostname portVar _ =
-- create a client that will expect a cert from the given hostname (CN) -- create a client that will expect a cert from the given hostname (CN)
defaultClient = (Tls.ClientConfig.default hostname Bytes.empty) defaultClient = (Tls.ClientConfig.default hostname Bytes.empty)
@ -197,22 +91,22 @@ testClient cert hostname portVar _ =
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert] Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
-- wait to find out what port the server started on -- wait to find out what port the server started on
port = take.impl portVar |> toException port = take portVar
-- create a tcp connection with the server -- create a tcp connection with the server
sock = clientSocket.impl "127.0.0.1" (Nat.toText port) |> toException sock = clientSocket "127.0.0.1" (Nat.toText port)
-- attach the TLS client to the TCP socket -- attach the TLS client to the TCP socket
tls = newClient tlsconfig sock |> toException tls = newClient tlsconfig sock
watch ("client connecting to port: " ++ (toText port)) () watch ("client connecting to port: " ++ (toText port)) ()
-- verify that the server presents us with a certificate chain for -- verify that the server presents us with a certificate chain for
-- test.unison.cloud originating with a certificate we trust, and -- test.unison.cloud originating with a certificate we trust, and
-- that the server can use a compatible TLS version and cipher -- that the server can use a compatible TLS version and cipher
handshake tls |> toException handshake tls
-- receive a message from the server -- receive a message from the server
fromUtf8.impl (toException (receive tls)) |> toException fromUtf8 (receive tls)
testConnectSelfSigned : '{io2.IO}[Result] testConnectSelfSigned : '{io2.IO}[Result]
testConnectSelfSigned _ = testConnectSelfSigned _ =
@ -223,10 +117,10 @@ testConnectSelfSigned _ =
forkComp (serverThread portVar toSend) forkComp (serverThread portVar toSend)
-- Client -- Client
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException cert = decodeCert (toUtf8 self_signed_cert_pem)
received = !(testClient (Some cert) "test.unison.cloud" portVar) received = !(testClient (Some cert) "test.unison.cloud" portVar)
expectU (a->a) "should have reaped what we've sown" toSend received expectU "should have reaped what we've sown" toSend received
runTest test runTest test

150
unison-src/new-runtime-transcripts/tls.output.md
View File

@ -1,114 +1,13 @@
# Tests for TLS builtins # Tests for TLS builtins
## Setup
You can skip the section which is just needed to make the transcript self-contained.
```unison ```unison
use .builtin.io2 Failure
a |> f = f a
startsWith : Text -> Text -> Boolean
startsWith prefix text = (eq (Text.take (size prefix) text) prefix)
contains : Text -> Text -> Boolean
contains needle haystack = if (size haystack) == 0 then false else
if startsWith needle haystack then true else
contains needle (drop 1 haystack)
filter: (a -> Boolean) -> [a] -> [a]
filter f all =
go acc = cases
a +: as -> if (f a) then go (cons a acc) as else go acc as
[] -> acc
go [] all
ability Exception e where raise : e ->{Exception e} a
toException : Either e a ->{Exception e} a
toException = cases
Left e -> raise e
Right a -> a
Exception.toEither.handler : Request {Exception e} a -> Either e a
Exception.toEither.handler = cases
{ a } -> Right a
{raise e -> _} -> Left e
Exception.toEither : '{g, Exception e} a ->{g} Either e a
Exception.toEither a = handle !a with Exception.toEither.handler
isNone = cases
Some _ -> false
None -> true
ability Stream a where
emit: a -> ()
Stream.toList.handler : Request {Stream a} r -> [a]
Stream.toList.handler =
go : [a] -> Request {Stream a} r -> [a]
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ _ } -> acc
go []
Stream.toList : '{Stream a} r -> [a]
Stream.toList s = handle !s with toList.handler
Stream.collect.handler : Request {Stream a} r -> ([a],r)
Stream.collect.handler =
go : [a] -> Request {Stream a} r -> ([a],r)
go acc = cases
{ Stream.emit a -> k } -> handle !k with go (acc :+ a)
{ r } -> (acc, r)
go []
Stream.collect : '{e, Stream a} r -> {e} ([a],r)
Stream.collect s =
handle !s with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, returns the Results and the result of the test
evalTest: '{Stream Result, Exception Failure, io2.IO} a -> ([Result], Either Failure a)
evalTest a = handle
(handle !a with Exception.toEither.handler)
with Stream.collect.handler
-- Run tests which might fail, might create temporary directores and Stream out
-- results, but ignore the produced value and only return the test Results
runTest: '{Stream Result, Exception Failure, io2.IO} a -> [Result]
runTest t = match evalTest t with
(results, Right _) -> results
(results, Left (Failure _ t _)) -> results :+ (Fail t)
--
-- convenience functions for emitting test results
--
expect : (a -> Text) -> (a -> a -> Boolean) -> Text -> a -> a -> {Stream Result} ()
expect toText compare msg expected actual = let
if (compare expected actual) then
emit (Ok msg)
else let
failMsg = msg ++ "expected : " ++ (toText expected) ++ " actual: " ++ (toText actual)
emit (Fail failMsg)
expectU : (a -> Text) -> Text -> a -> a -> {Stream Result} ()
expectU toText msg expected actual = expect toText (==) msg expected actual
check: Text -> Boolean -> {Stream Result} ()
check msg test = if test then emit (Ok msg) else emit (Fail msg)
-- generated with: -- generated with:
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 365 -out cert.pem -- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 365 -out cert.pem
self_signed_key_pem = "-----BEGIN PRIVATE KEY-----\nMIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQDBrpp+SxjCz/aQ\nQXT2hKXrT3lZ3Ek1VT/kgNre3J/RUyNZjZnZXCMyNjZ4IxYKxcCAIgGtfFpgvkzT\n5NRGZKLlSX4Y8HayV3gdEXO9hq4w/i/s+I0tOAJkVtHolXrrziZ7/4NZwMTbbqhO\n5hHHhbtBIpvNSw8el3AY3APkQ37+wM3fbvyeuG0ekoLqTa371W+/Z7pOi7QXYGEa\n8YHSNkuRKY46C4Y8oeWHOlSbQKu151GLuyQu74bnecGDN4KBdz9nyyKCCTpBsJpU\ni9Ozq3cps5L8dnN1zUNgaTyWp9kO3vbaTU8MY7p/dc7hNJ8pmGtSiiSs1xvni4Xl\nCBXBesxTAgMBAAECggEAAUtfcPSjh7nIFhK562PbkAUJ9JXKT3bwZGCQFek3kDiU\nBecyXgeFnLJMDuV9IjlMHg8cH8Ky/+6FqOzglk/Z3tps41HIGU0IWnlhYqThySYJ\nv/WxS9oR+gWyhXFqTuUj0LRWdmUZa7YDnfNfrwuvwrGuhOK5iSTN9PyTchUZZi50\ntxcNS/C3rk63c7TZLfuwxwGoUCeJvZZ/rmeVchhsuoo3QdSW0Aee7UtFtnvBfLCK\nXKdz+3q49fLZlDyx9/olJh+TY7GuF+G/LSfyQGi85beQhkXUH8/gIQIRI8INIEPB\n0XeTlv7Sgw5upqplJvHCXjAa+jz/Mo87znXBTMoIIQKBgQDorAlZCjzKxGDIaZoD\nDBXYzhSnnIhthThW4edCQ9/ZnJpX4vdTw4FngW504d8SPStMCYeBeMt8iwTczI4W\nHfK+AlVTlPfH/9NnIVADqqr9kobJW6782MYSW2/758d+L5bq8NGATyh8nPll9joN\nYAk7tNO2bGO2bEk2DbZMf3qnOQKBgQDVGdD005kUT3D+DfgeLTGzwk/2wCCPjoJ5\n6fsjsFAeZWU/qioIB3xHt1w8NsT6O+7XOKp/GRbsvsJR9Z/zmA3Ii5yrHYn48UzM\n+UyGLv+2HCpO+8A3szz/aDhKIxNFpXyZzvOXdtqBwTQbICOW2WRWOOgDrS2W1i9l\nD69xRLqj6wKBgBW0xwJ5hAZen7DSuT2DiR46y45/efLNtN3WIV77OgzxIS0FzZEQ\n8ieX2Zgp4kevUTS8xtl7TXCG/6MhqjfB/31edltf0GXmJfC/GNneuCkD3HM4jHCm\nQIRB54aWrvPEuM2ePc08lUha1KGAgRXyWaoqSn4ASqUgIQxb5x/n3KdxAoGAXlD0\nyMc2Q2T9r5PjMwfxrYvc9GsIfkEmwmqqupr4etuJumnH/JHDkcI30nazK8WG6j6s\nR2CFYvby7m92AcxUnWQdTSbfwAycX0QfeGwoxSMmHpsR8hUkdC5ea4Gmr/aUdUbB\nTVJPV4p5U2AgIE3LONYq6iWlvdLCW0pb7hfrO00CgYAb8bXz9BNow4soEkSbQysg\n4sGAr1+iSPY+ErffKRDpcFRnWcQdnTfI4xd8bgnC6OZwVpLbRZaZf3opDJ+axWqa\nEgAeHErTDY4R8aMecvyQj780sQ35kVq4VK0rSQyiKRBcjEust8UEzwYsUog2ysN0\n3zLHVEvFTfwOSctnEQRw1w==\n-----END PRIVATE KEY-----\n" self_signed_key_pem = "-----BEGIN PRIVATE KEY-----\nMIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQDBrpp+SxjCz/aQ\nQXT2hKXrT3lZ3Ek1VT/kgNre3J/RUyNZjZnZXCMyNjZ4IxYKxcCAIgGtfFpgvkzT\n5NRGZKLlSX4Y8HayV3gdEXO9hq4w/i/s+I0tOAJkVtHolXrrziZ7/4NZwMTbbqhO\n5hHHhbtBIpvNSw8el3AY3APkQ37+wM3fbvyeuG0ekoLqTa371W+/Z7pOi7QXYGEa\n8YHSNkuRKY46C4Y8oeWHOlSbQKu151GLuyQu74bnecGDN4KBdz9nyyKCCTpBsJpU\ni9Ozq3cps5L8dnN1zUNgaTyWp9kO3vbaTU8MY7p/dc7hNJ8pmGtSiiSs1xvni4Xl\nCBXBesxTAgMBAAECggEAAUtfcPSjh7nIFhK562PbkAUJ9JXKT3bwZGCQFek3kDiU\nBecyXgeFnLJMDuV9IjlMHg8cH8Ky/+6FqOzglk/Z3tps41HIGU0IWnlhYqThySYJ\nv/WxS9oR+gWyhXFqTuUj0LRWdmUZa7YDnfNfrwuvwrGuhOK5iSTN9PyTchUZZi50\ntxcNS/C3rk63c7TZLfuwxwGoUCeJvZZ/rmeVchhsuoo3QdSW0Aee7UtFtnvBfLCK\nXKdz+3q49fLZlDyx9/olJh+TY7GuF+G/LSfyQGi85beQhkXUH8/gIQIRI8INIEPB\n0XeTlv7Sgw5upqplJvHCXjAa+jz/Mo87znXBTMoIIQKBgQDorAlZCjzKxGDIaZoD\nDBXYzhSnnIhthThW4edCQ9/ZnJpX4vdTw4FngW504d8SPStMCYeBeMt8iwTczI4W\nHfK+AlVTlPfH/9NnIVADqqr9kobJW6782MYSW2/758d+L5bq8NGATyh8nPll9joN\nYAk7tNO2bGO2bEk2DbZMf3qnOQKBgQDVGdD005kUT3D+DfgeLTGzwk/2wCCPjoJ5\n6fsjsFAeZWU/qioIB3xHt1w8NsT6O+7XOKp/GRbsvsJR9Z/zmA3Ii5yrHYn48UzM\n+UyGLv+2HCpO+8A3szz/aDhKIxNFpXyZzvOXdtqBwTQbICOW2WRWOOgDrS2W1i9l\nD69xRLqj6wKBgBW0xwJ5hAZen7DSuT2DiR46y45/efLNtN3WIV77OgzxIS0FzZEQ\n8ieX2Zgp4kevUTS8xtl7TXCG/6MhqjfB/31edltf0GXmJfC/GNneuCkD3HM4jHCm\nQIRB54aWrvPEuM2ePc08lUha1KGAgRXyWaoqSn4ASqUgIQxb5x/n3KdxAoGAXlD0\nyMc2Q2T9r5PjMwfxrYvc9GsIfkEmwmqqupr4etuJumnH/JHDkcI30nazK8WG6j6s\nR2CFYvby7m92AcxUnWQdTSbfwAycX0QfeGwoxSMmHpsR8hUkdC5ea4Gmr/aUdUbB\nTVJPV4p5U2AgIE3LONYq6iWlvdLCW0pb7hfrO00CgYAb8bXz9BNow4soEkSbQysg\n4sGAr1+iSPY+ErffKRDpcFRnWcQdnTfI4xd8bgnC6OZwVpLbRZaZf3opDJ+axWqa\nEgAeHErTDY4R8aMecvyQj780sQ35kVq4VK0rSQyiKRBcjEust8UEzwYsUog2ysN0\n3zLHVEvFTfwOSctnEQRw1w==\n-----END PRIVATE KEY-----\n"
self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk1rv2Sx5XSK17BZSV4t7gwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjEwMTIyMDkxMTE3WhcNMjIwMTIyMDkxMTE3WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMGumn5L\nGMLP9pBBdPaEpetPeVncSTVVP+SA2t7cn9FTI1mNmdlcIzI2NngjFgrFwIAiAa18\nWmC+TNPk1EZkouVJfhjwdrJXeB0Rc72GrjD+L+z4jS04AmRW0eiVeuvOJnv/g1nA\nxNtuqE7mEceFu0Eim81LDx6XcBjcA+RDfv7Azd9u/J64bR6SgupNrfvVb79nuk6L\ntBdgYRrxgdI2S5EpjjoLhjyh5Yc6VJtAq7XnUYu7JC7vhud5wYM3goF3P2fLIoIJ\nOkGwmlSL07Ordymzkvx2c3XNQ2BpPJan2Q7e9tpNTwxjun91zuE0nymYa1KKJKzX\nG+eLheUIFcF6zFMCAwEAAaNTMFEwHQYDVR0OBBYEFFE3RQYASDWtwSdXL+qtQrjy\nH4SZMB8GA1UdIwQYMBaAFFE3RQYASDWtwSdXL+qtQrjyH4SZMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAH7D8W68cR0QvNNPugCY7lPvA/F94Qam\nwCC2A55edcagfjqFy77xx4Ljrd2TC19yiSzyeeJ+YuohbcipLce90BaaaiYq9aah\n5DICDCUhm1qbhJzqNB2Lqgl4aN+jRMeRVC+rpQBYBNmdPBqdv/k+T2uyghwmLWXe\n/AxCjCLA0zoYzOMytS86veD6CQbF5DpSTZx5dyZTeGhk2izhoM8cgiu+/7YncAbJ\nt7b7UT5Yu3+z1hAdUF5Q21bkEksGBC8UW0G0PMy8XNRMuMsz+2LC39u3u7QyX/+e\nuQGST3aCreV27zd0lrF8LHjwD2XcjVVzHy46VYQvf1r+6gatedDBjqc=\n-----END CERTIFICATE-----\n" self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk1rv2Sx5XSK17BZSV4t7gwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjEwMTIyMDkxMTE3WhcNMjIwMTIyMDkxMTE3WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMGumn5L\nGMLP9pBBdPaEpetPeVncSTVVP+SA2t7cn9FTI1mNmdlcIzI2NngjFgrFwIAiAa18\nWmC+TNPk1EZkouVJfhjwdrJXeB0Rc72GrjD+L+z4jS04AmRW0eiVeuvOJnv/g1nA\nxNtuqE7mEceFu0Eim81LDx6XcBjcA+RDfv7Azd9u/J64bR6SgupNrfvVb79nuk6L\ntBdgYRrxgdI2S5EpjjoLhjyh5Yc6VJtAq7XnUYu7JC7vhud5wYM3goF3P2fLIoIJ\nOkGwmlSL07Ordymzkvx2c3XNQ2BpPJan2Q7e9tpNTwxjun91zuE0nymYa1KKJKzX\nG+eLheUIFcF6zFMCAwEAAaNTMFEwHQYDVR0OBBYEFFE3RQYASDWtwSdXL+qtQrjy\nH4SZMB8GA1UdIwQYMBaAFFE3RQYASDWtwSdXL+qtQrjyH4SZMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAH7D8W68cR0QvNNPugCY7lPvA/F94Qam\nwCC2A55edcagfjqFy77xx4Ljrd2TC19yiSzyeeJ+YuohbcipLce90BaaaiYq9aah\n5DICDCUhm1qbhJzqNB2Lqgl4aN+jRMeRVC+rpQBYBNmdPBqdv/k+T2uyghwmLWXe\n/AxCjCLA0zoYzOMytS86veD6CQbF5DpSTZx5dyZTeGhk2izhoM8cgiu+/7YncAbJ\nt7b7UT5Yu3+z1hAdUF5Q21bkEksGBC8UW0G0PMy8XNRMuMsz+2LC39u3u7QyX/+e\nuQGST3aCreV27zd0lrF8LHjwD2XcjVVzHy46VYQvf1r+6gatedDBjqc=\n-----END CERTIFICATE-----\n"
``` ```
# Using an alternative certificate store # Using an alternative certificate store
@ -116,7 +15,7 @@ self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk
First lets make sure we can load our cert and private key First lets make sure we can load our cert and private key
```unison ```unison
test> match (decodeCert (toUtf8 self_signed_cert_pem) with test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
Left (Failure _ t _) -> [Fail t] Left (Failure _ t _) -> [Fail t]
Right _ -> [Ok "succesfully decoded self_signed_pem"] Right _ -> [Ok "succesfully decoded self_signed_pem"]
@ -135,7 +34,7 @@ test> match (decodeCert (toUtf8 self_signed_cert_pem) with
Now evaluating any watch expressions (lines starting with Now evaluating any watch expressions (lines starting with
`>`)... Ctrl+C cancels. `>`)... Ctrl+C cancels.
1 | test> match (decodeCert (toUtf8 self_signed_cert_pem) with 1 | test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
✅ Passed succesfully decoded self_signed_pem ✅ Passed succesfully decoded self_signed_pem
@ -151,9 +50,10 @@ the client can read.
```unison ```unison
serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let serverThread portVar toSend = 'let
go: '{io2.IO, Exception}()
go = 'let go = 'let
-- load our self signed cert -- load our self signed cert
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException cert = decodeCert (toUtf8 self_signed_cert_pem)
-- assume there is exactly one key decoded from our Bytes -- assume there is exactly one key decoded from our Bytes
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
@ -163,38 +63,38 @@ serverThread portVar toSend = 'let
-- Open a TCP server port: -- Open a TCP server port:
-- we pass the special port "0" to mean "please find us an open port" -- we pass the special port "0" to mean "please find us an open port"
sock = serverSocket.impl (Some "127.0.0.1") "0" |> toException sock = serverSocket (Some "127.0.0.1") "0"
-- find out what port we got -- find out what port we got
port = socketPort sock |> toException port = socketPort sock
-- report the port back so that the client knows where to connect -- report the port back so that the client knows where to connect
MVar.put.impl portVar port |> toException put portVar port
-- start listening to the socket so that it starts accepting connections -- start listening to the socket so that it starts accepting connections
listen.impl sock |> toException listen sock
watch ("server listening on port: " ++ (toText port)) () watch ("server listening on port: " ++ (toText port)) ()
-- accept a single connection on this socket -- accept a single connection on this socket
sock' = socketAccept.impl sock |> toException sock' = socketAccept sock
-- attach TLS to our TCP connection -- attach TLS to our TCP connection
tls = newServer tlsconfig sock' |> toException tls = newServer tlsconfig sock'
-- try to handshake the TLS connection with the client -- try to handshake the TLS connection with the client
handshake tls |> toException handshake tls
-- send our message over our tls channel -- send our message over our tls channel
send tls (toUtf8 toSend) |> toException send tls (toUtf8 toSend)
terminate tls |> toException terminate tls
closeSocket.impl sock' |> toException closeSocket sock'
match (toEither go) with match (toEither go) with
Left (Failure _ t _) -> watch ("error in server: " ++ t) () Left (Failure _ t _) -> watch ("error in server: " ++ t) ()
_ -> watch "server finished" () _ -> watch "server finished" ()
testClient : Optional SignedCert -> Text -> MVar Nat -> '{io2.IO, Exception Failure} Text testClient : Optional SignedCert -> Text -> MVar Nat -> '{io2.IO, Exception} Text
testClient cert hostname portVar _ = testClient cert hostname portVar _ =
-- create a client that will expect a cert from the given hostname (CN) -- create a client that will expect a cert from the given hostname (CN)
defaultClient = (Tls.ClientConfig.default hostname Bytes.empty) defaultClient = (Tls.ClientConfig.default hostname Bytes.empty)
@ -205,22 +105,22 @@ testClient cert hostname portVar _ =
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert] Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
-- wait to find out what port the server started on -- wait to find out what port the server started on
port = take.impl portVar |> toException port = take portVar
-- create a tcp connection with the server -- create a tcp connection with the server
sock = clientSocket.impl "127.0.0.1" (Nat.toText port) |> toException sock = clientSocket "127.0.0.1" (Nat.toText port)
-- attach the TLS client to the TCP socket -- attach the TLS client to the TCP socket
tls = newClient tlsconfig sock |> toException tls = newClient tlsconfig sock
watch ("client connecting to port: " ++ (toText port)) () watch ("client connecting to port: " ++ (toText port)) ()
-- verify that the server presents us with a certificate chain for -- verify that the server presents us with a certificate chain for
-- test.unison.cloud originating with a certificate we trust, and -- test.unison.cloud originating with a certificate we trust, and
-- that the server can use a compatible TLS version and cipher -- that the server can use a compatible TLS version and cipher
handshake tls |> toException handshake tls
-- receive a message from the server -- receive a message from the server
fromUtf8.impl (toException (receive tls)) |> toException fromUtf8 (receive tls)
testConnectSelfSigned : '{io2.IO}[Result] testConnectSelfSigned : '{io2.IO}[Result]
testConnectSelfSigned _ = testConnectSelfSigned _ =
@ -231,10 +131,10 @@ testConnectSelfSigned _ =
forkComp (serverThread portVar toSend) forkComp (serverThread portVar toSend)
-- Client -- Client
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException cert = decodeCert (toUtf8 self_signed_cert_pem)
received = !(testClient (Some cert) "test.unison.cloud" portVar) received = !(testClient (Some cert) "test.unison.cloud" portVar)
expectU (a->a) "should have reaped what we've sown" toSend received expectU "should have reaped what we've sown" toSend received
runTest test runTest test
@ -301,7 +201,7 @@ testCNReject _ =
testClient : Optional SignedCert testClient : Optional SignedCert
-> Text -> Text
-> MVar Nat -> MVar Nat
-> '{io2.IO, Exception Failure} Text -> '{io2.IO, Exception} Text
testConnectSelfSigned : '{io2.IO} [Result] testConnectSelfSigned : '{io2.IO} [Result]
``` ```
@ -316,7 +216,7 @@ testCNReject _ =
testClient : Optional SignedCert testClient : Optional SignedCert
-> Text -> Text
-> MVar Nat -> MVar Nat
-> '{io2.IO, Exception Failure} Text -> '{io2.IO, Exception} Text
testConnectSelfSigned : '{io2.IO} [Result] testConnectSelfSigned : '{io2.IO} [Result]
.> io.test testConnectSelfSigned .> io.test testConnectSelfSigned

8
unison-src/new-runtime-transcripts/utf8.output.md
View File

@ -5,8 +5,9 @@ Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding o
```ucm ```ucm
.> find Utf8 .> find Utf8
1. builtin.Text.toUtf8 : Text -> Bytes 1. Text.fromUtf8 : Bytes ->{Exception} Text
2. builtin.Text.fromUtf8.impl : Bytes -> Either Failure Text 2. builtin.Text.toUtf8 : Text -> Bytes
3. builtin.Text.fromUtf8.impl : Bytes -> Either Failure Text
``` ```
@ -26,7 +27,8 @@ ascii = "ABCDE"
do an `add` or `update`, here's how your codebase would do an `add` or `update`, here's how your codebase would
change: change:
⍟ These new definitions are ok to `add`: ⍟ These names already exist. You can `update` them to your
new definition:
ascii : Text ascii : Text