mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-15 04:11:34 +03:00
refactoring new-runtime-transcripts
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
parent
2f01c8ca37
commit
7a2a8fb28b
@ -517,7 +517,7 @@ ioBuiltins =
|
||||
, ("IO.putBytes.impl.v3", handle --> bytes --> iof unit)
|
||||
, ("IO.systemTime.impl.v3", unit --> iof nat)
|
||||
, ("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.setCurrentDirectory.impl.v3", text --> iof unit)
|
||||
, ("IO.fileExists.impl.v3", text --> iof boolean)
|
||||
@ -533,7 +533,7 @@ ioBuiltins =
|
||||
, ("IO.listen.impl.v3", socket --> iof unit)
|
||||
, ("IO.clientSocket.impl.v3", text --> text --> iof socket)
|
||||
, ("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.socketSend.impl.v3", socket --> bytes --> iof unit)
|
||||
, ("IO.socketReceive.impl.v3", socket --> nat --> iof bytes)
|
||||
@ -542,16 +542,16 @@ ioBuiltins =
|
||||
|
||||
, ("IO.delay.impl.v3", nat --> iof unit)
|
||||
, ("IO.kill.impl.v3", threadId --> iof unit)
|
||||
, ("Tls.newClient", tlsClientConfig --> socket --> iof tls)
|
||||
, ("Tls.newServer", tlsServerConfig --> socket --> iof tls)
|
||||
, ("Tls.handshake", tls --> iof unit)
|
||||
, ("Tls.send", tls --> bytes --> iof unit)
|
||||
, ("Tls.decodeCert", bytes --> eithert failure tlsSignedCert)
|
||||
, ("Tls.newClient.impl.v3", tlsClientConfig --> socket --> iof tls)
|
||||
, ("Tls.newServer.impl.v3", tlsServerConfig --> socket --> iof tls)
|
||||
, ("Tls.handshake.impl.v3", tls --> iof unit)
|
||||
, ("Tls.send.impl.v3", tls --> bytes --> iof unit)
|
||||
, ("Tls.decodeCert.impl.v3", bytes --> eithert failure tlsSignedCert)
|
||||
, ("Tls.encodeCert", tlsSignedCert --> bytes)
|
||||
, ("Tls.decodePrivateKey", bytes --> list tlsPrivateKey)
|
||||
, ("Tls.encodePrivateKey", tlsPrivateKey --> bytes)
|
||||
, ("Tls.receive", tls --> iof bytes)
|
||||
, ("Tls.terminate", tls --> iof unit)
|
||||
, ("Tls.receive.impl.v3", tls --> iof bytes)
|
||||
, ("Tls.terminate.impl.v3", tls --> iof unit)
|
||||
, ("Tls.ClientConfig.default", text --> bytes --> tlsClientConfig)
|
||||
, ("Tls.ServerConfig.default", list tlsSignedCert --> tlsPrivateKey --> tlsServerConfig)
|
||||
, ("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.tryTake", forall1 "a" $ \a -> mvar a --> io (optionalt a))
|
||||
, ("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.isEmpty", forall1 "a" $ \a -> mvar a --> io boolean)
|
||||
, ("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
|
||||
mvar :: Type v -> Type v
|
||||
|
||||
@ -1358,7 +1358,7 @@ declareForeigns = do
|
||||
declareForeign "IO.getTempDirectory.impl.v3" unitToEFBox
|
||||
$ mkForeignIOF $ \() -> getTemporaryDirectory
|
||||
|
||||
declareForeign "IO.createTempDirectory" boxToEFBox
|
||||
declareForeign "IO.createTempDirectory.impl.v3" boxToEFBox
|
||||
$ mkForeignIOF $ \prefix -> do
|
||||
temp <- getTemporaryDirectory
|
||||
createTempDirectory temp prefix
|
||||
@ -1402,7 +1402,7 @@ declareForeigns = do
|
||||
, port) ->
|
||||
fst <$> SYS.bindSock (hostPreference mhst) port
|
||||
|
||||
declareForeign "IO.socketPort" boxToEFNat
|
||||
declareForeign "IO.socketPort.impl.v3" boxToEFNat
|
||||
. mkForeignIOF $ \(handle :: Socket) -> do
|
||||
n <- SYS.socketPort handle
|
||||
return (fromIntegral n :: Word64)
|
||||
@ -1452,7 +1452,7 @@ declareForeigns = do
|
||||
declareForeign "MVar.put.impl.v3" boxBoxToEF0
|
||||
. 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
|
||||
|
||||
declareForeign "MVar.swap.impl.v3" boxBoxToEFBox
|
||||
@ -1464,8 +1464,8 @@ declareForeigns = do
|
||||
declareForeign "MVar.read.impl.v3" boxBoxToEFBox
|
||||
. mkForeignIOF $ \(mv :: MVar Closure) -> readMVar mv
|
||||
|
||||
declareForeign "MVar.tryRead" boxToMaybeBox
|
||||
. mkForeign $ \(mv :: MVar Closure) -> tryReadMVar mv
|
||||
declareForeign "MVar.tryRead.impl.v3" boxToEFBox
|
||||
. mkForeignIOF $ \(mv :: MVar Closure) -> tryReadMVar mv
|
||||
|
||||
declareForeign "Text.toUtf8" boxDirect . mkForeign
|
||||
$ pure . Bytes.fromArray . encodeUtf8
|
||||
@ -1535,18 +1535,18 @@ declareForeigns = do
|
||||
declareForeign "Tls.Config.defaultServer" unitDirect . mkForeign $ \() -> do
|
||||
pure $ (def :: ServerParams) { TLS.serverSupported = defaultSupported }
|
||||
|
||||
declareForeign "Tls.newClient" boxBoxToEFBox . mkForeignTls $
|
||||
declareForeign "Tls.newClient.impl.v3" boxBoxToEFBox . mkForeignTls $
|
||||
\(config :: TLS.ClientParams,
|
||||
socket :: SYS.Socket) -> TLS.contextNew socket config
|
||||
|
||||
declareForeign "Tls.newServer" boxBoxToEFBox . mkForeignTls $
|
||||
declareForeign "Tls.newServer.impl.v3" boxBoxToEFBox . mkForeignTls $
|
||||
\(config :: TLS.ServerParams,
|
||||
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
|
||||
|
||||
declareForeign "Tls.send" boxBoxToEFBox . mkForeignTls $
|
||||
declareForeign "Tls.send.impl.v3" boxBoxToEFBox . mkForeignTls $
|
||||
\(tls :: TLS.Context,
|
||||
bytes :: Bytes.Bytes) -> TLS.sendData tls (Bytes.toLazyByteString bytes)
|
||||
|
||||
@ -1556,7 +1556,7 @@ declareForeigns = do
|
||||
asCert :: PEM -> Either String X.SignedCertificate
|
||||
asCert pem = X.decodeSignedCertificate $ pemContent pem
|
||||
in
|
||||
declareForeign "Tls.decodeCert" boxToEFBox . mkForeign $
|
||||
declareForeign "Tls.decodeCert.impl.v3" boxToEFBox . mkForeign $
|
||||
\(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes
|
||||
|
||||
declareForeign "Tls.encodeCert" boxDirect . mkForeign $
|
||||
@ -1568,12 +1568,12 @@ declareForeigns = do
|
||||
declareForeign "Tls.encodePrivateKey" boxDirect . mkForeign $
|
||||
\(privateKey :: X.PrivKey) -> pure $ pack $ show privateKey
|
||||
|
||||
declareForeign "Tls.receive" boxToEFBox . mkForeignTls $
|
||||
declareForeign "Tls.receive.impl.v3" boxToEFBox . mkForeignTls $
|
||||
\(tls :: TLS.Context) -> do
|
||||
bs <- TLS.recvData tls
|
||||
pure $ Bytes.fromArray bs
|
||||
|
||||
declareForeign "Tls.terminate" boxToEFBox . mkForeignTls $
|
||||
declareForeign "Tls.terminate.impl.v3" boxToEFBox . mkForeignTls $
|
||||
\(tls :: TLS.Context) -> TLS.bye tls
|
||||
|
||||
declareForeign "Code.dependencies" boxDirect
|
||||
|
||||
267
unison-src/new-runtime-transcripts/_base.md
Normal file
267
unison-src/new-runtime-transcripts/_base.md
Normal 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
276
unison-src/new-runtime-transcripts/_base.output.md
Normal 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.
|
||||
|
||||
```
|
||||
@ -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.
|
||||
|
||||
## 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
|
||||
|
||||
```unison:hide
|
||||
@ -186,8 +150,8 @@ test> Nat.tests.conversions =
|
||||
```unison
|
||||
> [Any "hi", Any (41 + 1)]
|
||||
|
||||
test> Any.test1 = check (Any "hi" == Any "hi")
|
||||
test> Any.test2 = check (not (Any "hi" == Any 42))
|
||||
test> Any.test1 = checks [(Any "hi" == Any "hi")]
|
||||
test> Any.test2 = checks [(not (Any "hi" == Any 42))]
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
|
||||
@ -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.
|
||||
|
||||
## 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
|
||||
|
||||
```unison
|
||||
@ -170,8 +142,8 @@ test> Nat.tests.conversions =
|
||||
```unison
|
||||
> [Any "hi", Any (41 + 1)]
|
||||
|
||||
test> Any.test1 = check (Any "hi" == Any "hi")
|
||||
test> Any.test2 = check (not (Any "hi" == Any 42))
|
||||
test> Any.test1 = checks [(Any "hi" == Any "hi")]
|
||||
test> Any.test2 = checks [(not (Any "hi" == Any 42))]
|
||||
```
|
||||
|
||||
```ucm
|
||||
@ -192,11 +164,11 @@ test> Any.test2 = check (not (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
|
||||
|
||||
4 | test> Any.test2 = check (not (Any "hi" == Any 42))
|
||||
4 | test> Any.test2 = checks [(not (Any "hi" == Any 42))]
|
||||
|
||||
✅ Passed Passed
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
```unison
|
||||
ability Err where
|
||||
throw : Text -> a
|
||||
|
||||
save : a -> Bytes
|
||||
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
|
||||
Left _ -> throw "could not deserialize value"
|
||||
Right v -> match Value.load v with
|
||||
Left _ -> throw "could not load value"
|
||||
Right x -> x
|
||||
|
||||
roundtrip : a ->{io2.IO, Err} a
|
||||
roundtrip : a ->{io2.IO, Throw Text} a
|
||||
roundtrip x = load (save x)
|
||||
|
||||
handleTest : Text -> Request {Err} a -> Result
|
||||
handleTest : Text -> Request {Throw Text} a -> Result
|
||||
handleTest t = let
|
||||
pfx = "(" ++ t ++ ") "
|
||||
cases
|
||||
{ _ } -> 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 =
|
||||
if x == y
|
||||
then ()
|
||||
@ -47,11 +44,6 @@ showThree = cases
|
||||
one n -> "one " ++ 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 f = cases
|
||||
[] -> []
|
||||
@ -69,7 +61,7 @@ extensionals
|
||||
: (a -> b -> Text)
|
||||
-> (a -> b -> c)
|
||||
-> (a -> b -> c)
|
||||
-> [(a,b)] ->{Err} ()
|
||||
-> [(a,b)] ->{Throw Text} ()
|
||||
extensionals sh f g = cases
|
||||
[] -> ()
|
||||
(x,y) +: xs ->
|
||||
@ -79,7 +71,7 @@ extensionals sh f g = cases
|
||||
fib10 : [Nat]
|
||||
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
|
||||
sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")"
|
||||
handle
|
||||
@ -87,7 +79,7 @@ extensionality t f = let
|
||||
extensionals sh f g (prod threes fib10)
|
||||
with handleTest t
|
||||
|
||||
identicality : Text -> a ->{IO} Result
|
||||
identicality : Text -> a ->{io2.IO} Result
|
||||
identicality t x
|
||||
= handle identical "" x (roundtrip x) with handleTest t
|
||||
```
|
||||
|
||||
@ -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.
|
||||
|
||||
```unison
|
||||
ability Err where
|
||||
throw : Text -> a
|
||||
|
||||
save : a -> Bytes
|
||||
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
|
||||
Left _ -> throw "could not deserialize value"
|
||||
Right v -> match Value.load v with
|
||||
Left _ -> throw "could not load value"
|
||||
Right x -> x
|
||||
|
||||
roundtrip : a ->{io2.IO, Err} a
|
||||
roundtrip : a ->{io2.IO, Throw Text} a
|
||||
roundtrip x = load (save x)
|
||||
|
||||
handleTest : Text -> Request {Err} a -> Result
|
||||
handleTest : Text -> Request {Throw Text} a -> Result
|
||||
handleTest t = let
|
||||
pfx = "(" ++ t ++ ") "
|
||||
cases
|
||||
{ _ } -> 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 =
|
||||
if x == y
|
||||
then ()
|
||||
@ -42,11 +39,6 @@ showThree = cases
|
||||
one n -> "one " ++ 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 f = cases
|
||||
[] -> []
|
||||
@ -64,7 +56,7 @@ extensionals
|
||||
: (a -> b -> Text)
|
||||
-> (a -> b -> c)
|
||||
-> (a -> b -> c)
|
||||
-> [(a,b)] ->{Err} ()
|
||||
-> [(a,b)] ->{Throw Text} ()
|
||||
extensionals sh f g = cases
|
||||
[] -> ()
|
||||
(x,y) +: xs ->
|
||||
@ -74,7 +66,7 @@ extensionals sh f g = cases
|
||||
fib10 : [Nat]
|
||||
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
|
||||
sh t n = "(" ++ showThree t ++ ", " ++ toText n ++ ")"
|
||||
handle
|
||||
@ -82,7 +74,7 @@ extensionality t f = let
|
||||
extensionals sh f g (prod threes fib10)
|
||||
with handleTest t
|
||||
|
||||
identicality : Text -> a ->{IO} Result
|
||||
identicality : Text -> a ->{io2.IO} Result
|
||||
identicality t x
|
||||
= handle identical "" x (roundtrip x) with handleTest t
|
||||
```
|
||||
@ -95,27 +87,29 @@ identicality t x
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
ability Err
|
||||
type Three a b c
|
||||
concatMap : (a ->{g} [b]) ->{g} [a] ->{g} [b]
|
||||
extensionality : Text
|
||||
-> (Three Nat Nat Nat
|
||||
->{Err} Nat
|
||||
->{Err} b)
|
||||
->{IO} Result
|
||||
extensionals : (a ->{Err} b ->{Err} Text)
|
||||
->{Err} (a ->{Err} b ->{Err} c)
|
||||
->{Err} (a ->{Err} b ->{Err} c)
|
||||
->{Err} [(a, b)]
|
||||
->{Err} ()
|
||||
->{Throw Text} Nat
|
||||
->{Throw Text} b)
|
||||
->{io2.IO} Result
|
||||
extensionals : (a ->{Throw Text} b ->{Throw Text} Text)
|
||||
->{Throw Text} (a
|
||||
->{Throw Text} b
|
||||
->{Throw Text} c)
|
||||
->{Throw Text} (a
|
||||
->{Throw Text} b
|
||||
->{Throw Text} c)
|
||||
->{Throw Text} [(a, b)]
|
||||
->{Throw Text} ()
|
||||
fib10 : [Nat]
|
||||
handleTest : Text -> Request {Err} a -> Result
|
||||
identical : Text -> a -> a ->{Err} ()
|
||||
identicality : Text -> a ->{IO} Result
|
||||
load : Bytes ->{IO, Err} a
|
||||
map : (a ->{g} b) ->{g} [a] ->{g} [b]
|
||||
handleTest : Text -> Request {Throw Text} a -> Result
|
||||
identical : Text -> a -> a ->{Throw Text} ()
|
||||
identicality : Text -> a ->{io2.IO} Result
|
||||
load : Bytes ->{io2.IO, Throw Text} a
|
||||
prod : [a] ->{g} [b] ->{g} [(a, b)]
|
||||
roundtrip : a ->{IO, Err} a
|
||||
roundtrip : a ->{io2.IO, Throw Text} a
|
||||
save : a -> Bytes
|
||||
showThree : Three Nat Nat Nat -> Text
|
||||
threes : [Three Nat Nat Nat]
|
||||
@ -126,27 +120,29 @@ identicality t x
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
ability Err
|
||||
type Three a b c
|
||||
concatMap : (a ->{g} [b]) ->{g} [a] ->{g} [b]
|
||||
extensionality : Text
|
||||
-> (Three Nat Nat Nat
|
||||
->{Err} Nat
|
||||
->{Err} b)
|
||||
->{IO} Result
|
||||
extensionals : (a ->{Err} b ->{Err} Text)
|
||||
->{Err} (a ->{Err} b ->{Err} c)
|
||||
->{Err} (a ->{Err} b ->{Err} c)
|
||||
->{Err} [(a, b)]
|
||||
->{Err} ()
|
||||
->{Throw Text} Nat
|
||||
->{Throw Text} b)
|
||||
->{io2.IO} Result
|
||||
extensionals : (a ->{Throw Text} b ->{Throw Text} Text)
|
||||
->{Throw Text} (a
|
||||
->{Throw Text} b
|
||||
->{Throw Text} c)
|
||||
->{Throw Text} (a
|
||||
->{Throw Text} b
|
||||
->{Throw Text} c)
|
||||
->{Throw Text} [(a, b)]
|
||||
->{Throw Text} ()
|
||||
fib10 : [Nat]
|
||||
handleTest : Text -> Request {Err} a -> Result
|
||||
identical : Text -> a -> a ->{Err} ()
|
||||
identicality : Text -> a ->{IO} Result
|
||||
load : Bytes ->{IO, Err} a
|
||||
map : (a ->{g} b) ->{g} [a] ->{g} [b]
|
||||
handleTest : Text -> Request {Throw Text} a -> Result
|
||||
identical : Text -> a -> a ->{Throw Text} ()
|
||||
identicality : Text -> a ->{io2.IO} Result
|
||||
load : Bytes ->{io2.IO, Throw Text} a
|
||||
prod : [a] ->{g} [b] ->{g} [(a, b)]
|
||||
roundtrip : a ->{IO, Err} a
|
||||
roundtrip : a ->{io2.IO, Throw Text} a
|
||||
save : a -> Bytes
|
||||
showThree : Three Nat Nat Nat -> Text
|
||||
threes : [Three Nat Nat Nat]
|
||||
@ -218,7 +214,7 @@ tests =
|
||||
fVal : Value
|
||||
h : Three Nat Nat 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
|
||||
|
||||
```
|
||||
@ -238,7 +234,7 @@ to actual show that the serialization works.
|
||||
fVal : Value
|
||||
h : Three Nat Nat 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
|
||||
|
||||
.> display fDeps
|
||||
|
||||
@ -12,9 +12,10 @@ id2 x =
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⊡ Previously added definitions will be ignored: id
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
id : x -> x
|
||||
id2 : x -> x
|
||||
|
||||
```
|
||||
|
||||
@ -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.
|
||||
|
||||
## 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
|
||||
.builtin> ls Bytes
|
||||
```
|
||||
|
||||
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
|
||||
|
||||
Here's a few usage examples:
|
||||
@ -71,7 +29,7 @@ mysecret : Bytes
|
||||
mysecret = fromHex "237be2"
|
||||
|
||||
ex3 = fromHex "50d3ab"
|
||||
|> crypto.hmacBytes Sha2_256 mysecret
|
||||
|> (crypto.hmacBytes Sha2_256 mysecret)
|
||||
|> hex
|
||||
|
||||
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:
|
||||
|
||||
```unison:hide
|
||||
ex alg input expected = check let
|
||||
hashBytes alg (ascii input) ==
|
||||
fromHex expected
|
||||
ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected]
|
||||
|
||||
test> sha3_512.tests.ex1 =
|
||||
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).
|
||||
|
||||
```unison
|
||||
ex' alg secret msg expected = check let
|
||||
hmacBytes alg (fromHex secret) (ascii msg) ==
|
||||
fromHex expected
|
||||
ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected]
|
||||
|
||||
test> hmac_sha2_256.tests.ex1 =
|
||||
ex' Sha2_256
|
||||
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
|
||||
"Hi There"
|
||||
"b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7"
|
||||
|
||||
test> hmac_sha2_512.tests.ex1 =
|
||||
ex' Sha2_512
|
||||
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
|
||||
|
||||
@ -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.
|
||||
|
||||
## 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
|
||||
.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`.
|
||||
|
||||
```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
|
||||
|
||||
Here's a few usage examples:
|
||||
@ -88,7 +43,7 @@ mysecret : Bytes
|
||||
mysecret = fromHex "237be2"
|
||||
|
||||
ex3 = fromHex "50d3ab"
|
||||
|> crypto.hmacBytes Sha2_256 mysecret
|
||||
|> (crypto.hmacBytes Sha2_256 mysecret)
|
||||
|> hex
|
||||
|
||||
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:
|
||||
|
||||
```unison
|
||||
ex alg input expected = check let
|
||||
hashBytes alg (ascii input) ==
|
||||
fromHex expected
|
||||
ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected]
|
||||
|
||||
test> sha3_512.tests.ex1 =
|
||||
ex Sha3_512
|
||||
@ -286,29 +239,28 @@ test> blake2b_512.tests.ex3 =
|
||||
|
||||
Cached test results (`help testcache` to learn more)
|
||||
|
||||
◉ blake2b_512.tests.ex1 Passed.
|
||||
◉ blake2b_512.tests.ex2 Passed.
|
||||
◉ blake2b_512.tests.ex3 Passed.
|
||||
◉ blake2s_256.tests.ex1 Passed.
|
||||
◉ hex.tests.ex1 Passed.
|
||||
◉ sha2_256.tests.ex1 Passed.
|
||||
◉ sha2_256.tests.ex2 Passed.
|
||||
◉ sha2_256.tests.ex3 Passed.
|
||||
◉ sha2_256.tests.ex4 Passed.
|
||||
◉ sha2_512.tests.ex1 Passed.
|
||||
◉ sha2_512.tests.ex2 Passed.
|
||||
◉ sha2_512.tests.ex3 Passed.
|
||||
◉ sha2_512.tests.ex4 Passed.
|
||||
◉ sha3_256.tests.ex1 Passed.
|
||||
◉ sha3_256.tests.ex2 Passed.
|
||||
◉ sha3_256.tests.ex3 Passed.
|
||||
◉ sha3_256.tests.ex4 Passed.
|
||||
◉ sha3_512.tests.ex1 Passed.
|
||||
◉ sha3_512.tests.ex2 Passed.
|
||||
◉ sha3_512.tests.ex3 Passed.
|
||||
◉ sha3_512.tests.ex4 Passed.
|
||||
◉ blake2b_512.tests.ex1 Passed
|
||||
◉ blake2b_512.tests.ex2 Passed
|
||||
◉ blake2b_512.tests.ex3 Passed
|
||||
◉ blake2s_256.tests.ex1 Passed
|
||||
◉ sha2_256.tests.ex1 Passed
|
||||
◉ sha2_256.tests.ex2 Passed
|
||||
◉ sha2_256.tests.ex3 Passed
|
||||
◉ sha2_256.tests.ex4 Passed
|
||||
◉ sha2_512.tests.ex1 Passed
|
||||
◉ sha2_512.tests.ex2 Passed
|
||||
◉ sha2_512.tests.ex3 Passed
|
||||
◉ sha2_512.tests.ex4 Passed
|
||||
◉ sha3_256.tests.ex1 Passed
|
||||
◉ sha3_256.tests.ex2 Passed
|
||||
◉ sha3_256.tests.ex3 Passed
|
||||
◉ sha3_256.tests.ex4 Passed
|
||||
◉ sha3_512.tests.ex1 Passed
|
||||
◉ sha3_512.tests.ex2 Passed
|
||||
◉ sha3_512.tests.ex3 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
|
||||
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).
|
||||
|
||||
```unison
|
||||
ex' alg secret msg expected = check let
|
||||
hmacBytes alg (fromHex secret) (ascii msg) ==
|
||||
fromHex expected
|
||||
ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected]
|
||||
|
||||
test> hmac_sha2_256.tests.ex1 =
|
||||
ex' Sha2_256
|
||||
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
|
||||
"Hi There"
|
||||
"b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7"
|
||||
|
||||
test> hmac_sha2_512.tests.ex1 =
|
||||
ex' Sha2_512
|
||||
"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"
|
||||
@ -369,21 +318,21 @@ test> hmac_sha2_512.tests.ex2 =
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... 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
|
||||
@ -391,33 +340,32 @@ test> hmac_sha2_512.tests.ex2 =
|
||||
|
||||
Cached test results (`help testcache` to learn more)
|
||||
|
||||
◉ blake2b_512.tests.ex1 Passed.
|
||||
◉ blake2b_512.tests.ex2 Passed.
|
||||
◉ blake2b_512.tests.ex3 Passed.
|
||||
◉ blake2s_256.tests.ex1 Passed.
|
||||
◉ hex.tests.ex1 Passed.
|
||||
◉ hmac_sha2_256.tests.ex1 Passed.
|
||||
◉ hmac_sha2_256.tests.ex2 Passed.
|
||||
◉ hmac_sha2_512.tests.ex1 Passed.
|
||||
◉ hmac_sha2_512.tests.ex2 Passed.
|
||||
◉ sha2_256.tests.ex1 Passed.
|
||||
◉ sha2_256.tests.ex2 Passed.
|
||||
◉ sha2_256.tests.ex3 Passed.
|
||||
◉ sha2_256.tests.ex4 Passed.
|
||||
◉ sha2_512.tests.ex1 Passed.
|
||||
◉ sha2_512.tests.ex2 Passed.
|
||||
◉ sha2_512.tests.ex3 Passed.
|
||||
◉ sha2_512.tests.ex4 Passed.
|
||||
◉ sha3_256.tests.ex1 Passed.
|
||||
◉ sha3_256.tests.ex2 Passed.
|
||||
◉ sha3_256.tests.ex3 Passed.
|
||||
◉ sha3_256.tests.ex4 Passed.
|
||||
◉ sha3_512.tests.ex1 Passed.
|
||||
◉ sha3_512.tests.ex2 Passed.
|
||||
◉ sha3_512.tests.ex3 Passed.
|
||||
◉ sha3_512.tests.ex4 Passed.
|
||||
◉ blake2b_512.tests.ex1 Passed
|
||||
◉ blake2b_512.tests.ex2 Passed
|
||||
◉ blake2b_512.tests.ex3 Passed
|
||||
◉ blake2s_256.tests.ex1 Passed
|
||||
◉ hmac_sha2_256.tests.ex1 Passed
|
||||
◉ hmac_sha2_256.tests.ex2 Passed
|
||||
◉ hmac_sha2_512.tests.ex1 Passed
|
||||
◉ hmac_sha2_512.tests.ex2 Passed
|
||||
◉ sha2_256.tests.ex1 Passed
|
||||
◉ sha2_256.tests.ex2 Passed
|
||||
◉ sha2_256.tests.ex3 Passed
|
||||
◉ sha2_256.tests.ex4 Passed
|
||||
◉ sha2_512.tests.ex1 Passed
|
||||
◉ sha2_512.tests.ex2 Passed
|
||||
◉ sha2_512.tests.ex3 Passed
|
||||
◉ sha2_512.tests.ex4 Passed
|
||||
◉ sha3_256.tests.ex1 Passed
|
||||
◉ sha3_256.tests.ex2 Passed
|
||||
◉ sha3_256.tests.ex3 Passed
|
||||
◉ sha3_256.tests.ex4 Passed
|
||||
◉ sha3_512.tests.ex1 Passed
|
||||
◉ sha3_512.tests.ex2 Passed
|
||||
◉ sha3_512.tests.ex3 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
|
||||
test.
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
# tests for IO / MVar
|
||||
# tests for built-in IO functions
|
||||
|
||||
```ucm:hide
|
||||
.> 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.
|
||||
|
||||
```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
|
||||
```
|
||||
|
||||
## 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
|
||||
|
||||
@ -185,23 +37,23 @@ Tests: createDirectory,
|
||||
testCreateRename : '{io2.IO} [Result]
|
||||
testCreateRename _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "fileio")
|
||||
tempDir = newTempDir "fileio"
|
||||
fooDir = tempDir ++ "/foo"
|
||||
barDir = tempDir ++ "/bar"
|
||||
toException let createDirectory.impl fooDir
|
||||
check "create a foo directory" (toException (isDirectory.impl fooDir))
|
||||
check "directory should exist" (toException (fileExists.impl fooDir))
|
||||
toException let renameDirectory.impl fooDir barDir
|
||||
check "foo should no longer exist" (not (toException (fileExists.impl fooDir)))
|
||||
check "directory should no longer exist" (not (toException (fileExists.impl fooDir)))
|
||||
check "bar should now exist" (toException (fileExists.impl barDir))
|
||||
createDirectory.impl fooDir
|
||||
check "create a foo directory" (isDirectory fooDir)
|
||||
check "directory should exist" (fileExists fooDir)
|
||||
renameDirectory fooDir barDir
|
||||
check "foo should no longer exist" (not (fileExists fooDir))
|
||||
check "directory should no longer exist" (not (fileExists fooDir))
|
||||
check "bar should now exist" (fileExists barDir)
|
||||
|
||||
bazDir = barDir ++ "/baz"
|
||||
toException let createDirectory.impl bazDir
|
||||
toException let removeDirectory.impl barDir
|
||||
createDirectory.impl bazDir
|
||||
removeDirectory.impl barDir
|
||||
|
||||
check "removeDirectory works recursively" (not (toException (isDirectory.impl barDir)))
|
||||
check "removeDirectory works recursively" (not (toException (isDirectory.impl bazDir)))
|
||||
check "removeDirectory works recursively" (not (isDirectory barDir))
|
||||
check "removeDirectory works recursively" (not (isDirectory bazDir))
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -220,12 +72,12 @@ Tests: openFile
|
||||
testOpenClose : '{io2.IO} [Result]
|
||||
testOpenClose _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "seek")
|
||||
tempDir = (newTempDir "seek")
|
||||
fooFile = tempDir ++ "/foo"
|
||||
handle1 = toException (openFile.impl fooFile FileMode.Write)
|
||||
check "file should be open" (toException (isFileOpen.impl handle1))
|
||||
toException (closeFile.impl handle1)
|
||||
check "file should be closed" (not (toException (isFileOpen.impl handle1)))
|
||||
handle1 = openFile fooFile FileMode.Write
|
||||
check "file should be open" (isFileOpen handle1)
|
||||
closeFile handle1
|
||||
check "file should be closed" (not (isFileOpen handle1))
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -248,48 +100,47 @@ Tests: openFile
|
||||
testSeek : '{io2.IO} [Result]
|
||||
testSeek _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "seek")
|
||||
tempDir = newTempDir "seek"
|
||||
emit (Ok "seeked")
|
||||
fooFile = tempDir ++ "/foo"
|
||||
handle1 = toException (openFile.impl fooFile FileMode.Append)
|
||||
putBytes.impl handle1 (toUtf8 "12345678")
|
||||
closeFile.impl handle1
|
||||
handle1 = openFile fooFile FileMode.Append
|
||||
putBytes handle1 (toUtf8 "12345678")
|
||||
closeFile handle1
|
||||
|
||||
handle3 = toException (openFile.impl fooFile FileMode.Read)
|
||||
check "readable file should be seekable" (toException (isSeekable.impl handle3))
|
||||
check "shouldn't be the EOF" (not (toException (isFileEOF.impl handle3)))
|
||||
expectU "we should be at position 0" 0 (toException (handlePosition.impl handle3))
|
||||
handle3 = openFile fooFile FileMode.Read
|
||||
check "readable file should be seekable" (isSeekable handle3)
|
||||
check "shouldn't be the EOF" (not (isFileEOF handle3))
|
||||
expectU "we should be at position 0" 0 (handlePosition handle3)
|
||||
|
||||
toException (seekHandle.impl handle3 AbsoluteSeek +1)
|
||||
expectU "we should be at position 1" 1 (toException (handlePosition.impl handle3))
|
||||
bytes3a = toException (getBytes.impl handle3 1000)
|
||||
text3a = toException (Text.fromUtf8.impl bytes3a)
|
||||
seekHandle handle3 AbsoluteSeek +1
|
||||
expectU "we should be at position 1" 1 (handlePosition handle3)
|
||||
bytes3a = getBytes handle3 1000
|
||||
text3a = Text.fromUtf8 bytes3a
|
||||
expectU "should be able to read our temporary file after seeking" "2345678" text3a
|
||||
closeFile.impl handle3
|
||||
closeFile handle3
|
||||
|
||||
runTest test
|
||||
|
||||
testAppend : '{io2.IO} [Result]
|
||||
testAppend _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "openFile")
|
||||
tempDir = newTempDir "openFile"
|
||||
fooFile = tempDir ++ "/foo"
|
||||
handle1 = toException (openFile.impl fooFile FileMode.Write)
|
||||
toException (putBytes.impl handle1 (toUtf8 "test1"))
|
||||
toException (closeFile.impl handle1)
|
||||
handle1 = openFile fooFile FileMode.Write
|
||||
putBytes handle1 (toUtf8 "test1")
|
||||
closeFile handle1
|
||||
|
||||
handle2 = toException (openFile.impl fooFile FileMode.Append)
|
||||
toException (putBytes.impl handle2 (toUtf8 "test2"))
|
||||
toException (closeFile.impl handle2)
|
||||
handle2 = openFile fooFile FileMode.Append
|
||||
putBytes handle2 (toUtf8 "test2")
|
||||
closeFile handle2
|
||||
|
||||
handle3 = toException (openFile.impl fooFile FileMode.Read)
|
||||
bytes3 = toException (getBytes.impl handle3 1000)
|
||||
text3 = toException (Text.fromUtf8.impl bytes3)
|
||||
handle3 = openFile fooFile FileMode.Read
|
||||
bytes3 = getBytes handle3 1000
|
||||
text3 = Text.fromUtf8 bytes3
|
||||
|
||||
expectU "should be able to read our temporary file" "test1test2" text3
|
||||
|
||||
closeFile.impl handle3
|
||||
|
||||
closeFile handle3
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -304,7 +155,7 @@ testAppend _ =
|
||||
testSystemTime : '{io2.IO} [Result]
|
||||
testSystemTime _ =
|
||||
test = 'let
|
||||
t = toException !io2.IO.systemTime.impl
|
||||
t = !systemTime
|
||||
check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000))
|
||||
|
||||
runTest test
|
||||
@ -313,11 +164,3 @@ testSystemTime _ =
|
||||
.> add
|
||||
.> 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.
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
# tests for IO / MVar
|
||||
# tests for built-in IO functions
|
||||
|
||||
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.
|
||||
|
||||
```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
|
||||
|
||||
### Creating/Deleting/Renaming Directories
|
||||
@ -201,23 +26,23 @@ Tests: createDirectory,
|
||||
testCreateRename : '{io2.IO} [Result]
|
||||
testCreateRename _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "fileio")
|
||||
tempDir = newTempDir "fileio"
|
||||
fooDir = tempDir ++ "/foo"
|
||||
barDir = tempDir ++ "/bar"
|
||||
toException let createDirectory.impl fooDir
|
||||
check "create a foo directory" (toException (isDirectory.impl fooDir))
|
||||
check "directory should exist" (toException (fileExists.impl fooDir))
|
||||
toException let renameDirectory.impl fooDir barDir
|
||||
check "foo should no longer exist" (not (toException (fileExists.impl fooDir)))
|
||||
check "directory should no longer exist" (not (toException (fileExists.impl fooDir)))
|
||||
check "bar should now exist" (toException (fileExists.impl barDir))
|
||||
createDirectory.impl fooDir
|
||||
check "create a foo directory" (isDirectory fooDir)
|
||||
check "directory should exist" (fileExists fooDir)
|
||||
renameDirectory fooDir barDir
|
||||
check "foo should no longer exist" (not (fileExists fooDir))
|
||||
check "directory should no longer exist" (not (fileExists fooDir))
|
||||
check "bar should now exist" (fileExists barDir)
|
||||
|
||||
bazDir = barDir ++ "/baz"
|
||||
toException let createDirectory.impl bazDir
|
||||
toException let removeDirectory.impl barDir
|
||||
createDirectory.impl bazDir
|
||||
removeDirectory.impl barDir
|
||||
|
||||
check "removeDirectory works recursively" (not (toException (isDirectory.impl barDir)))
|
||||
check "removeDirectory works recursively" (not (toException (isDirectory.impl bazDir)))
|
||||
check "removeDirectory works recursively" (not (isDirectory barDir))
|
||||
check "removeDirectory works recursively" (not (isDirectory bazDir))
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -267,12 +92,12 @@ Tests: openFile
|
||||
testOpenClose : '{io2.IO} [Result]
|
||||
testOpenClose _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "seek")
|
||||
tempDir = (newTempDir "seek")
|
||||
fooFile = tempDir ++ "/foo"
|
||||
handle1 = toException (openFile.impl fooFile FileMode.Write)
|
||||
check "file should be open" (toException (isFileOpen.impl handle1))
|
||||
toException (closeFile.impl handle1)
|
||||
check "file should be closed" (not (toException (isFileOpen.impl handle1)))
|
||||
handle1 = openFile fooFile FileMode.Write
|
||||
check "file should be open" (isFileOpen handle1)
|
||||
closeFile handle1
|
||||
check "file should be closed" (not (isFileOpen handle1))
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -321,48 +146,47 @@ Tests: openFile
|
||||
testSeek : '{io2.IO} [Result]
|
||||
testSeek _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "seek")
|
||||
tempDir = newTempDir "seek"
|
||||
emit (Ok "seeked")
|
||||
fooFile = tempDir ++ "/foo"
|
||||
handle1 = toException (openFile.impl fooFile FileMode.Append)
|
||||
putBytes.impl handle1 (toUtf8 "12345678")
|
||||
closeFile.impl handle1
|
||||
handle1 = openFile fooFile FileMode.Append
|
||||
putBytes handle1 (toUtf8 "12345678")
|
||||
closeFile handle1
|
||||
|
||||
handle3 = toException (openFile.impl fooFile FileMode.Read)
|
||||
check "readable file should be seekable" (toException (isSeekable.impl handle3))
|
||||
check "shouldn't be the EOF" (not (toException (isFileEOF.impl handle3)))
|
||||
expectU "we should be at position 0" 0 (toException (handlePosition.impl handle3))
|
||||
handle3 = openFile fooFile FileMode.Read
|
||||
check "readable file should be seekable" (isSeekable handle3)
|
||||
check "shouldn't be the EOF" (not (isFileEOF handle3))
|
||||
expectU "we should be at position 0" 0 (handlePosition handle3)
|
||||
|
||||
toException (seekHandle.impl handle3 AbsoluteSeek +1)
|
||||
expectU "we should be at position 1" 1 (toException (handlePosition.impl handle3))
|
||||
bytes3a = toException (getBytes.impl handle3 1000)
|
||||
text3a = toException (Text.fromUtf8.impl bytes3a)
|
||||
seekHandle handle3 AbsoluteSeek +1
|
||||
expectU "we should be at position 1" 1 (handlePosition handle3)
|
||||
bytes3a = getBytes handle3 1000
|
||||
text3a = Text.fromUtf8 bytes3a
|
||||
expectU "should be able to read our temporary file after seeking" "2345678" text3a
|
||||
closeFile.impl handle3
|
||||
closeFile handle3
|
||||
|
||||
runTest test
|
||||
|
||||
testAppend : '{io2.IO} [Result]
|
||||
testAppend _ =
|
||||
test = 'let
|
||||
tempDir = toException (newTempDir "openFile")
|
||||
tempDir = newTempDir "openFile"
|
||||
fooFile = tempDir ++ "/foo"
|
||||
handle1 = toException (openFile.impl fooFile FileMode.Write)
|
||||
toException (putBytes.impl handle1 (toUtf8 "test1"))
|
||||
toException (closeFile.impl handle1)
|
||||
handle1 = openFile fooFile FileMode.Write
|
||||
putBytes handle1 (toUtf8 "test1")
|
||||
closeFile handle1
|
||||
|
||||
handle2 = toException (openFile.impl fooFile FileMode.Append)
|
||||
toException (putBytes.impl handle2 (toUtf8 "test2"))
|
||||
toException (closeFile.impl handle2)
|
||||
handle2 = openFile fooFile FileMode.Append
|
||||
putBytes handle2 (toUtf8 "test2")
|
||||
closeFile handle2
|
||||
|
||||
handle3 = toException (openFile.impl fooFile FileMode.Read)
|
||||
bytes3 = toException (getBytes.impl handle3 1000)
|
||||
text3 = toException (Text.fromUtf8.impl bytes3)
|
||||
handle3 = openFile fooFile FileMode.Read
|
||||
bytes3 = getBytes handle3 1000
|
||||
text3 = Text.fromUtf8 bytes3
|
||||
|
||||
expectU "should be able to read our temporary file" "test1test2" text3
|
||||
|
||||
closeFile.impl handle3
|
||||
|
||||
closeFile handle3
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -418,7 +242,7 @@ testAppend _ =
|
||||
testSystemTime : '{io2.IO} [Result]
|
||||
testSystemTime _ =
|
||||
test = 'let
|
||||
t = toException !io2.IO.systemTime.impl
|
||||
t = !systemTime
|
||||
check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000))
|
||||
|
||||
runTest test
|
||||
@ -453,10 +277,3 @@ testSystemTime _ =
|
||||
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.
|
||||
|
||||
|
||||
@ -1,103 +1,5 @@
|
||||
# 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
|
||||
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
|
||||
@ -116,13 +18,13 @@ testMvars _ =
|
||||
test2 = "test2"
|
||||
ma = MVar.new test
|
||||
check "ma should not be empty" (not (isEmpty ma))
|
||||
test' = toException (take ma)
|
||||
test' = take ma
|
||||
expectU "should reap what you sow" test test'
|
||||
check "ma should be empty" (isEmpty ma)
|
||||
toException (put ma test)
|
||||
test'' = toException (swap ma test2)
|
||||
put ma test
|
||||
test'' = swap ma test2
|
||||
expectU "swap returns old contents" test test''
|
||||
test''' = toException (swap ma test)
|
||||
test''' = swap ma test
|
||||
expectU "swap returns old contents" test2 test'''
|
||||
|
||||
ma2 = !MVar.newEmpty
|
||||
|
||||
77
unison-src/new-runtime-transcripts/mvar.output.md
Normal file
77
unison-src/new-runtime-transcripts/mvar.output.md
Normal 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.
|
||||
|
||||
```
|
||||
@ -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
|
||||
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)
|
||||
serverSocket = compose2 reraise serverSocket.impl
|
||||
socketPort = compose reraise socketPort.impl
|
||||
listen = compose reraise listen.impl
|
||||
closeSocket = compose reraise closeSocket.impl
|
||||
clientSocket = compose2 reraise clientSocket.impl
|
||||
socketSend = compose2 reraise socketSend.impl
|
||||
socketReceive = compose2 reraise socketReceive.impl
|
||||
socketAccept = compose reraise socketAccept.impl
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
.> add
|
||||
```
|
||||
|
||||
# Tests for network related builtins
|
||||
|
||||
### Creating server sockets
|
||||
|
||||
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 _ =
|
||||
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")
|
||||
port = toException (socketPort sock)
|
||||
putBytes.impl (stdHandle StdOut) (toUtf8 (toText port))
|
||||
expectU Nat.toText "should have bound to port 1028" 1028 port
|
||||
port = socketPort sock
|
||||
putBytes (stdHandle StdOut) (toUtf8 (toText port))
|
||||
expectU "should have bound to port 1028" 1028 port
|
||||
|
||||
runTest test
|
||||
|
||||
testDefaultHost : '{io2.IO} [Result]
|
||||
testDefaultHost _ =
|
||||
test = 'let
|
||||
sock = toException (io2.IO.serverSocket.impl None "1028")
|
||||
sock = serverSocket None "1028"
|
||||
emit (Ok "successfully created socket")
|
||||
port = toException (socketPort sock)
|
||||
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port)))
|
||||
expectU Nat.toText "should have bound to port 1028" 1028 port
|
||||
port = socketPort sock
|
||||
putBytes (stdHandle StdOut) (toUtf8 (toText port))
|
||||
expectU "should have bound to port 1028" 1028 port
|
||||
|
||||
runTest test
|
||||
|
||||
testDefaultPort : '{io2.IO} [Result]
|
||||
testDefaultPort _ =
|
||||
test = 'let
|
||||
sock = toException (io2.IO.serverSocket.impl None "0")
|
||||
sock = serverSocket None "0"
|
||||
emit (Ok "successfully created socket")
|
||||
port = toException (socketPort sock)
|
||||
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port)))
|
||||
port = socketPort sock
|
||||
putBytes (stdHandle StdOut) (toUtf8 (toText port))
|
||||
|
||||
check "port should be > 1024" (1024 < 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 portVar toSend = 'let
|
||||
go : '{io2.IO, Exception}()
|
||||
go = 'let
|
||||
sock = toException (serverSocket.impl (Some "127.0.0.1") "0")
|
||||
port = toException (socketPort sock)
|
||||
toException (put.impl portVar port)
|
||||
toException (listen.impl sock)
|
||||
sock' = toException (socketAccept.impl sock)
|
||||
toException (socketSend.impl sock' (toUtf8 toSend))
|
||||
toException (closeSocket.impl sock')
|
||||
sock = serverSocket (Some "127.0.0.1") "0"
|
||||
port = socketPort sock
|
||||
put portVar port
|
||||
listen sock
|
||||
sock' = socketAccept sock
|
||||
socketSend sock' (toUtf8 toSend)
|
||||
closeSocket sock'
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -198,12 +119,11 @@ serverThread portVar toSend = 'let
|
||||
|
||||
clientThread : MVar Nat -> MVar Text -> '{io2.IO}()
|
||||
clientThread portVar resultVar = 'let
|
||||
go : '{io2.IO, Exception Failure}()
|
||||
go = 'let
|
||||
port = toException (take.impl portVar)
|
||||
sock = toException (clientSocket.impl "127.0.0.1" (Nat.toText port))
|
||||
msg = toException (fromUtf8.impl (toException (socketReceive.impl sock 100)))
|
||||
toException (put.impl resultVar msg)
|
||||
port = take portVar
|
||||
sock = clientSocket "127.0.0.1" (Nat.toText port)
|
||||
msg = fromUtf8 (socketReceive sock 100)
|
||||
put resultVar msg
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -220,9 +140,9 @@ testTcpConnect = 'let
|
||||
forkComp (serverThread portVar toSend)
|
||||
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
|
||||
|
||||
|
||||
@ -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
|
||||
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)
|
||||
serverSocket = compose2 reraise serverSocket.impl
|
||||
socketPort = compose reraise socketPort.impl
|
||||
listen = compose reraise listen.impl
|
||||
closeSocket = compose reraise closeSocket.impl
|
||||
clientSocket = compose2 reraise clientSocket.impl
|
||||
socketSend = compose2 reraise socketSend.impl
|
||||
socketReceive = compose2 reraise socketReceive.impl
|
||||
socketAccept = compose reraise socketAccept.impl
|
||||
```
|
||||
|
||||
# Tests for network related builtins
|
||||
|
||||
### Creating server sockets
|
||||
|
||||
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 _ =
|
||||
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")
|
||||
port = toException (socketPort sock)
|
||||
putBytes.impl (stdHandle StdOut) (toUtf8 (toText port))
|
||||
expectU Nat.toText "should have bound to port 1028" 1028 port
|
||||
port = socketPort sock
|
||||
putBytes (stdHandle StdOut) (toUtf8 (toText port))
|
||||
expectU "should have bound to port 1028" 1028 port
|
||||
|
||||
runTest test
|
||||
|
||||
testDefaultHost : '{io2.IO} [Result]
|
||||
testDefaultHost _ =
|
||||
test = 'let
|
||||
sock = toException (io2.IO.serverSocket.impl None "1028")
|
||||
sock = serverSocket None "1028"
|
||||
emit (Ok "successfully created socket")
|
||||
port = toException (socketPort sock)
|
||||
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port)))
|
||||
expectU Nat.toText "should have bound to port 1028" 1028 port
|
||||
port = socketPort sock
|
||||
putBytes (stdHandle StdOut) (toUtf8 (toText port))
|
||||
expectU "should have bound to port 1028" 1028 port
|
||||
|
||||
runTest test
|
||||
|
||||
testDefaultPort : '{io2.IO} [Result]
|
||||
testDefaultPort _ =
|
||||
test = 'let
|
||||
sock = toException (io2.IO.serverSocket.impl None "0")
|
||||
sock = serverSocket None "0"
|
||||
emit (Ok "successfully created socket")
|
||||
port = toException (socketPort sock)
|
||||
toException (putBytes.impl (stdHandle StdOut) (toUtf8 (toText port)))
|
||||
port = socketPort sock
|
||||
putBytes (stdHandle StdOut) (toUtf8 (toText port))
|
||||
|
||||
check "port should be > 1024" (1024 < 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
|
||||
serverThread: MVar Nat -> Text -> '{io2.IO}()
|
||||
serverThread portVar toSend = 'let
|
||||
go : '{io2.IO, Exception}()
|
||||
go = 'let
|
||||
sock = toException (serverSocket.impl (Some "127.0.0.1") "0")
|
||||
port = toException (socketPort sock)
|
||||
toException (put.impl portVar port)
|
||||
toException (listen.impl sock)
|
||||
sock' = toException (socketAccept.impl sock)
|
||||
toException (socketSend.impl sock' (toUtf8 toSend))
|
||||
toException (closeSocket.impl sock')
|
||||
sock = serverSocket (Some "127.0.0.1") "0"
|
||||
port = socketPort sock
|
||||
put portVar port
|
||||
listen sock
|
||||
sock' = socketAccept sock
|
||||
socketSend sock' (toUtf8 toSend)
|
||||
closeSocket sock'
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -221,12 +147,11 @@ serverThread portVar toSend = 'let
|
||||
|
||||
clientThread : MVar Nat -> MVar Text -> '{io2.IO}()
|
||||
clientThread portVar resultVar = 'let
|
||||
go : '{io2.IO, Exception Failure}()
|
||||
go = 'let
|
||||
port = toException (take.impl portVar)
|
||||
sock = toException (clientSocket.impl "127.0.0.1" (Nat.toText port))
|
||||
msg = toException (fromUtf8.impl (toException (socketReceive.impl sock 100)))
|
||||
toException (put.impl resultVar msg)
|
||||
port = take portVar
|
||||
sock = clientSocket "127.0.0.1" (Nat.toText port)
|
||||
msg = fromUtf8 (socketReceive sock 100)
|
||||
put resultVar msg
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -243,9 +168,9 @@ testTcpConnect = 'let
|
||||
forkComp (serverThread portVar toSend)
|
||||
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
|
||||
|
||||
|
||||
@ -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.
|
||||
Some thread delaying is just accomplished by counting in a loop.
|
||||
```unison
|
||||
use io2
|
||||
|
||||
count : Nat -> ()
|
||||
count = cases
|
||||
0 -> ()
|
||||
n -> count (drop n 1)
|
||||
|
||||
inc : TVar Nat ->{IO} Nat
|
||||
inc : TVar Nat ->{io2.IO} Nat
|
||||
inc v =
|
||||
atomically 'let
|
||||
x = TVar.read v
|
||||
TVar.write v (x+1)
|
||||
x
|
||||
|
||||
loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat
|
||||
loop : '{io2.IO} Nat -> Nat -> Nat ->{io2.IO} Nat
|
||||
loop grab acc = cases
|
||||
0 -> acc
|
||||
n ->
|
||||
@ -53,7 +21,7 @@ loop grab acc = cases
|
||||
count (m*10)
|
||||
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 =
|
||||
n = loop '(inc v) 0 k
|
||||
atomically '(TVar.write out (Some n))
|
||||
@ -66,7 +34,7 @@ body k out v =
|
||||
Test case.
|
||||
|
||||
```unison
|
||||
spawn : Nat ->{IO} Result
|
||||
spawn : Nat ->{io2.IO} Result
|
||||
spawn k = let
|
||||
out1 = TVar.newIO None
|
||||
out2 = TVar.newIO None
|
||||
@ -94,7 +62,7 @@ display m n s =
|
||||
nats : [Nat]
|
||||
nats = [89,100,116,144,169,188,200,233,256,300]
|
||||
|
||||
tests : '{IO} [Result]
|
||||
tests : '{io2.IO} [Result]
|
||||
tests = '(map spawn nats)
|
||||
```
|
||||
|
||||
|
||||
@ -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.
|
||||
Some thread delaying is just accomplished by counting in a loop.
|
||||
```unison
|
||||
use io2
|
||||
|
||||
count : Nat -> ()
|
||||
count = cases
|
||||
0 -> ()
|
||||
n -> count (drop n 1)
|
||||
|
||||
inc : TVar Nat ->{IO} Nat
|
||||
inc : TVar Nat ->{io2.IO} Nat
|
||||
inc v =
|
||||
atomically 'let
|
||||
x = TVar.read v
|
||||
TVar.write v (x+1)
|
||||
x
|
||||
|
||||
loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat
|
||||
loop : '{io2.IO} Nat -> Nat -> Nat ->{io2.IO} Nat
|
||||
loop grab acc = cases
|
||||
0 -> acc
|
||||
n ->
|
||||
@ -74,7 +21,7 @@ loop grab acc = cases
|
||||
count (m*10)
|
||||
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 =
|
||||
n = loop '(inc v) 0 k
|
||||
atomically '(TVar.write out (Some n))
|
||||
@ -88,10 +35,16 @@ body k out v =
|
||||
|
||||
⍟ 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 -> ()
|
||||
inc : TVar Nat ->{IO} Nat
|
||||
loop : '{IO} Nat ->{IO} Nat ->{IO} Nat ->{IO} Nat
|
||||
inc : TVar Nat ->{io2.IO} Nat
|
||||
loop : '{io2.IO} Nat
|
||||
->{io2.IO} Nat
|
||||
->{io2.IO} Nat
|
||||
->{io2.IO} Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
@ -99,16 +52,19 @@ body k out v =
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} ()
|
||||
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{io2.IO} ()
|
||||
count : Nat -> ()
|
||||
inc : TVar Nat ->{IO} Nat
|
||||
loop : '{IO} Nat ->{IO} Nat ->{IO} Nat ->{IO} Nat
|
||||
inc : TVar Nat ->{io2.IO} Nat
|
||||
loop : '{io2.IO} Nat
|
||||
->{io2.IO} Nat
|
||||
->{io2.IO} Nat
|
||||
->{io2.IO} Nat
|
||||
|
||||
```
|
||||
Test case.
|
||||
|
||||
```unison
|
||||
spawn : Nat ->{IO} Result
|
||||
spawn : Nat ->{io2.IO} Result
|
||||
spawn k = let
|
||||
out1 = TVar.newIO None
|
||||
out2 = TVar.newIO None
|
||||
@ -136,7 +92,7 @@ display m n s =
|
||||
nats : [Nat]
|
||||
nats = [89,100,116,144,169,188,200,233,256,300]
|
||||
|
||||
tests : '{IO} [Result]
|
||||
tests : '{io2.IO} [Result]
|
||||
tests = '(map spawn nats)
|
||||
```
|
||||
|
||||
@ -150,8 +106,8 @@ tests = '(map spawn nats)
|
||||
|
||||
display : Nat -> Nat -> Nat -> Text
|
||||
nats : [Nat]
|
||||
spawn : Nat ->{IO} Result
|
||||
tests : '{IO} [Result]
|
||||
spawn : Nat ->{io2.IO} Result
|
||||
tests : '{io2.IO} [Result]
|
||||
|
||||
```
|
||||
```ucm
|
||||
@ -161,8 +117,8 @@ tests = '(map spawn nats)
|
||||
|
||||
display : Nat -> Nat -> Nat -> Text
|
||||
nats : [Nat]
|
||||
spawn : Nat ->{IO} Result
|
||||
tests : '{IO} [Result]
|
||||
spawn : Nat ->{io2.IO} Result
|
||||
tests : '{io2.IO} [Result]
|
||||
|
||||
.> io.test tests
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -121,10 +27,9 @@ See if we can get another thread to stuff a value into a MVar
|
||||
```unison
|
||||
thread1 : MVar Nat -> '{io2.IO}()
|
||||
thread1 mv = 'let
|
||||
go : '{io2.IO, Exception Failure} ()
|
||||
go = 'let
|
||||
x = toException (take.impl mv)
|
||||
toException (put.impl mv (increment x))
|
||||
x = take mv
|
||||
put mv (increment x)
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -133,12 +38,11 @@ thread1 mv = 'let
|
||||
|
||||
testBasicMultiThreadMVar : '{io2.IO} [Result]
|
||||
testBasicMultiThreadMVar = 'let
|
||||
test: '{io2.IO, Exception Failure, Stream Result} ()
|
||||
test = 'let
|
||||
mv = new 10
|
||||
.builtin.io2.IO.forkComp (thread1 mv)
|
||||
next = toException (take.impl mv)
|
||||
expectU Nat.toText "other thread should have incremented" 11 next
|
||||
next = take mv
|
||||
expectU "other thread should have incremented" 11 next
|
||||
|
||||
runTest test
|
||||
|
||||
@ -153,9 +57,8 @@ testBasicMultiThreadMVar = 'let
|
||||
```unison
|
||||
sendingThread: Nat -> MVar Nat -> '{io2.IO}()
|
||||
sendingThread toSend mv = 'let
|
||||
go : '{io2.IO, Exception Failure} ()
|
||||
go = 'let
|
||||
toException (put.impl mv (increment toSend))
|
||||
put mv (increment toSend)
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -164,10 +67,9 @@ sendingThread toSend mv = 'let
|
||||
|
||||
receivingThread: MVar Nat -> MVar Text -> '{io2.IO}()
|
||||
receivingThread recv send = 'let
|
||||
go : '{io2.IO, Exception Failure} ()
|
||||
go = 'let
|
||||
recvd = toException (take.impl recv)
|
||||
toException (put.impl send (toText recvd))
|
||||
recvd = take recv
|
||||
put send (toText recvd)
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -182,9 +84,9 @@ testTwoThreads = 'let
|
||||
.builtin.io2.IO.forkComp (sendingThread 6 send)
|
||||
.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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -119,10 +34,9 @@ See if we can get another thread to stuff a value into a MVar
|
||||
```unison
|
||||
thread1 : MVar Nat -> '{io2.IO}()
|
||||
thread1 mv = 'let
|
||||
go : '{io2.IO, Exception Failure} ()
|
||||
go = 'let
|
||||
x = toException (take.impl mv)
|
||||
toException (put.impl mv (increment x))
|
||||
x = take mv
|
||||
put mv (increment x)
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -131,12 +45,11 @@ thread1 mv = 'let
|
||||
|
||||
testBasicMultiThreadMVar : '{io2.IO} [Result]
|
||||
testBasicMultiThreadMVar = 'let
|
||||
test: '{io2.IO, Exception Failure, Stream Result} ()
|
||||
test = 'let
|
||||
mv = new 10
|
||||
.builtin.io2.IO.forkComp (thread1 mv)
|
||||
next = toException (take.impl mv)
|
||||
expectU Nat.toText "other thread should have incremented" 11 next
|
||||
next = take mv
|
||||
expectU "other thread should have incremented" 11 next
|
||||
|
||||
runTest test
|
||||
|
||||
@ -178,9 +91,8 @@ testBasicMultiThreadMVar = 'let
|
||||
```unison
|
||||
sendingThread: Nat -> MVar Nat -> '{io2.IO}()
|
||||
sendingThread toSend mv = 'let
|
||||
go : '{io2.IO, Exception Failure} ()
|
||||
go = 'let
|
||||
toException (put.impl mv (increment toSend))
|
||||
put mv (increment toSend)
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -189,10 +101,9 @@ sendingThread toSend mv = 'let
|
||||
|
||||
receivingThread: MVar Nat -> MVar Text -> '{io2.IO}()
|
||||
receivingThread recv send = 'let
|
||||
go : '{io2.IO, Exception Failure} ()
|
||||
go = 'let
|
||||
recvd = toException (take.impl recv)
|
||||
toException (put.impl send (toText recvd))
|
||||
recvd = take recv
|
||||
put send (toText recvd)
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch t ()
|
||||
@ -207,9 +118,9 @@ testTwoThreads = 'let
|
||||
.builtin.io2.IO.forkComp (sendingThread 6 send)
|
||||
.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
|
||||
|
||||
|
||||
@ -1,120 +1,13 @@
|
||||
# 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
|
||||
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:
|
||||
-- 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_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
|
||||
@ -126,7 +19,7 @@ self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk
|
||||
First lets make sure we can load our cert and private key
|
||||
|
||||
```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]
|
||||
Right _ -> [Ok "succesfully decoded self_signed_pem"]
|
||||
|
||||
@ -143,9 +36,10 @@ the client can read.
|
||||
```unison
|
||||
serverThread: MVar Nat -> Text -> '{io2.IO}()
|
||||
serverThread portVar toSend = 'let
|
||||
go: '{io2.IO, Exception}()
|
||||
go = 'let
|
||||
-- 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
|
||||
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
|
||||
@ -155,38 +49,38 @@ serverThread portVar toSend = 'let
|
||||
|
||||
-- Open a TCP server 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
|
||||
port = socketPort sock |> toException
|
||||
port = socketPort sock
|
||||
|
||||
-- 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
|
||||
listen.impl sock |> toException
|
||||
listen sock
|
||||
|
||||
watch ("server listening on port: " ++ (toText port)) ()
|
||||
|
||||
-- accept a single connection on this socket
|
||||
sock' = socketAccept.impl sock |> toException
|
||||
sock' = socketAccept sock
|
||||
|
||||
-- attach TLS to our TCP connection
|
||||
tls = newServer tlsconfig sock' |> toException
|
||||
tls = newServer tlsconfig sock'
|
||||
|
||||
-- try to handshake the TLS connection with the client
|
||||
handshake tls |> toException
|
||||
handshake tls
|
||||
|
||||
-- send our message over our tls channel
|
||||
send tls (toUtf8 toSend) |> toException
|
||||
terminate tls |> toException
|
||||
closeSocket.impl sock' |> toException
|
||||
send tls (toUtf8 toSend)
|
||||
terminate tls
|
||||
closeSocket sock'
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch ("error in server: " ++ t) ()
|
||||
_ -> 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 _ =
|
||||
-- create a client that will expect a cert from the given hostname (CN)
|
||||
defaultClient = (Tls.ClientConfig.default hostname Bytes.empty)
|
||||
@ -197,22 +91,22 @@ testClient cert hostname portVar _ =
|
||||
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
|
||||
|
||||
-- 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
|
||||
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
|
||||
tls = newClient tlsconfig sock |> toException
|
||||
tls = newClient tlsconfig sock
|
||||
watch ("client connecting to port: " ++ (toText port)) ()
|
||||
|
||||
-- verify that the server presents us with a certificate chain for
|
||||
-- test.unison.cloud originating with a certificate we trust, and
|
||||
-- that the server can use a compatible TLS version and cipher
|
||||
handshake tls |> toException
|
||||
handshake tls
|
||||
|
||||
-- receive a message from the server
|
||||
fromUtf8.impl (toException (receive tls)) |> toException
|
||||
fromUtf8 (receive tls)
|
||||
|
||||
testConnectSelfSigned : '{io2.IO}[Result]
|
||||
testConnectSelfSigned _ =
|
||||
@ -223,10 +117,10 @@ testConnectSelfSigned _ =
|
||||
forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem)
|
||||
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
|
||||
|
||||
|
||||
@ -1,114 +1,13 @@
|
||||
# Tests for TLS builtins
|
||||
|
||||
## Setup
|
||||
|
||||
You can skip the section which is just needed to make the transcript self-contained.
|
||||
|
||||
```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:
|
||||
-- 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_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
|
||||
@ -116,7 +15,7 @@ self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk
|
||||
First lets make sure we can load our cert and private key
|
||||
|
||||
```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]
|
||||
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
|
||||
`>`)... 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
|
||||
|
||||
@ -151,9 +50,10 @@ the client can read.
|
||||
```unison
|
||||
serverThread: MVar Nat -> Text -> '{io2.IO}()
|
||||
serverThread portVar toSend = 'let
|
||||
go: '{io2.IO, Exception}()
|
||||
go = 'let
|
||||
-- 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
|
||||
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
|
||||
@ -163,38 +63,38 @@ serverThread portVar toSend = 'let
|
||||
|
||||
-- Open a TCP server 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
|
||||
port = socketPort sock |> toException
|
||||
port = socketPort sock
|
||||
|
||||
-- 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
|
||||
listen.impl sock |> toException
|
||||
listen sock
|
||||
|
||||
watch ("server listening on port: " ++ (toText port)) ()
|
||||
|
||||
-- accept a single connection on this socket
|
||||
sock' = socketAccept.impl sock |> toException
|
||||
sock' = socketAccept sock
|
||||
|
||||
-- attach TLS to our TCP connection
|
||||
tls = newServer tlsconfig sock' |> toException
|
||||
tls = newServer tlsconfig sock'
|
||||
|
||||
-- try to handshake the TLS connection with the client
|
||||
handshake tls |> toException
|
||||
handshake tls
|
||||
|
||||
-- send our message over our tls channel
|
||||
send tls (toUtf8 toSend) |> toException
|
||||
terminate tls |> toException
|
||||
closeSocket.impl sock' |> toException
|
||||
send tls (toUtf8 toSend)
|
||||
terminate tls
|
||||
closeSocket sock'
|
||||
|
||||
match (toEither go) with
|
||||
Left (Failure _ t _) -> watch ("error in server: " ++ t) ()
|
||||
_ -> 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 _ =
|
||||
-- create a client that will expect a cert from the given hostname (CN)
|
||||
defaultClient = (Tls.ClientConfig.default hostname Bytes.empty)
|
||||
@ -205,22 +105,22 @@ testClient cert hostname portVar _ =
|
||||
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
|
||||
|
||||
-- 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
|
||||
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
|
||||
tls = newClient tlsconfig sock |> toException
|
||||
tls = newClient tlsconfig sock
|
||||
watch ("client connecting to port: " ++ (toText port)) ()
|
||||
|
||||
-- verify that the server presents us with a certificate chain for
|
||||
-- test.unison.cloud originating with a certificate we trust, and
|
||||
-- that the server can use a compatible TLS version and cipher
|
||||
handshake tls |> toException
|
||||
handshake tls
|
||||
|
||||
-- receive a message from the server
|
||||
fromUtf8.impl (toException (receive tls)) |> toException
|
||||
fromUtf8 (receive tls)
|
||||
|
||||
testConnectSelfSigned : '{io2.IO}[Result]
|
||||
testConnectSelfSigned _ =
|
||||
@ -231,10 +131,10 @@ testConnectSelfSigned _ =
|
||||
forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem)
|
||||
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
|
||||
|
||||
@ -301,7 +201,7 @@ testCNReject _ =
|
||||
testClient : Optional SignedCert
|
||||
-> Text
|
||||
-> MVar Nat
|
||||
-> '{io2.IO, Exception Failure} Text
|
||||
-> '{io2.IO, Exception} Text
|
||||
testConnectSelfSigned : '{io2.IO} [Result]
|
||||
|
||||
```
|
||||
@ -316,7 +216,7 @@ testCNReject _ =
|
||||
testClient : Optional SignedCert
|
||||
-> Text
|
||||
-> MVar Nat
|
||||
-> '{io2.IO, Exception Failure} Text
|
||||
-> '{io2.IO, Exception} Text
|
||||
testConnectSelfSigned : '{io2.IO} [Result]
|
||||
|
||||
.> io.test testConnectSelfSigned
|
||||
|
||||
@ -5,8 +5,9 @@ Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding o
|
||||
```ucm
|
||||
.> find Utf8
|
||||
|
||||
1. builtin.Text.toUtf8 : Text -> Bytes
|
||||
2. builtin.Text.fromUtf8.impl : Bytes -> Either Failure Text
|
||||
1. Text.fromUtf8 : Bytes ->{Exception} 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
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
⍟ These names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
ascii : Text
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user