unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-22 07:48:10 +03:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/trunk' into wip/codebase2

Browse Source 
but IO.handleOPs fails
# Conflicts:
#	parser-typechecker/src/Unison/Builtin.hs
#	parser-typechecker/src/Unison/Builtin/Decls.hs
#	parser-typechecker/src/Unison/Builtin/Terms.hs
#	parser-typechecker/src/Unison/Codebase.hs
#	parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs
#	parser-typechecker/unison-parser-typechecker.cabal
#	unison-src/transcripts/isPropagated-exists.md
#	unison-src/transcripts/isPropagated-exists.output.md
This commit is contained in:
Arya Irani 2021-02-11 21:59:26 -05:00
commit 93968af9ad
45 changed files with 3197 additions and 825 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -2,6 +2,7 @@
.unison*
test-output
transcript-*
scratch.u
# Stack
.stack-work

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

@ -61,7 +61,8 @@ names0 = Names3.names0 terms types where
| (ct, (_,(r,decl))) <- ((CT.Data,) <$> builtinDataDecls @Symbol) <>
((CT.Effect,) . (second . second) DD.toDataDecl <$> builtinEffectDecls)
, ((_,vc,_), cid) <- DD.constructors' decl `zip` [0..]] <>
Rel.fromList [ (Name.fromVar v, Referent.Ref (R.DerivedId i)) | (v,i) <- Map.toList $ TD.builtinTermsRef @Symbol Intrinsic]
Rel.fromList [ (Name.fromVar v, Referent.Ref (R.DerivedId i))
| (v,i) <- Map.toList $ TD.builtinTermsRef @Symbol Intrinsic]
types = Rel.fromList builtinTypes <>
Rel.fromList [ (Name.fromVar v, R.DerivedId r)
| (v,(r,_)) <- builtinDataDecls @Symbol ] <>
@ -169,9 +170,15 @@ builtinTypesSrc =
, B' "Value" CT.Data
, B' "Any" CT.Data
, B' "crypto.HashAlgorithm" CT.Data
, B' "IOFailure" CT.Data, Rename' "IOFailure" "io2.IOFailure"
, B' "TlsFailure" CT.Data, Rename' "TlsFailure" "io2.TlsFailure"
, B' "Tls" CT.Data, Rename' "Tls" "io2.Tls"
, B' "Tls.ClientConfig" CT.Data, Rename' "Tls.ClientConfig" "io2.Tls.ClientConfig"
, B' "Tls.ServerConfig" CT.Data, Rename' "Tls.ServerConfig" "io2.Tls.ServerConfig"
, B' "Tls.SignedCert" CT.Data, Rename' "Tls.SignedCert" "io2.Tls.SignedCert"
, B' "Tls.PrivateKey" CT.Data, Rename' "Tls.PrivateKey" "io2.Tls.PrivateKey"
, B' "TVar" CT.Data, Rename' "TVar" "io2.TVar"
, B' "STM" CT.Effect, Rename' "STM" "io2.STM"
]
-- rename these to "builtin" later, when builtin means intrinsic as opposed to
@ -388,7 +395,7 @@ builtinsSrc =
, B "Text.toCharList" $ text --> list char
, B "Text.fromCharList" $ list char --> text
, B "Text.toUtf8" $ text --> bytes
, B "Text.fromUtf8.v2" $ bytes --> eithert failure text
, B "Text.fromUtf8.v3" $ bytes --> eithert failure text
, B "Char.toNat" $ char --> nat
, B "Char.fromNat" $ nat --> char
@ -443,10 +450,10 @@ builtinsSrc =
,(">=", "gteq")]
] ++ moveUnder "io2" ioBuiltins
++ moveUnder "io2" mvarBuiltins
++ moveUnder "io2" stmBuiltins
++ hashBuiltins
++ fmap (uncurry B) codeBuiltins
moveUnder :: Text -> [(Text, Type v)] -> [BuiltinDSL v]
moveUnder prefix bs = bs >>= \(n,ty) -> [B n ty, Rename n (prefix <> "." <> n)]
@ -502,65 +509,77 @@ hashBuiltins =
ioBuiltins :: Var v => [(Text, Type v)]
ioBuiltins =
[ ("IO.openFile.v2", text --> fmode --> iof handle)
, ("IO.closeFile.v2", handle --> iof unit)
, ("IO.isFileEOF.v2", handle --> iof boolean)
, ("IO.isFileOpen.v2", handle --> iof boolean)
, ("IO.isSeekable.v2", handle --> iof boolean)
, ("IO.seekHandle.v2", handle --> smode --> int --> iof unit)
, ("IO.handlePosition.v2", handle --> iof int)
, ("IO.getBuffering.v2", handle --> iof bmode)
, ("IO.setBuffering.v2", handle --> bmode --> iof unit)
, ("IO.getBytes.v2", handle --> nat --> iof bytes)
, ("IO.putBytes.v2", handle --> bytes --> iof unit)
, ("IO.systemTime.v2", unit --> iof nat)
, ("IO.getTempDirectory.v2", unit --> iof text)
[ ("IO.openFile.v3", text --> fmode --> iof handle)
, ("IO.closeFile.v3", handle --> iof unit)
, ("IO.isFileEOF.v3", handle --> iof boolean)
, ("IO.isFileOpen.v3", handle --> iof boolean)
, ("IO.isSeekable.v3", handle --> iof boolean)
, ("IO.seekHandle.v3", handle --> smode --> int --> iof unit)
, ("IO.handlePosition.v3", handle --> iof nat)
, ("IO.getBuffering.v3", handle --> iof bmode)
, ("IO.setBuffering.v3", handle --> bmode --> iof unit)
, ("IO.getBytes.v3", handle --> nat --> iof bytes)
, ("IO.putBytes.v3", handle --> bytes --> iof unit)
, ("IO.systemTime.v3", unit --> iof nat)
, ("IO.getTempDirectory.v3", unit --> iof text)
, ("IO.createTempDirectory", text --> iof text)
, ("IO.getCurrentDirectory.v2", unit --> iof text)
, ("IO.setCurrentDirectory.v2", text --> iof unit)
, ("IO.fileExists.v2", text --> iof boolean)
, ("IO.isDirectory.v2", text --> iof boolean)
, ("IO.createDirectory.v2", text --> iof unit)
, ("IO.removeDirectory.v2", text --> iof unit)
, ("IO.renameDirectory.v2", text --> text --> iof unit)
, ("IO.removeFile.v2", text --> iof unit)
, ("IO.renameFile.v2", text --> text --> iof unit)
, ("IO.getFileTimestamp.v2", text --> iof nat)
, ("IO.getFileSize.v2", text --> iof nat)
, ("IO.serverSocket.v2", text --> text --> iof socket)
, ("IO.listen.v2", socket --> iof unit)
, ("IO.clientSocket.v2", text --> text --> iof socket)
, ("IO.closeSocket.v2", socket --> iof unit)
, ("IO.socketAccept.v2", socket --> iof socket)
, ("IO.socketSend.v2", socket --> bytes --> iof unit)
, ("IO.socketReceive.v2", socket --> nat --> iof bytes)
, ("IO.getCurrentDirectory.v3", unit --> iof text)
, ("IO.setCurrentDirectory.v3", text --> iof unit)
, ("IO.fileExists.v3", text --> iof boolean)
, ("IO.isDirectory.v3", text --> iof boolean)
, ("IO.createDirectory.v3", text --> iof unit)
, ("IO.removeDirectory.v3", text --> iof unit)
, ("IO.renameDirectory.v3", text --> text --> iof unit)
, ("IO.removeFile.v3", text --> iof unit)
, ("IO.renameFile.v3", text --> text --> iof unit)
, ("IO.getFileTimestamp.v3", text --> iof nat)
, ("IO.getFileSize.v3", text --> iof nat)
, ("IO.serverSocket.v3", optionalt text --> text --> iof socket)
, ("IO.listen.v3", socket --> iof unit)
, ("IO.clientSocket.v3", text --> text --> iof socket)
, ("IO.closeSocket.v3", socket --> iof unit)
, ("IO.socketPort", socket --> iof nat)
, ("IO.socketAccept.v3", socket --> iof socket)
, ("IO.socketSend.v3", socket --> bytes --> iof unit)
, ("IO.socketReceive.v3", socket --> nat --> iof bytes)
, ("IO.forkComp.v2"
, forall1 "a" $ \a -> (unit --> iof a) --> io threadId)
, forall1 "a" $ \a -> (unit --> io a) --> io threadId)
, ("IO.stdHandle", stdhandle --> handle)
, ("IO.delay.v2", nat --> iof unit)
, ("IO.kill.v2", threadId --> iof unit)
, ("IO.delay.v3", nat --> iof unit)
, ("IO.kill.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.encodeCert", tlsSignedCert --> bytes)
, ("Tls.decodePrivateKey", bytes --> list tlsPrivateKey)
, ("Tls.encodePrivateKey", tlsPrivateKey --> bytes)
, ("Tls.receive", tls --> iof bytes)
, ("Tls.terminate", tls --> iof unit)
, ("Tls.Config.defaultClient", text --> bytes --> tlsClientConfig)
, ("Tls.Config.defaultServer", tlsServerConfig)
, ("Tls.ClientConfig.default", text --> bytes --> tlsClientConfig)
, ("Tls.ServerConfig.default", list tlsSignedCert --> tlsPrivateKey --> tlsServerConfig)
, ("TLS.ClientConfig.ciphers.set", list tlsCipher --> tlsClientConfig --> tlsClientConfig)
, ("Tls.ServerConfig.ciphers.set", list tlsCipher --> tlsServerConfig --> tlsServerConfig)
, ("Tls.ClientConfig.certificates.set", list tlsSignedCert --> tlsClientConfig --> tlsClientConfig)
, ("Tls.ServerConfig.certificates.set", list tlsSignedCert --> tlsServerConfig --> tlsServerConfig)
, ("Tls.ClientConfig.versions.set", list tlsVersion --> tlsClientConfig --> tlsClientConfig)
, ("Tls.ServerConfig.versions.set", list tlsVersion --> tlsServerConfig --> tlsServerConfig)
]
mvarBuiltins :: forall v. Var v => [(Text, Type v)]
mvarBuiltins =
[ ("MVar.new", forall1 "a" $ \a -> a --> io (mvar a))
, ("MVar.newEmpty.v2", forall1 "a" $ \a -> unit --> io (mvar a))
, ("MVar.take.v2", forall1 "a" $ \a -> mvar a --> iof a)
, ("MVar.take.v3", forall1 "a" $ \a -> mvar a --> iof a)
, ("MVar.tryTake", forall1 "a" $ \a -> mvar a --> io (optionalt a))
, ("MVar.put.v2", forall1 "a" $ \a -> mvar a --> a --> iof unit)
, ("MVar.put.v3", forall1 "a" $ \a -> mvar a --> a --> iof unit)
, ("MVar.tryPut", forall1 "a" $ \a -> mvar a --> a --> io boolean)
, ("MVar.swap.v2", forall1 "a" $ \a -> mvar a --> a --> iof a)
, ("MVar.swap.v3", forall1 "a" $ \a -> mvar a --> a --> iof a)
, ("MVar.isEmpty", forall1 "a" $ \a -> mvar a --> io boolean)
, ("MVar.read.v2", forall1 "a" $ \a -> mvar a --> iof a)
, ("MVar.read.v3", forall1 "a" $ \a -> mvar a --> iof a)
, ("MVar.tryRead", forall1 "a" $ \a -> mvar a --> io (optionalt a))
]
where
@ -583,6 +602,18 @@ codeBuiltins =
, forall1 "a" $ \a -> value --> io (eithert (list termLink) a))
]
stmBuiltins :: forall v. Var v => [(Text, Type v)]
stmBuiltins =
[ ("TVar.new", forall1 "a" $ \a -> a --> stm (tvar a))
, ("TVar.newIO", forall1 "a" $ \a -> a --> io (tvar a))
, ("TVar.read", forall1 "a" $ \a -> tvar a --> stm a)
, ("TVar.readIO", forall1 "a" $ \a -> tvar a --> io a)
, ("TVar.write", forall1 "a" $ \a -> tvar a --> a --> stm unit)
, ("TVar.swap", forall1 "a" $ \a -> tvar a --> a --> stm a)
, ("STM.retry", forall1 "a" $ \a -> unit --> stm a)
, ("STM.atomically", forall1 "a" $ \a -> (unit --> stm a) --> io a)
]
forall1 :: Var v => Text -> (Type v -> Type v) -> Type v
forall1 name body =
let
@ -625,12 +656,14 @@ threadId = Type.threadId ()
handle = Type.fileHandle ()
unit = DD.unitType ()
tls, tlsClientConfig, tlsServerConfig :: Var v => Type v
tls, tlsClientConfig, tlsServerConfig, tlsSignedCert, tlsPrivateKey, tlsVersion, tlsCipher :: Var v => Type v
tls = Type.ref () Type.tlsRef
tlsClientConfig = Type.ref () Type.tlsClientConfigRef
tlsServerConfig = Type.ref () Type.tlsServerConfigRef
-- tlsVersion = Type.ref () Type.tlsVersionRef
-- tlsCiphers = Type.ref () Type.tlsCiphersRef
tlsSignedCert = Type.ref () Type.tlsSignedCertRef
tlsPrivateKey = Type.ref () Type.tlsPrivateKeyRef
tlsVersion = Type.ref () Type.tlsVersionRef
tlsCipher = Type.ref () Type.tlsCipherRef
fmode, bmode, smode, stdhandle :: Var v => Type v
fmode = DD.fileModeType ()
@ -653,3 +686,6 @@ code = Type.code ()
value = Type.value ()
termLink = Type.termLink ()
stm, tvar :: Var v => Type v -> Type v
stm = Type.effect1 () (Type.ref () Type.stmRef)
tvar a = Type.ref () Type.tvarRef `app` a

413
parser-typechecker/src/Unison/Builtin/Decls.hs
View File

@ -43,15 +43,18 @@ pairRef = lookupDeclRef "Tuple"
optionalRef = lookupDeclRef "Optional"
eitherRef = lookupDeclRef "Either"
testResultRef, linkRef, docRef, isPropagatedRef, isTestRef, ioErrorRef, stdHandleRef, failureRef :: Reference
testResultRef, linkRef, docRef, ioErrorRef, stdHandleRef, failureRef, tlsSignedCertRef, tlsPrivateKeyRef :: Reference
isPropagatedRef, isTestRef :: Reference
isPropagatedRef = lookupDeclRef "IsPropagated"
isTestRef = lookupDeclRef "IsTest"
testResultRef = lookupDeclRef "Test.Result"
linkRef = lookupDeclRef "Link"
docRef = lookupDeclRef "Doc"
isPropagatedRef = lookupDeclRef "IsPropagated"
isTestRef = lookupDeclRef "IsTest"
ioErrorRef = lookupDeclRef "io2.IOError"
stdHandleRef = lookupDeclRef "io2.StdHandle"
failureRef = lookupDeclRef "io2.Failure"
tlsSignedCertRef = lookupDeclRef "io2.Tls.SignedCert"
tlsPrivateKeyRef = lookupDeclRef "io2.Tls.PrivateKey"
fileModeRef, filePathRef, bufferModeRef, seekModeRef, seqViewRef :: Reference
fileModeRef = lookupDeclRef "io2.FileMode"
@ -69,7 +72,8 @@ constructorId ref name = do
(_,_,dd) <- find (\(_,r,_) -> Reference.DerivedId r == ref) (builtinDataDecls @Symbol)
elemIndex name $ DD.constructorNames dd
isPropagatedConstructorId, isTestConstructorId, okConstructorId, failConstructorId, docBlobId, docLinkId, docSignatureId, docSourceId, docEvaluateId, docJoinId, linkTermId, linkTypeId :: ConstructorId
okConstructorId, failConstructorId, docBlobId, docLinkId, docSignatureId, docSourceId, docEvaluateId, docJoinId, linkTermId, linkTypeId :: ConstructorId
isPropagatedConstructorId, isTestConstructorId :: ConstructorId
Just isPropagatedConstructorId = constructorId isPropagatedRef "IsPropagated.IsPropagated"
Just isTestConstructorId = constructorId isTestRef "IsTest.IsTest"
Just okConstructorId = constructorId testResultRef "Test.Result.Ok"
@ -91,221 +95,193 @@ failConstructorReferent = Referent.Con testResultRef failConstructorId CT.Data
-- | builtinTypes' and those types defined herein
builtinDataDecls :: Var v => [(v, Reference.Id, DataDeclaration v ())]
builtinDataDecls = rs1 ++ rs
where
rs1 = case hashDecls $
Map.fromList
[ (v "Link", link)
] of
Right a -> a
Left e -> error $ "builtinDataDecls: " <> show e
rs = case hashDecls $
Map.fromList
[ (v "Unit", unit),
(v "Tuple", tuple),
(v "Optional", opt),
(v "Either", eith),
(v "Test.Result", tr),
(v "IsPropagated", isPropagated),
(v "IsTest", isTest),
(v "Doc", doc),
(v "io2.FileMode", fmode),
(v "io2.BufferMode", bmode),
(v "io2.SeekMode", smode),
(v "SeqView", seqview),
(v "io2.IOError", ioerr),
(v "io2.StdHandle", stdhnd),
(v "io2.Failure", failure),
(v "io2.TlsFailure", tlsFailure)
] of
Right a -> a
Left e -> error $ "builtinDataDecls: " <> show e
[(_, linkRef, _)] = rs1
v = Var.named
var name = Type.var () (v name)
arr = Type.arrow'
-- see note on `hashDecls` above for why ctor must be called `Unit.Unit`.
unit = DataDeclaration Structural () [] [((), v "Unit.Unit", var "Unit")]
tuple =
DataDeclaration
Structural
where
rs1 = case hashDecls $ Map.fromList
[ (v "Link" , link)
] of Right a -> a; Left e -> error $ "builtinDataDecls: " <> show e
rs = case hashDecls $ Map.fromList
[ (v "Unit" , unit)
, (v "Tuple" , tuple)
, (v "Optional" , opt)
, (v "Either" , eith)
, (v "Test.Result" , tr)
, (v "IsPropagated" , isPropagated)
, (v "IsTest" , isTest)
, (v "Doc" , doc)
, (v "io2.FileMode" , fmode)
, (v "io2.BufferMode" , bmode)
, (v "io2.SeekMode" , smode)
, (v "SeqView" , seqview)
, (v "io2.IOError" , ioerr)
, (v "io2.StdHandle" , stdhnd)
, (v "io2.Failure" , failure)
, (v "io2.TlsFailure" , tlsFailure)
, (v "io2.IOFailure" , ioFailure)
] of Right a -> a; Left e -> error $ "builtinDataDecls: " <> show e
[(_, linkRef, _)] = rs1
v = Var.named
var name = Type.var () (v name)
arr = Type.arrow'
-- see note on `hashDecls` above for why ctor must be called `Unit.Unit`.
unit = DataDeclaration Structural () [] [((), v "Unit.Unit", var "Unit")]
tuple = DataDeclaration
Structural
()
[v "a", v "b"]
[ ( ()
, v "Tuple.Cons"
, Type.foralls
()
[v "a", v "b"]
[ ( (),
v "Tuple.Cons",
Type.foralls
()
[v "a", v "b"]
( var "a"
`arr` (var "b" `arr` Type.apps' (var "Tuple") [var "a", var "b"])
)
)
]
opt =
DataDeclaration
Structural
()
[v "a"]
[ ( (),
v "Optional.None",
Type.foralls () [v "a"] (Type.app' (var "Optional") (var "a"))
),
( (),
v "Optional.Some",
Type.foralls
()
[v "a"]
(var "a" `arr` Type.app' (var "Optional") (var "a"))
)
]
eith =
DataDeclaration
Structural
()
[v "a", v "b"]
[ ( (),
v "Either.Left",
Type.foralls
()
[v "a", v "b"]
(var "a" `arr` Type.apps' (var "Either") [var "a", var "b"])
),
( (),
v "Either.Right",
Type.foralls
()
[v "a", v "b"]
(var "b" `arr` Type.apps' (var "Either") [var "a", var "b"])
)
]
isTest =
DataDeclaration
(Unique "e6dca08b40458b03ca1660cfbdaecaa7279b42d18257898b5fd1c34596aac36f")
()
[]
[((), v "IsTest.IsTest", var "IsTest")]
isPropagated =
DataDeclaration
(Unique "b28d929d0a73d2c18eac86341a3bb9399f8550c11b5f35eabb2751e6803ccc20")
()
[]
[((), v "IsPropagated.IsPropagated", var "IsPropagated")]
fmode =
DataDeclaration
(Unique "3c11ba4f0a5d8fedd427b476cdd2d7673197d11e")
()
[]
[ ((), v "io2.FileMode.Read", var "io2.FileMode"),
((), v "io2.FileMode.Write", var "io2.FileMode"),
((), v "io2.FileMode.Append", var "io2.FileMode"),
((), v "io2.FileMode.ReadWrite", var "io2.FileMode")
]
bmode =
DataDeclaration
(Unique "7dd9560d3826c21e5e6a7e08f575b61adcddf849")
()
[]
[ ((), v "io2.BufferMode.NoBuffering", var "io2.BufferMode"),
((), v "io2.BufferMode.LineBuffering", var "io2.BufferMode"),
((), v "io2.BufferMode.BlockBuffering", var "io2.BufferMode"),
( (),
v "io2.BufferMode.SizedBlockBuffering",
Type.nat () `arr` var "io2.BufferMode"
)
]
smode =
DataDeclaration
(Unique "453a764f73cb4c7371d9af23b2d5ed646bf9e57c")
()
[]
[ ((), v "io2.SeekMode.AbsoluteSeek", var "io2.SeekMode"),
((), v "io2.SeekMode.RelativeSeek", var "io2.SeekMode"),
((), v "io2.SeekMode.SeekFromEnd", var "io2.SeekMode")
]
ioerr =
DataDeclaration
(Unique "5915e25ac83205f7885395cc6c6c988bc5ec69a1")
()
[]
[ ((), v "io2.IOError.AlreadyExists", var "io2.IOError"),
((), v "io2.IOError.NoSuchThing", var "io2.IOError"),
((), v "io2.IOError.ResourceBusy", var "io2.IOError"),
((), v "io2.IOError.ResourceExhausted", var "io2.IOError"),
((), v "io2.IOError.EOF", var "io2.IOError"),
((), v "io2.IOError.IllegalOperation", var "io2.IOError"),
((), v "io2.IOError.PermissionDenied", var "io2.IOError"),
((), v "io2.IOError.UserError", var "io2.IOError")
]
failure =
DataDeclaration
(Unique "52ad89274a358b9c802792aa05915e25ac83205f7885395cc6c6c988bc5ec69a1")
()
[]
[ ((), v "io2.Failure.Failure", (Type.typeLink () `arr` (Type.text () `arr` var "io2.Failure")))
]
tlsFailure =
DataDeclaration
(Unique "df5ba835130b227ab83d02d1feff5402455a732d613b51dee32230d2f2d067c6")
()
[]
[]
stdhnd =
DataDeclaration
(Unique "67bf7a8e517cbb1e9f42bc078e35498212d3be3c")
()
[]
[ ((), v "io2.StdHandle.StdIn", var "io2.StdHandle"),
((), v "io2.StdHandle.StdOut", var "io2.StdHandle"),
((), v "io2.StdHandle.StdErr", var "io2.StdHandle")
]
seqview =
DataDeclaration
Structural
()
[v "a", v "b"]
[ ( (),
v "SeqView.VEmpty",
Type.foralls
()
[v "a", v "b"]
(Type.apps' (var "SeqView") [var "a", var "b"])
),
( (),
v "SeqView.VElem",
let sv = Type.apps' (var "SeqView") [var "a", var "b"]
in Type.foralls
()
[v "a", v "b"]
(var "a" `arr` (var "b" `arr` sv))
)
]
tr =
DataDeclaration
(Unique "70621e539cd802b2ad53105697800930411a3ebc")
()
[]
[ ((), v "Test.Result.Fail", Type.text () `arr` var "Test.Result"),
((), v "Test.Result.Ok", Type.text () `arr` var "Test.Result")
]
doc =
DataDeclaration
(Unique "c63a75b845e4f7d01107d852e4c2485c51a50aaaa94fc61995e71bbee983a2ac3713831264adb47fb6bd1e058d5f004")
()
[]
[ ((), v "Doc.Blob", Type.text () `arr` var "Doc"),
((), v "Doc.Link", Type.refId () linkRef `arr` var "Doc"),
((), v "Doc.Signature", Type.termLink () `arr` var "Doc"),
((), v "Doc.Source", Type.refId () linkRef `arr` var "Doc"),
((), v "Doc.Evaluate", Type.termLink () `arr` var "Doc"),
((), v "Doc.Join", Type.app () (Type.vector ()) (var "Doc") `arr` var "Doc")
]
link =
DataDeclaration
(Unique "a5803524366ead2d7f3780871d48771e8142a3b48802f34a96120e230939c46bd5e182fcbe1fa64e9bff9bf741f3c04")
()
[]
[ ((), v "Link.Term", Type.termLink () `arr` var "Link"),
((), v "Link.Type", Type.typeLink () `arr` var "Link")
]
( var "a"
`arr` (var "b" `arr` Type.apps' (var "Tuple") [var "a", var "b"])
)
)
]
opt = DataDeclaration
Structural
()
[v "a"]
[ ( ()
, v "Optional.None"
, Type.foralls () [v "a"] (Type.app' (var "Optional") (var "a"))
)
, ( ()
, v "Optional.Some"
, Type.foralls ()
[v "a"]
(var "a" `arr` Type.app' (var "Optional") (var "a"))
)
]
eith = DataDeclaration
Structural
()
[v "a", v "b"]
[ ( ()
, v "Either.Left"
, Type.foralls () [v "a", v "b"]
(var "a" `arr` Type.apps' (var "Either") [var "a", var "b"])
)
, ( ()
, v "Either.Right"
, Type.foralls () [v "a", v "b"]
(var "b" `arr` Type.apps' (var "Either") [var "a", var "b"])
)
]
isTest =
DataDeclaration
(Unique "e6dca08b40458b03ca1660cfbdaecaa7279b42d18257898b5fd1c34596aac36f")
()
[]
[((), v "IsTest.IsTest", var "IsTest")]
isPropagated =
DataDeclaration
(Unique "b28d929d0a73d2c18eac86341a3bb9399f8550c11b5f35eabb2751e6803ccc20")
()
[]
[((), v "IsPropagated.IsPropagated", var "IsPropagated")]
fmode = DataDeclaration
(Unique "3c11ba4f0a5d8fedd427b476cdd2d7673197d11e")
()
[]
[ ((), v "io2.FileMode.Read", var "io2.FileMode")
, ((), v "io2.FileMode.Write", var "io2.FileMode")
, ((), v "io2.FileMode.Append", var "io2.FileMode")
, ((), v "io2.FileMode.ReadWrite", var "io2.FileMode")
]
bmode = DataDeclaration
(Unique "7dd9560d3826c21e5e6a7e08f575b61adcddf849")
()
[]
[ ((), v "io2.BufferMode.NoBuffering", var "io2.BufferMode")
, ((), v "io2.BufferMode.LineBuffering", var "io2.BufferMode")
, ((), v "io2.BufferMode.BlockBuffering", var "io2.BufferMode")
, ((), v "io2.BufferMode.SizedBlockBuffering"
, Type.nat () `arr` var "io2.BufferMode")
]
smode = DataDeclaration
(Unique "453a764f73cb4c7371d9af23b2d5ed646bf9e57c")
()
[]
[ ((), v "io2.SeekMode.AbsoluteSeek", var "io2.SeekMode")
, ((), v "io2.SeekMode.RelativeSeek", var "io2.SeekMode")
, ((), v "io2.SeekMode.SeekFromEnd", var "io2.SeekMode")
]
ioerr = DataDeclaration
(Unique "5915e25ac83205f7885395cc6c6c988bc5ec69a1")
()
[]
[ ((), v "io2.IOError.AlreadyExists", var "io2.IOError")
, ((), v "io2.IOError.NoSuchThing", var "io2.IOError")
, ((), v "io2.IOError.ResourceBusy", var "io2.IOError")
, ((), v "io2.IOError.ResourceExhausted", var "io2.IOError")
, ((), v "io2.IOError.EOF", var "io2.IOError")
, ((), v "io2.IOError.IllegalOperation", var "io2.IOError")
, ((), v "io2.IOError.PermissionDenied", var "io2.IOError")
, ((), v "io2.IOError.UserError", var "io2.IOError")
]
failure = DataDeclaration
(Unique "52ad89274a358b9c802792aa05915e25ac83205f7885395cc6c6c988bc5ec69a1")
()
[]
[ ((), v "io2.Failure.Failure", Type.typeLink () `arr` (Type.text () `arr` (Type.any () `arr` var "io2.Failure")))
]
tlsFailure = DataDeclaration (Unique "df5ba835130b227ab83d02d1feff5402455a732d613b51dee32230d2f2d067c6")()[]
[]
ioFailure = DataDeclaration (Unique "009cb00e78cac9e47485cc3633c7a363939f63866ea07ab330346a2121d69a83")()[]
[]
stdhnd = DataDeclaration
(Unique "67bf7a8e517cbb1e9f42bc078e35498212d3be3c")
()
[]
[ ((), v "io2.StdHandle.StdIn", var "io2.StdHandle")
, ((), v "io2.StdHandle.StdOut", var "io2.StdHandle")
, ((), v "io2.StdHandle.StdErr", var "io2.StdHandle")
]
seqview = DataDeclaration
Structural
()
[v "a", v "b"]
[ ( ()
, v "SeqView.VEmpty"
, Type.foralls () [v "a", v "b"]
(Type.apps' (var "SeqView") [var "a", var "b"])
)
, ( ()
, v "SeqView.VElem"
, let sv = Type.apps' (var "SeqView") [var "a", var "b"]
in Type.foralls () [v "a", v "b"]
(var "a" `arr` (var "b" `arr` sv))
)
]
tr = DataDeclaration
(Unique "70621e539cd802b2ad53105697800930411a3ebc")
()
[]
[ ((), v "Test.Result.Fail", Type.text () `arr` var "Test.Result")
, ((), v "Test.Result.Ok" , Type.text () `arr` var "Test.Result")
]
doc = DataDeclaration
(Unique "c63a75b845e4f7d01107d852e4c2485c51a50aaaa94fc61995e71bbee983a2ac3713831264adb47fb6bd1e058d5f004")
()
[]
[ ((), v "Doc.Blob", Type.text () `arr` var "Doc")
, ((), v "Doc.Link", Type.refId () linkRef `arr` var "Doc")
, ((), v "Doc.Signature", Type.termLink () `arr` var "Doc")
, ((), v "Doc.Source", Type.refId () linkRef `arr` var "Doc")
, ((), v "Doc.Evaluate", Type.termLink () `arr` var "Doc")
, ((), v "Doc.Join", Type.app () (Type.vector()) (var "Doc") `arr` var "Doc")
]
link = DataDeclaration
(Unique "a5803524366ead2d7f3780871d48771e8142a3b48802f34a96120e230939c46bd5e182fcbe1fa64e9bff9bf741f3c04")
()
[]
[ ((), v "Link.Term", Type.termLink () `arr` var "Link")
, ((), v "Link.Type", Type.typeLink () `arr` var "Link")
]
builtinEffectDecls :: [(v, Reference.Id, DD.EffectDeclaration v ())]
builtinEffectDecls = []
@ -355,6 +331,9 @@ seekModeType a = Type.ref a seekModeRef
stdHandleType a = Type.ref a stdHandleRef
failureType a = Type.ref a failureRef
tlsSignedCertType :: Var v => a -> Type v a
tlsSignedCertType a = Type.ref a tlsSignedCertRef
unitTerm :: Var v => a -> Term v a
unitTerm ann = Term.constructor ann unitRef 0

4
parser-typechecker/src/Unison/Builtin/Terms.hs
View File

@ -31,4 +31,6 @@ v :: Var v => Text -> v
v = Var.named
builtinTermsRef :: Var v => a -> Map v Reference.Id
builtinTermsRef a = fmap fst . Term.hashComponents . Map.fromList . fmap (\(v, tm, _tp) -> (v, tm)) $ builtinTermsSrc a
builtinTermsRef a = fmap fst . Term.hashComponents . Map.fromList
. fmap (\(v, tm, _tp) -> (v, tm))
$ builtinTermsSrc a

12
parser-typechecker/src/Unison/Codebase.hs
View File

@ -42,7 +42,7 @@ type DataDeclaration v a = DD.DataDeclaration v a
type EffectDeclaration v a = DD.EffectDeclaration v a
-- | this FileCodebase detail lives here, because the interface depends on it 🙃
type CodebasePath = FilePath
type CodebasePath = FilePath
data Codebase m v a =
Codebase { getTerm :: Reference.Id -> m (Maybe (Term v a))
@ -97,16 +97,16 @@ data GetRootBranchError
debug :: Bool
debug = False
data SyncFileCodebaseResult = SyncOk | UnknownDestinationRootBranch Branch.Hash | NotFastForward
-- | Write all of the builtins types into the codebase and create empty namespace
initializeCodebase :: forall m. Monad m => Codebase m Symbol Parser.Ann -> m ()
initializeCodebase c = do
let uf = UF.typecheckedUnisonFile (Map.fromList Builtin.builtinDataDecls)
(Map.fromList Builtin.builtinEffectDecls)
[Builtin.builtinTermsSrc Parser.Intrinsic]
mempty
let uf = (UF.typecheckedUnisonFile (Map.fromList Builtin.builtinDataDecls)
(Map.fromList Builtin.builtinEffectDecls)
[Builtin.builtinTermsSrc Parser.Intrinsic]
mempty)
addDefsToCodebase c uf
putRootBranch c (Branch.one Branch.empty0)

20
parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -118,7 +118,7 @@ import Unison.LabeledDependency (LabeledDependency)
import Unison.Term (Term)
import Unison.Type (Type)
import qualified Unison.Builtin as Builtin
import qualified Unison.Builtin.Terms as Builtin
import qualified Unison.Builtin.Terms as Builtin
import Unison.NameSegment (NameSegment(..))
import qualified Unison.NameSegment as NameSegment
import Unison.Codebase.ShortBranchHash (ShortBranchHash)
@ -371,11 +371,9 @@ loop = do
(misses', hits) <- hqNameQuery [from]
let tpRefs = Set.fromList $ typeReferences hits
tmRefs = Set.fromList $ termReferences hits
tmMisses = misses'
<> (HQ'.toHQ . SR.termName <$> termResults hits)
tpMisses = misses'
<> (HQ'.toHQ . SR.typeName <$> typeResults hits)
misses = if isTerm then tpMisses else tmMisses
misses = Set.difference (Set.fromList misses') if isTerm
then Set.fromList $ HQ'.toHQ . SR.termName <$> termResults hits
else Set.fromList $ HQ'.toHQ . SR.typeName <$> typeResults hits
go :: Reference -> Action m (Either Event Input) v ()
go fr = do
let termPatch =
@ -391,8 +389,8 @@ loop = do
(const (if isTerm then termPatch else typePatch)))
-- Say something
success
unless (null misses) $
respond $ SearchTermsNotFound misses
unless (Set.null misses) $
respond $ SearchTermsNotFound (Set.toList misses)
traverse_ go (if isTerm then tmRefs else tpRefs)
branchExists dest _x = respond $ BranchAlreadyExists dest
branchExistsSplit = branchExists . Path.unsplit'
@ -1629,8 +1627,8 @@ loop = do
e <- eval $ Execute ppe unisonFile
case e of
Left e -> respond $ EvaluationFailure e
Right _ -> pure () -- TODO
Left e -> respond $ EvaluationFailure e
Right _ -> pure () -- TODO
IOTestI main -> do
testType <- eval RuntimeTest
@ -1662,7 +1660,7 @@ loop = do
tm' <- eval $ Evaluate1 ppe tm
case tm' of
Left e -> respond (EvaluationFailure e)
Right tm' ->
Right tm' ->
respond $ TestResults Output.NewlyComputed ppe True True (oks [(ref, tm')]) (fails [(ref, tm')])
_ -> respond $ NoMainFunction "main" ppe [testType]
_ -> respond $ NoMainFunction "main" ppe [testType]

2
parser-typechecker/src/Unison/Runtime/ANF.hs
View File

@ -839,6 +839,8 @@ data POp
| VALU -- value
-- Debug
| PRNT | INFO
-- STM
| ATOM
deriving (Show,Eq,Ord)
type ANormal = ABTN.Term ANormalF

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

@ -29,7 +29,8 @@ import Unison.Symbol
import qualified Unison.Runtime.Stack as Closure
import Unison.Runtime.Stack (Closure)
import Unison.Runtime.Foreign
( Foreign(Wrap), HashAlgorithm(..), Failure(..))
( Foreign(Wrap), HashAlgorithm(..), pattern Failure)
import qualified Unison.Runtime.Foreign as F
import Unison.Runtime.Foreign.Function
import Unison.Runtime.IOSource
@ -48,7 +49,10 @@ import Data.Text.Encoding ( decodeUtf8', decodeUtf8' )
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Lazy as L
import qualified System.X509 as X
import qualified Data.X509 as X
import qualified Data.X509.Memory as X
import qualified Data.X509.CertificateStore as X
import Data.PEM (pemContent, pemParseLBS, PEM)
import Data.Set (insert)
import qualified Data.Map as Map
@ -56,6 +60,7 @@ import Unison.Prelude
import qualified Unison.Util.Bytes as Bytes
import Network.Socket as SYS
( accept
, socketPort
, Socket
)
import Network.Simple.TCP as SYS
@ -71,7 +76,8 @@ import Network.TLS as TLS
import Network.TLS.Extra.Cipher as Cipher
import System.IO as SYS
( openFile
( IOMode(..)
, openFile
, hClose
, hGetBuffering
, hSetBuffering
@ -108,6 +114,13 @@ import System.Directory as SYS
)
import System.IO.Temp (createTempDirectory)
import qualified Control.Concurrent.STM as STM
import qualified GHC.Conc as STM
import GHC.IO (IO(IO))
type Failure = F.Failure Closure
freshes :: Var v => Int -> [v]
freshes = freshes' mempty
@ -686,6 +699,16 @@ value'load
value'create :: Var v => SuperNormal v
value'create = unop0 0 $ \[x] -> TPrm VALU [x]
stm'atomic :: Var v => SuperNormal v
stm'atomic
= Lambda [BX]
. TAbs act
. TLetD unit BX (TCon Ty.unitRef 0 [])
. TName lz (Right act) [unit]
$ TPrm ATOM [lz]
where
(act,unit,lz) = fresh3
type ForeignOp = forall v. Var v => FOp -> ([Mem], ANormal v)
standard'handle :: ForeignOp
@ -789,6 +812,19 @@ inNat arg nat result cont instr =
. unbox arg Ty.natRef nat
$ TLetD result UN (TFOp instr [nat]) cont
-- Maybe a -> b -> ...
inMaybeBx :: forall v. Var v => v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inMaybeBx arg1 arg2 arg3 mb result cont instr =
([BX, BX],)
. TAbss [arg1, arg2]
. TMatch arg1 . flip (MatchData Ty.optionalRef) Nothing
$ mapFromList
[ (0, ([], TLetD mb UN (TLit $ I 0)
$ TLetD result UN (TFOp instr [mb, arg2]) cont))
, (1, ([BX], TAbs arg3 . TLetD mb UN (TLit $ I 1) $ TLetD result UN (TFOp instr [mb, arg3, arg2]) cont))
]
-- a -> b -> ...
inBxBx :: forall v. Var v => v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxBx arg1 arg2 result cont instr =
@ -823,9 +859,6 @@ inBxIomr arg1 arg2 fm result cont instr
-- All of these functions will take a Var named result containing the
-- result of the foreign call
--
outInt :: forall v. Var v => v -> ANormal v
outInt i = TCon Ty.intRef 0 [i]
outMaybe :: forall v. Var v => v -> v -> ANormal v
outMaybe maybe result =
TMatch result . MatchSum $ mapFromList
@ -852,7 +885,7 @@ outIoFailNat stack1 stack2 stack3 fail nat result =
$ TCon eitherReference 0 [fail])
, (1, ([UN],)
. TAbs stack3
. TLetD nat UN (TCon Ty.natRef 0 [stack3])
. TLetD nat BX (TCon Ty.natRef 0 [stack3])
$ TCon eitherReference 1 [nat])
]
@ -932,14 +965,6 @@ unitToEFBox = inUnit unit result
$ outIoFailBox stack1 stack2 fail result
where (unit, stack1, stack2, fail, result) = fresh5
-- a -> Int
boxToInt :: ForeignOp
boxToInt = inBx arg result
$ outInt result
where
(arg, result) = fresh2
-- a -> IOMode -> Either Failure b
boxIomrToEFBox :: ForeignOp
boxIomrToEFBox = inBxIomr arg1 arg2 enum result
$ outIoFailBox stack1 stack2 fail result
@ -952,6 +977,16 @@ boxTo0 = inBx arg result (TCon Ty.unitRef 0 [])
where
(arg, result) = fresh2
-- a -> b ->{E} ()
boxBoxTo0 :: ForeignOp
boxBoxTo0 instr
= ([BX,BX],)
. TAbss [arg1,arg2]
. TLets Direct [] [] (TFOp instr [arg1,arg2])
$ TCon Ty.unitRef 0 []
where
(arg1, arg2) = fresh2
-- Nat -> ()
natToUnit :: ForeignOp
natToUnit = inNat arg nat result (TCon Ty.unitRef 0 [])
@ -1033,6 +1068,14 @@ boxToEFNat = inBx arg result
where
(arg, result, stack1, stack2, stack3, nat, fail) = fresh7
-- Maybe a -> b -> Either Failure c
maybeBoxToEFBox :: ForeignOp
maybeBoxToEFBox = inMaybeBx arg1 arg2 arg3 mb result
$ outIoFail stack1 stack2 fail result
where
(arg1, arg2, arg3, mb, result, stack1, stack2, fail) = fresh8
-- a -> b -> Either Failure c
boxBoxToEFBox :: ForeignOp
boxBoxToEFBox = inBxBx arg1 arg2 result
@ -1228,13 +1271,15 @@ builtinLookup
, ("jumpCont", jumpk)
, ("IO.forkComp", fork'comp)
, ("IO.forkComp.v2", fork'comp)
, ("Code.isMissing", code'missing)
, ("Code.cache_", code'cache)
, ("Code.lookup", code'lookup)
, ("Value.load", value'load)
, ("Value.value", value'create)
, ("STM.atomically", stm'atomic)
] ++ foreignWrappers
type FDecl v
@ -1254,9 +1299,12 @@ mkForeignIOF f = mkForeign $ \a -> tryIOE (f a)
tryIOE :: IO a -> IO (Either Failure a)
tryIOE = fmap handleIOE . try
handleIOE :: Either IOException a -> Either Failure a
handleIOE (Left e) = Left $ Failure ioFailureReference (pack (show e))
handleIOE (Left e) = Left $ Failure ioFailureReference (pack (show e)) unitValue
handleIOE (Right a) = Right a
unitValue :: Closure
unitValue = Closure.Enum Ty.unitRef 0
mkForeignTls
:: forall a r.(ForeignConvention a, ForeignConvention r)
=> (a -> IO r) -> ForeignFunc
@ -1266,40 +1314,48 @@ mkForeignTls f = mkForeign $ \a -> fmap flatten (tryIO2 (tryIO1 (f a)))
tryIO1 = try
tryIO2 :: IO (Either TLS.TLSException r) -> IO (Either IOException (Either TLS.TLSException r))
tryIO2 = try
flatten :: Either IOException (Either TLS.TLSException r) -> Either Failure r
flatten (Left e) = Left (Failure ioFailureReference (pack (show e)))
flatten (Right (Left e)) = Left (Failure tlsFailureReference (pack (show e)))
flatten :: Either IOException (Either TLS.TLSException r) -> Either (Failure ) r
flatten (Left e) = Left (Failure ioFailureReference (pack (show e)) unitValue)
flatten (Right (Left e)) = Left (Failure tlsFailureReference (pack (show e)) (unitValue))
flatten (Right (Right a)) = Right a
declareForeigns :: Var v => FDecl v ()
declareForeigns = do
declareForeign "IO.openFile.v3" boxIomrToEFBox $
mkForeignIOF $ \(fnameText :: Text, n :: Int) ->
let fname = (unpack fnameText)
mode = case n of
0 -> ReadMode
1 -> WriteMode
2 -> AppendMode
_ -> ReadWriteMode
in openFile fname mode
declareForeign "IO.openFile.v2" boxIomrToEFBox $ mkForeignIOF (uncurry openFile)
declareForeign "IO.closeFile.v2" boxToEF0 $ mkForeignIOF hClose
declareForeign "IO.isFileEOF.v2" boxToEFBool $ mkForeignIOF hIsEOF
declareForeign "IO.isFileOpen.v2" boxToEFBool $ mkForeignIOF hIsOpen
declareForeign "IO.isSeekable.v2" boxToEFBool $ mkForeignIOF hIsSeekable
declareForeign "IO.closeFile.v3" boxToEF0 $ mkForeignIOF hClose
declareForeign "IO.isFileEOF.v3" boxToEFBool $ mkForeignIOF hIsEOF
declareForeign "IO.isFileOpen.v3" boxToEFBool $ mkForeignIOF hIsOpen
declareForeign "IO.isSeekable.v3" boxToEFBool $ mkForeignIOF hIsSeekable
declareForeign "IO.seekHandle.v2" seek'handle
declareForeign "IO.seekHandle.v3" seek'handle
. mkForeignIOF $ \(h,sm,n) -> hSeek h sm (fromIntegral (n :: Int))
declareForeign "IO.handlePosition.v2" boxToInt
declareForeign "IO.handlePosition.v3" boxToEFNat
-- TODO: truncating integer
. mkForeignIOF $ \h -> fromInteger @Word64 <$> hTell h
declareForeign "IO.getBuffering.v2" get'buffering
declareForeign "IO.getBuffering.v3" get'buffering
$ mkForeignIOF hGetBuffering
declareForeign "IO.setBuffering.v2" boxBoxToEF0
declareForeign "IO.setBuffering.v3" boxBoxToEF0
. mkForeignIOF $ uncurry hSetBuffering
declareForeign "IO.getBytes.v2" boxNatToEFBox . mkForeignIOF $ \(h,n) -> Bytes.fromArray <$> hGet h n
declareForeign "IO.getBytes.v3" boxNatToEFBox . mkForeignIOF $ \(h,n) -> Bytes.fromArray <$> hGet h n
declareForeign "IO.putBytes.v2" boxBoxToEFBox . mkForeignIOF $ \(h,bs) -> hPut h (Bytes.toArray bs)
declareForeign "IO.systemTime.v2" unitToEFNat
declareForeign "IO.putBytes.v3" boxBoxToEFBox . mkForeignIOF $ \(h,bs) -> hPut h (Bytes.toArray bs)
declareForeign "IO.systemTime.v3" unitToEFNat
$ mkForeignIOF $ \() -> getPOSIXTime
declareForeign "IO.getTempDirectory.v2" unitToEFBox
declareForeign "IO.getTempDirectory.v3" unitToEFBox
$ mkForeignIOF $ \() -> getTemporaryDirectory
declareForeign "IO.createTempDirectory" boxToEFBox
@ -1307,66 +1363,72 @@ declareForeigns = do
temp <- getTemporaryDirectory
createTempDirectory temp prefix
declareForeign "IO.getCurrentDirectory.v2" direct
declareForeign "IO.getCurrentDirectory.v3" direct
. mkForeignIOF $ \() -> getCurrentDirectory
declareForeign "IO.setCurrentDirectory.v2" boxToEF0
declareForeign "IO.setCurrentDirectory.v3" boxToEF0
$ mkForeignIOF setCurrentDirectory
declareForeign "IO.fileExists.v2" boxToEFBool
declareForeign "IO.fileExists.v3" boxToEFBool
$ mkForeignIOF doesPathExist
declareForeign "IO.isDirectory.v2" boxToEFBool
declareForeign "IO.isDirectory.v3" boxToEFBool
$ mkForeignIOF doesDirectoryExist
declareForeign "IO.createDirectory.v2" boxToEF0
declareForeign "IO.createDirectory.v3" boxToEF0
$ mkForeignIOF $ createDirectoryIfMissing True
declareForeign "IO.removeDirectory.v2" boxToEF0
declareForeign "IO.removeDirectory.v3" boxToEF0
$ mkForeignIOF removeDirectoryRecursive
declareForeign "IO.renameDirectory.v2" boxBoxToEF0
declareForeign "IO.renameDirectory.v3" boxBoxToEF0
$ mkForeignIOF $ uncurry renameDirectory
declareForeign "IO.removeFile.v2" boxToEF0
declareForeign "IO.removeFile.v3" boxToEF0
$ mkForeignIOF removeFile
declareForeign "IO.renameFile.v2" boxBoxToEF0
declareForeign "IO.renameFile.v3" boxBoxToEF0
$ mkForeignIOF $ uncurry renameFile
declareForeign "IO.getFileTimestamp.v2" boxToEFNat
declareForeign "IO.getFileTimestamp.v3" boxToEFNat
. mkForeignIOF $ fmap utcTimeToPOSIXSeconds . getModificationTime
declareForeign "IO.getFileSize.v2" boxToEFNat
declareForeign "IO.getFileSize.v3" boxToEFNat
-- TODO: truncating integer
. mkForeignIOF $ \fp -> fromInteger @Word64 <$> getFileSize fp
declareForeign "IO.serverSocket.v2" boxBoxToEFBox
. mkForeignIOF $ \(mhst,port) ->
declareForeign "IO.serverSocket.v3" maybeBoxToEFBox
. mkForeignIOF $ \(mhst :: Maybe Text
, port) ->
fst <$> SYS.bindSock (hostPreference mhst) port
declareForeign "IO.listen.v2" boxToEF0
. mkForeignIOF $ \sk -> SYS.listenSock sk 2048
declareForeign "IO.socketPort" boxToEFNat
. mkForeignIOF $ \(handle :: Socket) -> do
n <- SYS.socketPort handle
return (fromIntegral n :: Word64)
declareForeign "IO.clientSocket.v2" boxBoxDirect
declareForeign "IO.listen.v3" boxToEF0
. mkForeignIOF $ \sk -> SYS.listenSock sk 2
declareForeign "IO.clientSocket.v3" boxBoxToEFBox
. mkForeignIOF $ fmap fst . uncurry SYS.connectSock
declareForeign "IO.closeSocket.v2" boxToEF0
declareForeign "IO.closeSocket.v3" boxToEF0
$ mkForeignIOF SYS.closeSock
declareForeign "IO.socketAccept.v2" boxDirect
declareForeign "IO.socketAccept.v3" boxToEFBox
. mkForeignIOF $ fmap fst . SYS.accept
declareForeign "IO.socketSend.v2" boxBoxToEF0
declareForeign "IO.socketSend.v3" boxBoxToEF0
. mkForeignIOF $ \(sk,bs) -> SYS.send sk (Bytes.toArray bs)
declareForeign "IO.socketReceive.v2" boxNatToEFBox
declareForeign "IO.socketReceive.v3" boxNatToEFBox
. mkForeignIOF $ \(hs,n) ->
maybe Bytes.empty Bytes.fromArray <$> SYS.recv hs n
declareForeign "IO.kill.v2" boxTo0 $ mkForeignIOF killThread
declareForeign "IO.kill.v3" boxTo0 $ mkForeignIOF killThread
declareForeign "IO.delay.v2" natToUnit $ mkForeignIOF threadDelay
declareForeign "IO.delay.v3" natToUnit $ mkForeignIOF threadDelay
declareForeign "IO.stdHandle" standard'handle
. mkForeign $ \(n :: Int) -> case n of
@ -1381,25 +1443,25 @@ declareForeigns = do
declareForeign "MVar.newEmpty.v2" unitDirect
. mkForeign $ \() -> newEmptyMVar @Closure
declareForeign "MVar.take.v2" boxToEFBox
declareForeign "MVar.take.v3" boxToEFBox
. mkForeignIOF $ \(mv :: MVar Closure) -> takeMVar mv
declareForeign "MVar.tryTake" boxToMaybeBox
. mkForeign $ \(mv :: MVar Closure) -> tryTakeMVar mv
declareForeign "MVar.put.v2" boxBoxToEF0
declareForeign "MVar.put.v3" boxBoxToEF0
. mkForeignIOF $ \(mv :: MVar Closure, x) -> putMVar mv x
declareForeign "MVar.tryPut" boxBoxToEFBool
. mkForeign $ \(mv :: MVar Closure, x) -> tryPutMVar mv x
declareForeign "MVar.swap.v2" boxBoxToEFBox
declareForeign "MVar.swap.v3" boxBoxToEFBox
. mkForeignIOF $ \(mv :: MVar Closure, x) -> swapMVar mv x
declareForeign "MVar.isEmpty" boxToBool
. mkForeign $ \(mv :: MVar Closure) -> isEmptyMVar mv
declareForeign "MVar.read.v2" boxBoxToEFBox
declareForeign "MVar.read.v3" boxBoxToEFBox
. mkForeignIOF $ \(mv :: MVar Closure) -> readMVar mv
declareForeign "MVar.tryRead" boxToMaybeBox
@ -1408,8 +1470,55 @@ declareForeigns = do
declareForeign "Text.toUtf8" boxDirect . mkForeign
$ pure . Bytes.fromArray . encodeUtf8
declareForeign "Text.fromUtf8.v2" boxToEFBox . mkForeign
$ pure . mapLeft (Failure ioFailureReference . pack . show) . decodeUtf8' . Bytes.toArray
declareForeign "Text.fromUtf8.v3" boxToEFBox . mkForeign
$ pure . mapLeft (\t -> Failure ioFailureReference (pack ( show t)) unitValue) . decodeUtf8' . Bytes.toArray
declareForeign "Tls.ClientConfig.default" boxBoxDirect . mkForeign
$ \(hostName::Text, serverId:: Bytes.Bytes) ->
fmap (\store ->
(defaultParamsClient (unpack hostName) (Bytes.toArray serverId)) {
TLS.clientSupported = def { TLS.supportedCiphers = Cipher.ciphersuite_strong },
TLS.clientShared = def { TLS.sharedCAStore = store }
}) X.getSystemCertificateStore
declareForeign "Tls.ServerConfig.default" boxBoxDirect $ mkForeign
$ \(certs :: [X.SignedCertificate], key :: X.PrivKey) ->
pure $ (def :: TLS.ServerParams) { TLS.serverSupported = def { TLS.supportedCiphers = Cipher.ciphersuite_strong }
, TLS.serverShared = def { TLS.sharedCredentials = Credentials [((X.CertificateChain certs), key)] }
}
let updateClient :: X.CertificateStore -> TLS.ClientParams -> TLS.ClientParams
updateClient certs client = client { TLS.clientShared = ((clientShared client) { TLS.sharedCAStore = certs }) } in
declareForeign "Tls.ClientConfig.certificates.set" boxBoxDirect . mkForeign $
\(certs :: [X.SignedCertificate], params :: ClientParams) -> pure $ updateClient (X.makeCertificateStore certs) params
let updateServer :: X.CertificateStore -> TLS.ServerParams -> TLS.ServerParams
updateServer certs client = client { TLS.serverShared = ((serverShared client) { TLS.sharedCAStore = certs }) } in
declareForeign "Tls.ServerConfig.certificates.set" boxBoxDirect . mkForeign $
\(certs :: [X.SignedCertificate], params :: ServerParams) -> pure $ updateServer (X.makeCertificateStore certs) params
declareForeign "TVar.new" boxDirect . mkForeign
$ \(c :: Closure) -> unsafeSTMToIO $ STM.newTVar c
declareForeign "TVar.read" boxDirect . mkForeign
$ \(v :: STM.TVar Closure) -> unsafeSTMToIO $ STM.readTVar v
declareForeign "TVar.write" boxBoxTo0 . mkForeign
$ \(v :: STM.TVar Closure, c :: Closure)
-> unsafeSTMToIO $ STM.writeTVar v c
declareForeign "TVar.newIO" boxDirect . mkForeign
$ \(c :: Closure) -> STM.newTVarIO c
declareForeign "TVar.readIO" boxDirect . mkForeign
$ \(v :: STM.TVar Closure) -> STM.readTVarIO v
declareForeign "TVar.swap" boxBoxDirect . mkForeign
$ \(v, c :: Closure) -> unsafeSTMToIO $ STM.swapTVar v c
declareForeign "STM.retry" unitDirect . mkForeign
$ \() -> unsafeSTMToIO STM.retry :: IO Closure
let
defaultSupported :: TLS.Supported
@ -1430,6 +1539,10 @@ declareForeigns = do
\(config :: TLS.ClientParams,
socket :: SYS.Socket) -> TLS.contextNew socket config
declareForeign "Tls.newServer" boxBoxToEFBox . mkForeignTls $
\(config :: TLS.ServerParams,
socket :: SYS.Socket) -> TLS.contextNew socket config
declareForeign "Tls.handshake" boxToEFBox . mkForeignTls $
\(tls :: TLS.Context) -> TLS.handshake tls
@ -1437,6 +1550,24 @@ declareForeigns = do
\(tls :: TLS.Context,
bytes :: Bytes.Bytes) -> TLS.sendData tls (Bytes.toLazyByteString bytes)
let wrapFailure t = Failure tlsFailureReference (pack t) unitValue
decoded :: Bytes.Bytes -> Either String PEM
decoded bytes = fmap head $ pemParseLBS $ Bytes.toLazyByteString bytes
asCert :: PEM -> Either String X.SignedCertificate
asCert pem = X.decodeSignedCertificate $ pemContent pem
in
declareForeign "Tls.decodeCert" boxToEFBox . mkForeign $
\(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes
declareForeign "Tls.encodeCert" boxDirect . mkForeign $
\(cert :: X.SignedCertificate) -> pure $ Bytes.fromArray $ X.encodeSignedObject cert
declareForeign "Tls.decodePrivateKey" boxDirect . mkForeign $
\(bytes :: Bytes.Bytes) -> pure $ X.readKeyFileFromMemory $ L.toStrict $ Bytes.toLazyByteString bytes
declareForeign "Tls.encodePrivateKey" boxDirect . mkForeign $
\(privateKey :: X.PrivKey) -> pure $ pack $ show privateKey
declareForeign "Tls.receive" boxToEFBox . mkForeignTls $
\(tls :: TLS.Context) -> do
bs <- TLS.recvData tls
@ -1564,3 +1695,6 @@ builtinTypeBackref = mapFromList $ swap <$> typeReferences
builtinForeigns :: EnumMap Word64 ForeignFunc
builtinForeigns | (_, _, m) <- foreignDeclResults @Symbol = m
unsafeSTMToIO :: STM.STM a -> IO a
unsafeSTMToIO (STM.STM m) = IO m

5
parser-typechecker/src/Unison/Runtime/Foreign.hs
View File

@ -21,6 +21,7 @@ import Data.Text (Text, unpack)
import Data.Tagged (Tagged(..))
import Network.Socket (Socket)
import qualified Network.TLS as TLS (ClientParams, Context, ServerParams)
import qualified Data.X509 as X509
import System.IO (Handle)
import Unison.Util.Bytes (Bytes)
import Unison.Reference (Reference)
@ -91,6 +92,8 @@ instance BuiltinForeign Socket where foreignRef = Tagged Ty.socketRef
instance BuiltinForeign ThreadId where foreignRef = Tagged Ty.threadIdRef
instance BuiltinForeign TLS.ClientParams where foreignRef = Tagged Ty.tlsClientConfigRef
instance BuiltinForeign TLS.ServerParams where foreignRef = Tagged Ty.tlsServerConfigRef
instance BuiltinForeign X509.SignedCertificate where foreignRef = Tagged Ty.tlsSignedCertRef
instance BuiltinForeign X509.PrivKey where foreignRef = Tagged Ty.tlsPrivateKeyRef
instance BuiltinForeign FilePath where foreignRef = Tagged Ty.filePathRef
instance BuiltinForeign TLS.Context where foreignRef = Tagged Ty.tlsRef
instance BuiltinForeign (SuperGroup Symbol) where
@ -103,7 +106,7 @@ data HashAlgorithm where
newtype Tls = Tls TLS.Context
data Failure = Failure Reference Text -- todo: Failure a = Failure Reference Text (Any a)
data Failure a = Failure Reference Text a
instance BuiltinForeign HashAlgorithm where foreignRef = Tagged Ty.hashAlgorithmRef

15
parser-typechecker/src/Unison/Runtime/Foreign/Function.hs
View File

@ -15,6 +15,7 @@ import GHC.IO.Exception (IOException(..), IOErrorType(..))
import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM (TVar)
import Data.Foldable (toList)
import Data.Text (Text, pack, unpack)
import Data.Time.Clock.POSIX (POSIXTime)
@ -25,7 +26,7 @@ import System.IO (BufferMode(..), SeekMode, Handle, IOMode)
import Unison.Util.Bytes (Bytes)
import Unison.Reference (Reference)
import Unison.Type (mvarRef, typeLinkRef)
import Unison.Type (mvarRef, tvarRef, typeLinkRef)
import Unison.Symbol (Symbol)
import Unison.Runtime.ANF (SuperGroup, Mem(..), Value)
@ -257,13 +258,15 @@ instance (ForeignConvention a, ForeignConvention b)
(ustk, bstk) <- writeForeign ustk bstk y
writeForeign ustk bstk x
instance ForeignConvention Failure where
instance ForeignConvention a => ForeignConvention (Failure a) where
readForeign us bs ustk bstk = do
(us,bs,typeref) <- readTypelink us bs ustk bstk
(us,bs,message) <- readForeign us bs ustk bstk
pure (us, bs, (Failure typeref message))
(us,bs,any) <- readForeign us bs ustk bstk
pure (us, bs, Failure typeref message any)
writeForeign ustk bstk (Failure typeref message) = do
writeForeign ustk bstk (Failure typeref message any) = do
(ustk, bstk) <- writeForeign ustk bstk any
(ustk, bstk) <- writeForeign ustk bstk message
writeTypeLink ustk bstk typeref
@ -320,6 +323,10 @@ instance ForeignConvention (MVar Closure) where
readForeign = readForeignAs (unwrapForeign . marshalToForeign)
writeForeign = writeForeignAs (Foreign . Wrap mvarRef)
instance ForeignConvention (TVar Closure) where
readForeign = readForeignAs (unwrapForeign . marshalToForeign)
writeForeign = writeForeignAs (Foreign . Wrap tvarRef)
instance ForeignConvention (SuperGroup Symbol) where
readForeign = readForeignBuiltin
writeForeign = writeForeignBuiltin

6
parser-typechecker/src/Unison/Runtime/IOSource.hs
View File

@ -27,8 +27,12 @@ import qualified Unison.UnisonFile as UF
import qualified Unison.Var as Var
import qualified Unison.Names3 as Names
debug :: Bool
debug = False
typecheckedFile :: UF.TypecheckedUnisonFile Symbol Ann
typecheckedFile = typecheckedFile'
typecheckedFile = let x = typecheckedFile' in
if debug then trace ("IOSource.typecheckedFile = " ++ show x) x else x
typecheckedFile' :: forall v. Var.Var v => UF.TypecheckedUnisonFile v Ann
typecheckedFile' = let

9
parser-typechecker/src/Unison/Runtime/MCode.hs
View File

@ -417,7 +417,13 @@ data Instr
-- Put a delimiter on the continuation
| Reset !(EnumSet Word64) -- prompt ids
-- Fork thread evaluating delayed computation on boxed stack
| Fork !Int
-- Atomic transaction evaluating delayed computation on boxed stack
| Atomically !Int
-- Build a sequence consisting of a variable number of arguments
| Seq !Args
deriving (Show, Eq, Ord)
@ -1059,6 +1065,9 @@ emitPOp ANF.BLDS = Seq
emitPOp ANF.FORK = \case
BArg1 i -> Fork i
_ -> error "fork takes exactly one boxed argument"
emitPOp ANF.ATOM = \case
BArg1 i -> Atomically i
_ -> error "atomically takes exactly one boxed argument"
emitPOp ANF.PRNT = \case
BArg1 i -> Print i
_ -> error "print takes exactly one boxed argument"

32
parser-typechecker/src/Unison/Runtime/Machine.hs
View File

@ -10,6 +10,7 @@ module Unison.Runtime.Machine where
import GHC.Stack
import Control.Concurrent.STM as STM
import GHC.Conc as STM (unsafeIOToSTM)
import Data.Maybe (fromMaybe)
@ -26,7 +27,7 @@ import qualified Data.Set as S
import Control.Exception
import Control.Lens ((<&>))
import Control.Concurrent (forkIOWithUnmask, ThreadId)
import Control.Concurrent (forkIO, ThreadId)
import qualified Data.Primitive.PrimArray as PA
@ -47,9 +48,6 @@ import Unison.Runtime.Stack
import Unison.Runtime.MCode
import qualified Unison.Type as Rf
import qualified Unison.Runtime.IOSource as Rf
import qualified Unison.Util.Pretty as Pr
import qualified Unison.Util.Bytes as By
import Unison.Util.EnumContainers as EC
@ -302,7 +300,12 @@ exec !env !denv !ustk !bstk !k (ForeignCall _ w args)
exec !env !denv !ustk !bstk !k (Fork i) = do
tid <- forkEval env =<< peekOff bstk i
bstk <- bump bstk
poke bstk . Foreign . Wrap Rf.threadIdReference $ tid
poke bstk . Foreign . Wrap Rf.threadIdRef $ tid
pure (denv, ustk, bstk, k)
exec !env !denv !ustk !bstk !k (Atomically i) = do
c <- peekOff bstk i
bstk <- bump bstk
atomicEval env (poke bstk) c
pure (denv, ustk, bstk, k)
{-# inline exec #-}
@ -343,19 +346,20 @@ eval !_ !_ !_ !_ !_ (Die s) = die s
forkEval :: CCache -> Closure -> IO ThreadId
forkEval env clo
= forkIOWithUnmask $ \unmask ->
unmask (apply1 err env clo) `catch` \case
PE e -> putStrLn "runtime exception"
>> print (Pr.render 70 e)
BU _ -> putStrLn $ "unison exception reached top level"
= forkIO (apply1 err env clo)
where
err :: Stack 'UN -> Stack 'BX -> IO ()
err _ bstk = peek bstk >>= \case
-- Left e
DataB1 _ 0 e -> throwIO $ BU e
_ -> pure ()
err _ _ = pure ()
{-# inline forkEval #-}
atomicEval :: CCache -> (Closure -> IO ()) -> Closure -> IO ()
atomicEval env write clo
= atomically . unsafeIOToSTM $ apply1 readBack env clo
where
readBack :: Stack 'UN -> Stack 'BX -> IO ()
readBack _ bstk = peek bstk >>= write
{-# inline atomicEval #-}
-- fast path application
enter
:: CCache -> DEnv -> Stack 'UN -> Stack 'BX -> K

4
parser-typechecker/src/Unison/Runtime/Pattern.hs
View File

@ -145,6 +145,10 @@ decomposePattern
:: Var v
=> Reference -> Int -> Int -> P.Pattern v
-> [[P.Pattern v]]
decomposePattern rf0 t _ (P.Boolean _ b)
| rf0 == Rf.booleanRef
, t == if b then 1 else 0
= [[]]
decomposePattern rf0 t nfields p@(P.Constructor _ rf u ps)
| t == u
, rf0 == rf

2
parser-typechecker/tests/Unison/Test/UnisonSources.hs
View File

@ -153,7 +153,7 @@ resultTest rt uf filepath = do
tm' = Term.letRec' False bindings watchResult
-- note . show $ tm'
-- note . show $ Term.amap (const ()) tm
expect $ tm' == Term.amap (const ()) tm
expectEqual tm' (Term.amap (const ()) tm)
Left e -> crash $ show e
else pure ()

3
parser-typechecker/unison-parser-typechecker.cabal
View File

@ -225,6 +225,7 @@ library
network,
network-simple,
nonempty-containers,
pem,
process,
primitive,
random,
@ -249,6 +250,8 @@ library
util,
vector,
unicode-show,
x509,
x509-store,
x509-system,
-- v2
unison-core,

6
stack.yaml
View File

@ -41,6 +41,12 @@ extra-deps:
- sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
- direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718
- ListLike-4.7.3
# remove these when stackage upgrades containers
- containers-0.6.4.1
- text-1.2.4.1
- binary-0.8.8.0
- parsec-3.1.14.0
- Cabal-3.2.1.0
ghc-options:
# All packages

19
unison-core/src/Unison/Type.hs
View File

@ -227,20 +227,30 @@ filePathRef = Reference.Builtin "FilePath"
threadIdRef = Reference.Builtin "ThreadId"
socketRef = Reference.Builtin "Socket"
mvarRef :: Reference
mvarRef, tvarRef :: Reference
mvarRef = Reference.Builtin "MVar"
tvarRef = Reference.Builtin "TVar"
tlsRef :: Reference
tlsRef = Reference.Builtin "Tls"
stmRef :: Reference
stmRef = Reference.Builtin "STM"
tlsClientConfigRef :: Reference
tlsClientConfigRef = Reference.Builtin "Tls.ClientConfig"
tlsServerConfigRef :: Reference
tlsServerConfigRef = Reference.Builtin "Tls.ServerConfig"
tlsCiphersRef :: Reference
tlsCiphersRef = Reference.Builtin "Tls.Ciphers"
tlsSignedCertRef :: Reference
tlsSignedCertRef = Reference.Builtin "Tls.SignedCert"
tlsPrivateKeyRef :: Reference
tlsPrivateKeyRef = Reference.Builtin "Tls.PrivateKey"
tlsCipherRef :: Reference
tlsCipherRef = Reference.Builtin "Tls.Cipher"
tlsVersionRef :: Reference
tlsVersionRef = Reference.Builtin "Tls.Version"
@ -255,6 +265,9 @@ valueRef = Reference.Builtin "Value"
anyRef :: Reference
anyRef = Reference.Builtin "Any"
any :: Ord v => a -> Type v a
any a = ref a anyRef
builtin :: Ord v => a -> Text -> Type v a
builtin a = ref a . Reference.Builtin

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

@ -72,7 +72,7 @@ autoCleaned.handler _ =
Left _ -> handle k dir with go dirs
{ TempDirs.removeDir dir -> k } ->
handle k (removeDirectory dir) with go (filter (d -> not (d == dir)) dirs)
handle k (removeDirectory dir) with go (filter (d -> not (d == dir)) dirs)
go []
@ -134,7 +134,7 @@ evalTest a = handle
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)
(results, Left (Failure _ t _)) -> results :+ (Fail t)
```
@ -157,13 +157,13 @@ testAutoClean _ =
dir
match evalTest go with
(results, Left (Failure _ t)) -> results :+ (Fail t)
(results, Left (Failure _ t _)) -> results :+ (Fail t)
(results, Right dir) ->
match isDirectory 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)
Left (Failure _ t _) -> results :+ (Fail t)
```
```ucm
@ -249,18 +249,19 @@ testSeek : '{io2.IO} [Result]
testSeek _ =
test = 'let
tempDir = toException (newTempDir "seek")
emit (Ok "seeked")
fooFile = tempDir ++ "/foo"
handle1 = toException (openFile fooFile FileMode.Write)
handle1 = toException (openFile fooFile FileMode.Append)
putBytes handle1 (toUtf8 "12345678")
closeFile handle1
handle3 = toException (openFile fooFile FileMode.Read)
check "readable file should be seekable" (toException (isSeekable handle3))
check "shouldn't be the EOF" (not (toException (isFileEOF handle3)))
expectU "we should be at position 0" +0 (toException (handlePosition handle3))
expectU "we should be at position 0" 0 (toException (handlePosition handle3))
toException (seekHandle handle3 AbsoluteSeek +1)
expectU "we should be at position 1" +1 (toException (handlePosition handle3))
expectU "we should be at position 1" 1 (toException (handlePosition handle3))
bytes3a = toException (getBytes handle3 1000)
text3a = toException (Text.fromUtf8 bytes3a)
expectU "should be able to read our temporary file after seeking" "2345678" text3a
@ -272,25 +273,24 @@ testAppend : '{io2.IO} [Result]
testAppend _ =
test = 'let
tempDir = toException (newTempDir "openFile")
fooFile = tempDir ++ "/foo"
handle1 = toException (openFile fooFile FileMode.Write)
putBytes handle1 (toUtf8 "test1")
closeFile handle1
toException (putBytes handle1 (toUtf8 "test1"))
toException (closeFile handle1)
handle2 = toException (openFile fooFile FileMode.Append)
putBytes handle2 (toUtf8 "test2")
expectU "we should be at position 4" +4 (toException (handlePosition handle2))
check "which is the EOF" (toException (isFileEOF handle2))
closeFile handle2
toException (putBytes handle2 (toUtf8 "test2"))
toException (closeFile handle2)
handle3 = toException (openFile fooFile FileMode.Read)
bytes3 = toException (getBytes handle3 1000)
text3 = toException (Text.fromUtf8 bytes3)
expectU "should be able to read our temporary file" "test1test2" text3
closeFile handle3
runTest test
```
```ucm
@ -305,7 +305,7 @@ testSystemTime : '{io2.IO} [Result]
testSystemTime _ =
test = 'let
t = toException !io2.IO.systemTime
check "systemTime should be sane" ((t > 1600000000) && (t > 2000000000))
check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000))
runTest test
```
@ -321,34 +321,3 @@ 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.
```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' = toException (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)
expectU "swap returns old contents" test test''
test''' = toException (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
.> add
.> io.test testMvars
```

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

@ -67,7 +67,7 @@ autoCleaned.handler _ =
Left _ -> handle k dir with go dirs
{ TempDirs.removeDir dir -> k } ->
handle k (removeDirectory dir) with go (filter (d -> not (d == dir)) dirs)
handle k (removeDirectory dir) with go (filter (d -> not (d == dir)) dirs)
go []
@ -129,7 +129,7 @@ evalTest a = handle
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)
(results, Left (Failure _ t _)) -> results :+ (Fail t)
```
@ -148,13 +148,13 @@ testAutoClean _ =
dir
match evalTest go with
(results, Left (Failure _ t)) -> results :+ (Fail t)
(results, Left (Failure _ t _)) -> results :+ (Fail t)
(results, Right dir) ->
match isDirectory 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)
Left (Failure _ t _) -> results :+ (Fail t)
```
```ucm
@ -322,18 +322,19 @@ testSeek : '{io2.IO} [Result]
testSeek _ =
test = 'let
tempDir = toException (newTempDir "seek")
emit (Ok "seeked")
fooFile = tempDir ++ "/foo"
handle1 = toException (openFile fooFile FileMode.Write)
handle1 = toException (openFile fooFile FileMode.Append)
putBytes handle1 (toUtf8 "12345678")
closeFile handle1
handle3 = toException (openFile fooFile FileMode.Read)
check "readable file should be seekable" (toException (isSeekable handle3))
check "shouldn't be the EOF" (not (toException (isFileEOF handle3)))
expectU "we should be at position 0" +0 (toException (handlePosition handle3))
expectU "we should be at position 0" 0 (toException (handlePosition handle3))
toException (seekHandle handle3 AbsoluteSeek +1)
expectU "we should be at position 1" +1 (toException (handlePosition handle3))
expectU "we should be at position 1" 1 (toException (handlePosition handle3))
bytes3a = toException (getBytes handle3 1000)
text3a = toException (Text.fromUtf8 bytes3a)
expectU "should be able to read our temporary file after seeking" "2345678" text3a
@ -345,25 +346,24 @@ testAppend : '{io2.IO} [Result]
testAppend _ =
test = 'let
tempDir = toException (newTempDir "openFile")
fooFile = tempDir ++ "/foo"
handle1 = toException (openFile fooFile FileMode.Write)
putBytes handle1 (toUtf8 "test1")
closeFile handle1
toException (putBytes handle1 (toUtf8 "test1"))
toException (closeFile handle1)
handle2 = toException (openFile fooFile FileMode.Append)
putBytes handle2 (toUtf8 "test2")
expectU "we should be at position 4" +4 (toException (handlePosition handle2))
check "which is the EOF" (toException (isFileEOF handle2))
closeFile handle2
toException (putBytes handle2 (toUtf8 "test2"))
toException (closeFile handle2)
handle3 = toException (openFile fooFile FileMode.Read)
bytes3 = toException (getBytes handle3 1000)
text3 = toException (Text.fromUtf8 bytes3)
expectU "should be able to read our temporary file" "test1test2" text3
closeFile handle3
runTest test
```
@ -391,10 +391,14 @@ testAppend _ =
New test results:
◉ testSeek seeked
◉ testSeek readable file should be seekable
◉ testSeek shouldn't be the EOF
◉ testSeek we should be at position 0
◉ testSeek we should be at position 1
◉ testSeek should be able to read our temporary file after seeking
✅ 2 test(s) passing
✅ 6 test(s) passing
Tip: Use view testSeek to view the source of a test.
@ -402,7 +406,11 @@ testAppend _ =
New test results:
😶 No tests available.
◉ testAppend should be able to read our temporary file
✅ 1 test(s) passing
Tip: Use view testAppend to view the source of a test.
```
### SystemTime
@ -411,7 +419,7 @@ testSystemTime : '{io2.IO} [Result]
testSystemTime _ =
test = 'let
t = toException !io2.IO.systemTime
check "systemTime should be sane" ((t > 1600000000) && (t > 2000000000))
check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000))
runTest test
```
@ -452,68 +460,3 @@ 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.
```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' = toException (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)
expectU "swap returns old contents" test test''
test''' = toException (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.
```

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

@ -0,0 +1,142 @@
# 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
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' = toException (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)
expectU "swap returns old contents" test test''
test''' = toException (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
.> add
.> io.test testMvars
```

234
unison-src/new-runtime-transcripts/net.md Normal file
View File

@ -0,0 +1,234 @@
# 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)
```
```ucm:hide
.> add
```
### Creating server sockets
This section tests functions in the IO builtin related to binding to
TCP server socket, as to be able to accept incoming TCP connections.
```
builtin.io2.IO.serverSocket : Optional Text -> Text ->{io2.IO} Either Failure io2.Socket
```
This function takes two parameters, The first is the Hostname. If None
is provided, We will attempt to bind to 0.0.0.0 (All ipv4
addresses). We currently only support IPV4 (we should fix this!)
The second is the name of the port to bind to. This can be
a decimal representation of a port number between 1-65535. This can be
a named port like "ssh" (for port 22) or "kermit" (for port 1649),
This mapping of names to port numbers is maintained by the [nsswitch
service](https://en.wikipedia.org/wiki/Name_Service_Switch), typically
stored in `/etc/services` and queried with the `getent` tool:
# map number to name
$ getent services 22
ssh 22/tcp
# map name to number
$ getent services finger
finger 79/tcp
# get a list of all known names
$ getent services | head
tcpmux 1/tcp
echo 7/tcp
echo 7/udp
discard 9/tcp sink null
discard 9/udp sink null
systat 11/tcp users
daytime 13/tcp
daytime 13/udp
netstat 15/tcp
qotd 17/tcp quote
Below shows different examples of how we might specify the server coordinates.
``` unison
testExplicitHost : '{io2.IO} [Result]
testExplicitHost _ =
test = 'let
sock = toException (io2.IO.serverSocket (Some "127.0.0.1") "1028")
emit (Ok "successfully created socket")
port = toException (socketPort sock)
putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port
runTest test
testDefaultHost : '{io2.IO} [Result]
testDefaultHost _ =
test = 'let
sock = toException (io2.IO.serverSocket None "1028")
emit (Ok "successfully created socket")
port = toException (socketPort sock)
putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port
runTest test
testDefaultPort : '{io2.IO} [Result]
testDefaultPort _ =
test = 'let
sock = toException (io2.IO.serverSocket None "0")
emit (Ok "successfully created socket")
port = toException (socketPort sock)
putBytes (stdHandle StdOut) (toUtf8 (toText port))
check "port should be > 1024" (1024 < port)
check "port should be < 65536" (65536 > port)
runTest test
```
```ucm
.> add
.> io.test testDefaultPort
```
This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar.
```unison
serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let
go = 'let
sock = toException (serverSocket (Some "127.0.0.1") "0")
port = toException (socketPort sock)
toException (put portVar port)
toException (listen sock)
sock' = toException (socketAccept sock)
toException (socketSend sock' (toUtf8 toSend))
toException (closeSocket sock')
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
clientThread : MVar Nat -> MVar Text -> '{io2.IO}()
clientThread portVar resultVar = 'let
go : '{io2.IO, Exception Failure}()
go = 'let
port = toException (take portVar)
sock = toException (clientSocket "127.0.0.1" (Nat.toText port))
msg = toException (fromUtf8 (toException (socketReceive sock 100)))
toException (MVar.put resultVar msg)
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testTcpConnect : '{io2.IO}[Result]
testTcpConnect = 'let
test = 'let
portVar = !MVar.newEmpty
resultVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
forkComp (clientThread portVar resultVar)
received = toException (MVar.take resultVar)
expectU (a->a) "should have reaped what we've sown" toSend received
runTest test
```
```ucm
.> add
.> io.test testTcpConnect
```

286
unison-src/new-runtime-transcripts/net.output.md Normal file
View File

@ -0,0 +1,286 @@
# 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)
```
### Creating server sockets
This section tests functions in the IO builtin related to binding to
TCP server socket, as to be able to accept incoming TCP connections.
```builtin
.io2.IO.serverSocket : Optional Text -> Text ->{io2.IO} Either Failure io2.Socket
```
This function takes two parameters, The first is the Hostname. If None
is provided, We will attempt to bind to 0.0.0.0 (All ipv4
addresses). We currently only support IPV4 (we should fix this!)
The second is the name of the port to bind to. This can be
a decimal representation of a port number between 1-65535. This can be
a named port like "ssh" (for port 22) or "kermit" (for port 1649),
This mapping of names to port numbers is maintained by the [nsswitch
service](https://en.wikipedia.org/wiki/Name_Service_Switch), typically
stored in `/etc/services` and queried with the `getent` tool:
# map number to name
$ getent services 22
ssh 22/tcp
# map name to number
$ getent services finger
finger 79/tcp
# get a list of all known names
$ getent services | head
tcpmux 1/tcp
echo 7/tcp
echo 7/udp
discard 9/tcp sink null
discard 9/udp sink null
systat 11/tcp users
daytime 13/tcp
daytime 13/udp
netstat 15/tcp
qotd 17/tcp quote
Below shows different examples of how we might specify the server coordinates.
```unison
testExplicitHost : '{io2.IO} [Result]
testExplicitHost _ =
test = 'let
sock = toException (io2.IO.serverSocket (Some "127.0.0.1") "1028")
emit (Ok "successfully created socket")
port = toException (socketPort sock)
putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port
runTest test
testDefaultHost : '{io2.IO} [Result]
testDefaultHost _ =
test = 'let
sock = toException (io2.IO.serverSocket None "1028")
emit (Ok "successfully created socket")
port = toException (socketPort sock)
putBytes (stdHandle StdOut) (toUtf8 (toText port))
expectU Nat.toText "should have bound to port 1028" 1028 port
runTest test
testDefaultPort : '{io2.IO} [Result]
testDefaultPort _ =
test = 'let
sock = toException (io2.IO.serverSocket None "0")
emit (Ok "successfully created socket")
port = toException (socketPort sock)
putBytes (stdHandle StdOut) (toUtf8 (toText port))
check "port should be > 1024" (1024 < port)
check "port should be < 65536" (65536 > port)
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`:
testDefaultHost : '{io2.IO} [Result]
testDefaultPort : '{io2.IO} [Result]
testExplicitHost : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
testDefaultHost : '{io2.IO} [Result]
testDefaultPort : '{io2.IO} [Result]
testExplicitHost : '{io2.IO} [Result]
.> io.test testDefaultPort
New test results:
◉ testDefaultPort successfully created socket
◉ testDefaultPort port should be > 1024
◉ testDefaultPort port should be < 65536
✅ 3 test(s) passing
Tip: Use view testDefaultPort to view the source of a test.
```
This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar.
```unison
serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let
go = 'let
sock = toException (serverSocket (Some "127.0.0.1") "0")
port = toException (socketPort sock)
toException (put portVar port)
toException (listen sock)
sock' = toException (socketAccept sock)
toException (socketSend sock' (toUtf8 toSend))
toException (closeSocket sock')
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
clientThread : MVar Nat -> MVar Text -> '{io2.IO}()
clientThread portVar resultVar = 'let
go : '{io2.IO, Exception Failure}()
go = 'let
port = toException (take portVar)
sock = toException (clientSocket "127.0.0.1" (Nat.toText port))
msg = toException (fromUtf8 (toException (socketReceive sock 100)))
toException (MVar.put resultVar msg)
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testTcpConnect : '{io2.IO}[Result]
testTcpConnect = 'let
test = 'let
portVar = !MVar.newEmpty
resultVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
forkComp (clientThread portVar resultVar)
received = toException (MVar.take resultVar)
expectU (a->a) "should have reaped what we've sown" toSend received
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`:
clientThread : MVar Nat -> MVar Text -> '{io2.IO} ()
serverThread : MVar Nat -> Text -> '{io2.IO} ()
testTcpConnect : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
clientThread : MVar Nat -> MVar Text -> '{io2.IO} ()
serverThread : MVar Nat -> Text -> '{io2.IO} ()
testTcpConnect : '{io2.IO} [Result]
.> io.test testTcpConnect
New test results:
◉ testTcpConnect should have reaped what we've sown
✅ 1 test(s) passing
Tip: Use view testTcpConnect to view the source of a test.
```

104
unison-src/new-runtime-transcripts/stm.md Normal file
View File

@ -0,0 +1,104 @@
```ucm
.> builtins.merge
```
Standard helpful definitions
```unison
use io2
stdout : Handle
stdout = stdHandle StdOut
putLn : Text ->{IO} ()
putLn t =
putBytes 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 v =
atomically 'let
x = TVar.read v
TVar.write v (x+1)
x
loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat
loop grab acc = cases
0 -> acc
n ->
m = !grab
count (m*10)
loop grab (acc+m) (drop n 1)
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} ()
body k out v =
n = loop '(inc v) 0 k
atomically '(TVar.write out (Some n))
```
```ucm
.> add
```
Test case.
```unison
spawn : Nat ->{IO} Result
spawn k = let
out1 = TVar.newIO None
out2 = TVar.newIO None
counter = atomically '(TVar.new 0)
forkComp '(Right (body k out1 counter))
forkComp '(Right (body k out2 counter))
p = atomically 'let
r1 = TVar.read out1
r2 = TVar.swap out2 None
match (r1, r2) with
(Some m, Some n) -> (m, n)
_ -> !STM.retry
max = TVar.readIO counter
match p with (m, n) ->
sum : Nat
sum = max * drop max 1 / 2
if m+n == sum
then Ok "verified"
else Fail (display m n sum)
display : Nat -> Nat -> Nat -> Text
display m n s =
"mismatch: " ++ toText m ++ " + " ++ toText n ++ " /= " ++ toText s
nats : [Nat]
nats = [89,100,116,144,169,188,200,233,256,300]
tests : '{IO} [Result]
tests = '(map spawn nats)
```
```ucm
.> add
.> io.test tests
```

186
unison-src/new-runtime-transcripts/stm.output.md Normal file
View File

@ -0,0 +1,186 @@
```ucm
.> builtins.merge
Done.
```
Standard helpful definitions
```unison
use io2
stdout : Handle
stdout = stdHandle StdOut
putLn : Text ->{IO} ()
putLn t =
putBytes 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 v =
atomically 'let
x = TVar.read v
TVar.write v (x+1)
x
loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat
loop grab acc = cases
0 -> acc
n ->
m = !grab
count (m*10)
loop grab (acc+m) (drop n 1)
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} ()
body k out v =
n = loop '(inc v) 0 k
atomically '(TVar.write out (Some n))
```
```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`:
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} ()
count : Nat -> ()
inc : TVar Nat ->{IO} Nat
loop : '{IO} Nat ->{IO} Nat ->{IO} Nat ->{IO} Nat
```
```ucm
.> add
⍟ I've added these definitions:
body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} ()
count : Nat -> ()
inc : TVar Nat ->{IO} Nat
loop : '{IO} Nat ->{IO} Nat ->{IO} Nat ->{IO} Nat
```
Test case.
```unison
spawn : Nat ->{IO} Result
spawn k = let
out1 = TVar.newIO None
out2 = TVar.newIO None
counter = atomically '(TVar.new 0)
forkComp '(Right (body k out1 counter))
forkComp '(Right (body k out2 counter))
p = atomically 'let
r1 = TVar.read out1
r2 = TVar.swap out2 None
match (r1, r2) with
(Some m, Some n) -> (m, n)
_ -> !STM.retry
max = TVar.readIO counter
match p with (m, n) ->
sum : Nat
sum = max * drop max 1 / 2
if m+n == sum
then Ok "verified"
else Fail (display m n sum)
display : Nat -> Nat -> Nat -> Text
display m n s =
"mismatch: " ++ toText m ++ " + " ++ toText n ++ " /= " ++ toText s
nats : [Nat]
nats = [89,100,116,144,169,188,200,233,256,300]
tests : '{IO} [Result]
tests = '(map spawn nats)
```
```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`:
display : Nat -> Nat -> Nat -> Text
nats : [Nat]
spawn : Nat ->{IO} Result
tests : '{IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
display : Nat -> Nat -> Nat -> Text
nats : [Nat]
spawn : Nat ->{IO} Result
tests : '{IO} [Result]
.> io.test tests
New test results:
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
✅ 10 test(s) passing
Tip: Use view tests to view the source of a test.
```

196
unison-src/new-runtime-transcripts/thread.md Normal file
View File

@ -0,0 +1,196 @@
## 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
```unison
otherThread : '{io2.IO}()
otherThread = 'let
watch "I'm the other Thread" ()
testBasicFork : '{io2.IO} [Result]
testBasicFork = 'let
test = 'let
watch "I'm the parent thread" ()
threadId = io2.IO.forkComp otherThread
emit (Ok "created thread")
runTest test
```
See if we can get another thread to stuff a value into a MVar
```ucm:hide
.> add
.> io.test testBasicFork
```
```unison
thread1 : MVar Nat -> '{io2.IO}()
thread1 mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let
x = toException (take mv)
toException (put mv (increment x))
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testBasicMultiThreadMVar : '{io2.IO} [Result]
testBasicMultiThreadMVar = 'let
test: '{io2.IO, Exception Failure, Stream Result} ()
test = 'let
mv = new 10
forkComp (thread1 mv)
next = toException (take mv)
expectU Nat.toText "other thread should have incremented" 11 next
runTest test
```
```ucm
.> add
.> io.test testBasicMultiThreadMVar
```
```unison
sendingThread: Nat -> MVar Nat -> '{io2.IO}()
sendingThread toSend mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let
toException (put mv (increment toSend))
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
receivingThread: MVar Nat -> MVar Text -> '{io2.IO}()
receivingThread recv send = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let
recvd = toException (take recv)
toException (put send (toText recvd))
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testTwoThreads: '{io2.IO}[Result]
testTwoThreads = 'let
test = 'let
send = !MVar.newEmpty
recv = !MVar.newEmpty
forkComp (sendingThread 6 send)
forkComp (receivingThread send recv)
recvd = toException (take recv)
expectU (x->x) "" "7" recvd
runTest test
```
```ucm
.> add
.> io.test testTwoThreads
```

250
unison-src/new-runtime-transcripts/thread.output.md Normal file
View File

@ -0,0 +1,250 @@
## 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
```unison
otherThread : '{io2.IO}()
otherThread = 'let
watch "I'm the other Thread" ()
testBasicFork : '{io2.IO} [Result]
testBasicFork = 'let
test = 'let
watch "I'm the parent thread" ()
threadId = io2.IO.forkComp otherThread
emit (Ok "created thread")
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`:
otherThread : '{io2.IO} ()
testBasicFork : '{io2.IO} [Result]
```
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 mv)
toException (put mv (increment x))
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testBasicMultiThreadMVar : '{io2.IO} [Result]
testBasicMultiThreadMVar = 'let
test: '{io2.IO, Exception Failure, Stream Result} ()
test = 'let
mv = new 10
forkComp (thread1 mv)
next = toException (take mv)
expectU Nat.toText "other thread should have incremented" 11 next
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`:
testBasicMultiThreadMVar : '{io2.IO} [Result]
thread1 : MVar Nat -> '{io2.IO} ()
```
```ucm
.> add
⍟ I've added these definitions:
testBasicMultiThreadMVar : '{io2.IO} [Result]
thread1 : MVar Nat -> '{io2.IO} ()
.> io.test testBasicMultiThreadMVar
New test results:
◉ testBasicMultiThreadMVar other thread should have incremented
✅ 1 test(s) passing
Tip: Use view testBasicMultiThreadMVar to view the source of a
test.
```
```unison
sendingThread: Nat -> MVar Nat -> '{io2.IO}()
sendingThread toSend mv = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let
toException (put mv (increment toSend))
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
receivingThread: MVar Nat -> MVar Text -> '{io2.IO}()
receivingThread recv send = 'let
go : '{io2.IO, Exception Failure} ()
go = 'let
recvd = toException (take recv)
toException (put send (toText recvd))
match (toEither go) with
Left (Failure _ t _) -> watch t ()
_ -> ()
testTwoThreads: '{io2.IO}[Result]
testTwoThreads = 'let
test = 'let
send = !MVar.newEmpty
recv = !MVar.newEmpty
forkComp (sendingThread 6 send)
forkComp (receivingThread send recv)
recvd = toException (take recv)
expectU (x->x) "" "7" recvd
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`:
receivingThread : MVar Nat -> MVar Text -> '{io2.IO} ()
sendingThread : Nat -> MVar Nat -> '{io2.IO} ()
testTwoThreads : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
receivingThread : MVar Nat -> MVar Text -> '{io2.IO} ()
sendingThread : Nat -> MVar Nat -> '{io2.IO} ()
testTwoThreads : '{io2.IO} [Result]
.> io.test testTwoThreads
New test results:
◉ testTwoThreads
✅ 1 test(s) passing
Tip: Use view testTwoThreads to view the source of a test.
```

287
unison-src/new-runtime-transcripts/tls.md Normal file
View File

@ -0,0 +1,287 @@
# 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 (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
.> add
```
# Using an alternative certificate store
First lets make sure we can load our cert and private key
```unison
test> match (decodeCert (toUtf8 self_signed_cert_pem) with
Left (Failure _ t _) -> [Fail t]
Right _ -> [Ok "succesfully decoded self_signed_pem"]
```
Test handshaking a client/server a local TCP connection using our
self-signed cert.
We'll create a server and a client, and start threads for each.
The server will report the port it is bound to via a passed MVar which
the client can read.
```unison
serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let
go = 'let
-- load our self signed cert
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException
-- assume there is exactly one key decoded from our Bytes
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
-- create a default configuration using our credentials (certificate chain and key)
tlsconfig = Tls.ServerConfig.default [cert] key
-- Open a TCP server port:
-- we pass the special port "0" to mean "please find us an open port"
sock = serverSocket (Some "127.0.0.1") "0" |> toException
-- find out what port we got
port = socketPort sock |> toException
-- report the port back so that the client knows where to connect
MVar.put portVar port |> toException
-- start listening to the socket so that it starts accepting connections
listen sock |> toException
watch ("server listening on port: " ++ (toText port)) ()
-- accept a single connection on this socket
sock' = socketAccept sock |> toException
-- attach TLS to our TCP connection
tls = newServer tlsconfig sock' |> toException
-- try to handshake the TLS connection with the client
handshake tls |> toException
-- send our message over our tls channel
send tls (toUtf8 toSend) |> toException
terminate tls |> toException
closeSocket sock' |> toException
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 cert hostname portVar _ =
-- create a client that will expect a cert from the given hostname (CN)
defaultClient = (Tls.ClientConfig.default hostname Bytes.empty)
-- if we were passed a certificate to trust, it is the only certificate we trust
tlsconfig = match cert with
None -> defaultClient
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
-- wait to find out what port the server started on
port = take portVar |> toException
-- create a tcp connection with the server
sock = clientSocket "127.0.0.1" (Nat.toText port) |> toException
-- attach the TLS client to the TCP socket
tls = newClient tlsconfig sock |> toException
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
-- receive a message from the server
fromUtf8 (toException (receive tls)) |> toException
testConnectSelfSigned : '{io2.IO}[Result]
testConnectSelfSigned _ =
test _ =
-- Server
portVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
-- Client
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException
received = !(testClient (Some cert) "test.unison.cloud" portVar)
expectU (a->a) "should have reaped what we've sown" toSend received
runTest test
-- this client will trust whatever certs the system trusts
-- for signing certs. This should NOT trust the server
-- serving the self-signed cert, so both the client and
-- the server should have a failure during the handshake
testCAReject : '{io2.IO}[Result]
testCAReject _ =
checkError : Either Failure a -> Result
checkError = cases
Right _ -> Fail "expected a handshake exception"
Left (Failure _ t _) ->
if contains "UnknownCa" t && contains "HandshakeFailed" t then Ok "correctly rejected self-signed cert" else
Fail ("expected UnknownCa, got: " ++ t)
test _ =
-- Server
portVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
-- Client
testClient None "test.unison.cloud" portVar |> toEither |> checkError |> emit
runTest test
-- this client will ask for a different hostname, and
-- therefore should fail during the handshake when the
-- server presents an cert with unexpected hostname
testCNReject : '{io2.IO}[Result]
testCNReject _ =
checkError : Either Failure a -> Result
checkError = cases
Right _ -> Fail "expected a handshake exception"
Left (Failure _ t _) -> if contains "NameMismatch" t && contains "HandshakeFailed" t then Ok "correctly rejected self-signed cert" else
Fail ("expected UnknownCa, got: " ++ t)
test _ =
-- Server
portVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
-- Client
testClient None "wrong.host.name" portVar |> toEither |> checkError |> emit
runTest test
```
```ucm
.> add
.> io.test testConnectSelfSigned
.> io.test testCAReject
.> io.test testCNReject
```

353
unison-src/new-runtime-transcripts/tls.output.md Normal file
View File

@ -0,0 +1,353 @@
# 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 (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
First lets make sure we can load our cert and private key
```unison
test> match (decodeCert (toUtf8 self_signed_cert_pem) with
Left (Failure _ t _) -> [Fail t]
Right _ -> [Ok "succesfully decoded self_signed_pem"]
```
```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`:
test.ckc3ihvvem (Unison bug, unknown term)
Now evaluating any watch expressions (lines starting with
`>`)... Ctrl+C cancels.
1 | test> match (decodeCert (toUtf8 self_signed_cert_pem) with
✅ Passed succesfully decoded self_signed_pem
```
Test handshaking a client/server a local TCP connection using our
self-signed cert.
We'll create a server and a client, and start threads for each.
The server will report the port it is bound to via a passed MVar which
the client can read.
```unison
serverThread: MVar Nat -> Text -> '{io2.IO}()
serverThread portVar toSend = 'let
go = 'let
-- load our self signed cert
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException
-- assume there is exactly one key decoded from our Bytes
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
-- create a default configuration using our credentials (certificate chain and key)
tlsconfig = Tls.ServerConfig.default [cert] key
-- Open a TCP server port:
-- we pass the special port "0" to mean "please find us an open port"
sock = serverSocket (Some "127.0.0.1") "0" |> toException
-- find out what port we got
port = socketPort sock |> toException
-- report the port back so that the client knows where to connect
MVar.put portVar port |> toException
-- start listening to the socket so that it starts accepting connections
listen sock |> toException
watch ("server listening on port: " ++ (toText port)) ()
-- accept a single connection on this socket
sock' = socketAccept sock |> toException
-- attach TLS to our TCP connection
tls = newServer tlsconfig sock' |> toException
-- try to handshake the TLS connection with the client
handshake tls |> toException
-- send our message over our tls channel
send tls (toUtf8 toSend) |> toException
terminate tls |> toException
closeSocket sock' |> toException
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 cert hostname portVar _ =
-- create a client that will expect a cert from the given hostname (CN)
defaultClient = (Tls.ClientConfig.default hostname Bytes.empty)
-- if we were passed a certificate to trust, it is the only certificate we trust
tlsconfig = match cert with
None -> defaultClient
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
-- wait to find out what port the server started on
port = take portVar |> toException
-- create a tcp connection with the server
sock = clientSocket "127.0.0.1" (Nat.toText port) |> toException
-- attach the TLS client to the TCP socket
tls = newClient tlsconfig sock |> toException
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
-- receive a message from the server
fromUtf8 (toException (receive tls)) |> toException
testConnectSelfSigned : '{io2.IO}[Result]
testConnectSelfSigned _ =
test _ =
-- Server
portVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
-- Client
cert = decodeCert (toUtf8 self_signed_cert_pem) |> toException
received = !(testClient (Some cert) "test.unison.cloud" portVar)
expectU (a->a) "should have reaped what we've sown" toSend received
runTest test
-- this client will trust whatever certs the system trusts
-- for signing certs. This should NOT trust the server
-- serving the self-signed cert, so both the client and
-- the server should have a failure during the handshake
testCAReject : '{io2.IO}[Result]
testCAReject _ =
checkError : Either Failure a -> Result
checkError = cases
Right _ -> Fail "expected a handshake exception"
Left (Failure _ t _) ->
if contains "UnknownCa" t && contains "HandshakeFailed" t then Ok "correctly rejected self-signed cert" else
Fail ("expected UnknownCa, got: " ++ t)
test _ =
-- Server
portVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
-- Client
testClient None "test.unison.cloud" portVar |> toEither |> checkError |> emit
runTest test
-- this client will ask for a different hostname, and
-- therefore should fail during the handshake when the
-- server presents an cert with unexpected hostname
testCNReject : '{io2.IO}[Result]
testCNReject _ =
checkError : Either Failure a -> Result
checkError = cases
Right _ -> Fail "expected a handshake exception"
Left (Failure _ t _) -> if contains "NameMismatch" t && contains "HandshakeFailed" t then Ok "correctly rejected self-signed cert" else
Fail ("expected UnknownCa, got: " ++ t)
test _ =
-- Server
portVar = !MVar.newEmpty
toSend = "12345"
forkComp (serverThread portVar toSend)
-- Client
testClient None "wrong.host.name" portVar |> toEither |> checkError |> emit
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`:
serverThread : MVar Nat -> Text -> '{io2.IO} ()
testCAReject : '{io2.IO} [Result]
testCNReject : '{io2.IO} [Result]
testClient : Optional SignedCert
-> Text
-> MVar Nat
-> '{io2.IO, Exception Failure} Text
testConnectSelfSigned : '{io2.IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
serverThread : MVar Nat -> Text -> '{io2.IO} ()
testCAReject : '{io2.IO} [Result]
testCNReject : '{io2.IO} [Result]
testClient : Optional SignedCert
-> Text
-> MVar Nat
-> '{io2.IO, Exception Failure} Text
testConnectSelfSigned : '{io2.IO} [Result]
.> io.test testConnectSelfSigned
New test results:
◉ testConnectSelfSigned should have reaped what we've sown
✅ 1 test(s) passing
Tip: Use view testConnectSelfSigned to view the source of a
test.
.> io.test testCAReject
New test results:
◉ testCAReject correctly rejected self-signed cert
✅ 1 test(s) passing
Tip: Use view testCAReject to view the source of a test.
.> io.test testCNReject
New test results:
◉ testCNReject correctly rejected self-signed cert
✅ 1 test(s) passing
Tip: Use view testCNReject to view the source of a test.
```

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

@ -54,6 +54,6 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206]
-- Its an error if we drop the first byte
> match fromUtf8 (drop 1 greek_bytes) with
Left (Failure _ t) -> t
Left (Failure _ t _) -> t
```

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

@ -108,7 +108,7 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206]
-- Its an error if we drop the first byte
> match fromUtf8 (drop 1 greek_bytes) with
Left (Failure _ t) -> t
Left (Failure _ t _) -> t
```

22
unison-src/tests/methodical/pattern-matching.u
View File

@ -19,10 +19,30 @@ pat7 x y = cases
(p1, _) | p1 == 9 -> (x + y : Nat, p1)
(p1, _) | true -> (0, p1)
bpat = cases
false -> 0
true -> 1
npat = cases
0 -> 1
_ -> 0
ipat = cases
+1 -> -1
-1 -> +1
_ -> +0
> (pat1 0 1 (2, 3),
pat2 0 1 "hi",
pat3 0 1 (2, 3),
pat4 0 1 (2, 3),
pat5 0 1 (3, 2),
pat6 1 2 (3, 4),
pat7 1 2 (20, 10))
pat7 1 2 (20, 10),
bpat false,
bpat true,
npat 0,
npat 33,
ipat +1,
ipat -1,
ipat -33)

9
unison-src/tests/methodical/pattern-matching.ur
View File

@ -4,4 +4,11 @@
(0, 1, 2),
(0, 1, 2),
(3, 3),
(0, 20))
(0, 20),
0,
1,
1,
0,
-1,
+1,
+0)

436
unison-src/transcripts/alias-many.output.md
View File

@ -128,234 +128,280 @@ Let's try it!
108. Int.trailingZeros : Int -> Nat
109. Int.truncate0 : Int -> Nat
110. Int.xor : Int -> Int -> Int
111. unique type Link
112. builtin type Link.Term
113. Link.Term : Term -> Link
114. builtin type Link.Type
115. Link.Type : Type -> Link
116. builtin type List
117. List.++ : [a] -> [a] -> [a]
118. List.+: : a -> [a] -> [a]
119. List.:+ : [a] -> a -> [a]
120. List.at : Nat -> [a] -> Optional a
121. List.cons : a -> [a] -> [a]
122. List.drop : Nat -> [a] -> [a]
123. List.empty : [a]
124. List.size : [a] -> Nat
125. List.snoc : [a] -> a -> [a]
126. List.take : Nat -> [a] -> [a]
127. builtin type Nat
128. Nat.* : Nat -> Nat -> Nat
129. Nat.+ : Nat -> Nat -> Nat
130. Nat./ : Nat -> Nat -> Nat
131. Nat.and : Nat -> Nat -> Nat
132. Nat.complement : Nat -> Nat
133. Nat.drop : Nat -> Nat -> Nat
134. Nat.eq : Nat -> Nat -> Boolean
135. Nat.fromText : Text -> Optional Nat
136. Nat.gt : Nat -> Nat -> Boolean
137. Nat.gteq : Nat -> Nat -> Boolean
138. Nat.increment : Nat -> Nat
139. Nat.isEven : Nat -> Boolean
140. Nat.isOdd : Nat -> Boolean
141. Nat.leadingZeros : Nat -> Nat
142. Nat.lt : Nat -> Nat -> Boolean
143. Nat.lteq : Nat -> Nat -> Boolean
144. Nat.mod : Nat -> Nat -> Nat
145. Nat.or : Nat -> Nat -> Nat
146. Nat.popCount : Nat -> Nat
147. Nat.pow : Nat -> Nat -> Nat
148. Nat.shiftLeft : Nat -> Nat -> Nat
149. Nat.shiftRight : Nat -> Nat -> Nat
150. Nat.sub : Nat -> Nat -> Int
151. Nat.toFloat : Nat -> Float
152. Nat.toInt : Nat -> Int
153. Nat.toText : Nat -> Text
154. Nat.trailingZeros : Nat -> Nat
155. Nat.xor : Nat -> Nat -> Nat
156. type Optional a
157. Optional.None : Optional a
158. Optional.Some : a -> Optional a
159. builtin type Request
160. type SeqView a b
161. SeqView.VElem : a -> b -> SeqView a b
162. SeqView.VEmpty : SeqView a b
163. unique type Test.Result
164. Test.Result.Fail : Text -> Result
165. Test.Result.Ok : Text -> Result
166. builtin type Text
167. Text.!= : Text -> Text -> Boolean
168. Text.++ : Text -> Text -> Text
169. Text.drop : Nat -> Text -> Text
170. Text.empty : Text
171. Text.eq : Text -> Text -> Boolean
172. Text.fromCharList : [Char] -> Text
173. Text.fromUtf8 : Bytes -> Either Failure Text
174. Text.gt : Text -> Text -> Boolean
175. Text.gteq : Text -> Text -> Boolean
176. Text.lt : Text -> Text -> Boolean
177. Text.lteq : Text -> Text -> Boolean
178. Text.size : Text -> Nat
179. Text.take : Nat -> Text -> Text
180. Text.toCharList : Text -> [Char]
181. Text.toUtf8 : Text -> Bytes
182. Text.uncons : Text -> Optional (Char, Text)
183. Text.unsnoc : Text -> Optional (Text, Char)
184. type Tuple a b
185. Tuple.Cons : a -> b -> Tuple a b
186. type Unit
187. Unit.Unit : ()
188. Universal.< : a -> a -> Boolean
189. Universal.<= : a -> a -> Boolean
190. Universal.== : a -> a -> Boolean
191. Universal.> : a -> a -> Boolean
192. Universal.>= : a -> a -> Boolean
193. Universal.compare : a -> a -> Int
194. builtin type Value
195. Value.dependencies : Value -> [Term]
196. Value.deserialize : Bytes -> Either Text Value
197. Value.load : Value ->{IO} Either [Term] a
198. Value.serialize : Value -> Bytes
199. Value.value : a -> Value
200. bug : a -> b
201. builtin type crypto.HashAlgorithm
202. crypto.HashAlgorithm.Blake2b_256 : HashAlgorithm
203. crypto.HashAlgorithm.Blake2b_512 : HashAlgorithm
204. crypto.HashAlgorithm.Blake2s_256 : HashAlgorithm
205. crypto.HashAlgorithm.Sha2_256 : HashAlgorithm
206. crypto.HashAlgorithm.Sha2_512 : HashAlgorithm
207. crypto.HashAlgorithm.Sha3_256 : HashAlgorithm
208. crypto.HashAlgorithm.Sha3_512 : HashAlgorithm
209. crypto.hash : HashAlgorithm -> a -> Bytes
210. crypto.hashBytes : HashAlgorithm -> Bytes -> Bytes
211. crypto.hmac : HashAlgorithm -> Bytes -> a -> Bytes
212. crypto.hmacBytes : HashAlgorithm
111. unique type IsPropagated
112. IsPropagated.IsPropagated : IsPropagated
113. unique type IsTest
114. IsTest.IsTest : IsTest
115. unique type Link
116. builtin type Link.Term
117. Link.Term : Term -> Link
118. builtin type Link.Type
119. Link.Type : Type -> Link
120. builtin type List
121. List.++ : [a] -> [a] -> [a]
122. List.+: : a -> [a] -> [a]
123. List.:+ : [a] -> a -> [a]
124. List.at : Nat -> [a] -> Optional a
125. List.cons : a -> [a] -> [a]
126. List.drop : Nat -> [a] -> [a]
127. List.empty : [a]
128. List.size : [a] -> Nat
129. List.snoc : [a] -> a -> [a]
130. List.take : Nat -> [a] -> [a]
131. builtin type Nat
132. Nat.* : Nat -> Nat -> Nat
133. Nat.+ : Nat -> Nat -> Nat
134. Nat./ : Nat -> Nat -> Nat
135. Nat.and : Nat -> Nat -> Nat
136. Nat.complement : Nat -> Nat
137. Nat.drop : Nat -> Nat -> Nat
138. Nat.eq : Nat -> Nat -> Boolean
139. Nat.fromText : Text -> Optional Nat
140. Nat.gt : Nat -> Nat -> Boolean
141. Nat.gteq : Nat -> Nat -> Boolean
142. Nat.increment : Nat -> Nat
143. Nat.isEven : Nat -> Boolean
144. Nat.isOdd : Nat -> Boolean
145. Nat.leadingZeros : Nat -> Nat
146. Nat.lt : Nat -> Nat -> Boolean
147. Nat.lteq : Nat -> Nat -> Boolean
148. Nat.mod : Nat -> Nat -> Nat
149. Nat.or : Nat -> Nat -> Nat
150. Nat.popCount : Nat -> Nat
151. Nat.pow : Nat -> Nat -> Nat
152. Nat.shiftLeft : Nat -> Nat -> Nat
153. Nat.shiftRight : Nat -> Nat -> Nat
154. Nat.sub : Nat -> Nat -> Int
155. Nat.toFloat : Nat -> Float
156. Nat.toInt : Nat -> Int
157. Nat.toText : Nat -> Text
158. Nat.trailingZeros : Nat -> Nat
159. Nat.xor : Nat -> Nat -> Nat
160. type Optional a
161. Optional.None : Optional a
162. Optional.Some : a -> Optional a
163. builtin type Request
164. type SeqView a b
165. SeqView.VElem : a -> b -> SeqView a b
166. SeqView.VEmpty : SeqView a b
167. unique type Test.Result
168. Test.Result.Fail : Text -> Result
169. Test.Result.Ok : Text -> Result
170. builtin type Text
171. Text.!= : Text -> Text -> Boolean
172. Text.++ : Text -> Text -> Text
173. Text.drop : Nat -> Text -> Text
174. Text.empty : Text
175. Text.eq : Text -> Text -> Boolean
176. Text.fromCharList : [Char] -> Text
177. Text.fromUtf8 : Bytes -> Either Failure Text
178. Text.gt : Text -> Text -> Boolean
179. Text.gteq : Text -> Text -> Boolean
180. Text.lt : Text -> Text -> Boolean
181. Text.lteq : Text -> Text -> Boolean
182. Text.size : Text -> Nat
183. Text.take : Nat -> Text -> Text
184. Text.toCharList : Text -> [Char]
185. Text.toUtf8 : Text -> Bytes
186. Text.uncons : Text -> Optional (Char, Text)
187. Text.unsnoc : Text -> Optional (Text, Char)
188. type Tuple a b
189. Tuple.Cons : a -> b -> Tuple a b
190. type Unit
191. Unit.Unit : ()
192. Universal.< : a -> a -> Boolean
193. Universal.<= : a -> a -> Boolean
194. Universal.== : a -> a -> Boolean
195. Universal.> : a -> a -> Boolean
196. Universal.>= : a -> a -> Boolean
197. Universal.compare : a -> a -> Int
198. builtin type Value
199. Value.dependencies : Value -> [Term]
200. Value.deserialize : Bytes -> Either Text Value
201. Value.load : Value ->{IO} Either [Term] a
202. Value.serialize : Value -> Bytes
203. Value.value : a -> Value
204. bug : a -> b
205. builtin type crypto.HashAlgorithm
206. crypto.HashAlgorithm.Blake2b_256 : HashAlgorithm
207. crypto.HashAlgorithm.Blake2b_512 : HashAlgorithm
208. crypto.HashAlgorithm.Blake2s_256 : HashAlgorithm
209. crypto.HashAlgorithm.Sha2_256 : HashAlgorithm
210. crypto.HashAlgorithm.Sha2_512 : HashAlgorithm
211. crypto.HashAlgorithm.Sha3_256 : HashAlgorithm
212. crypto.HashAlgorithm.Sha3_512 : HashAlgorithm
213. crypto.hash : HashAlgorithm -> a -> Bytes
214. crypto.hashBytes : HashAlgorithm -> Bytes -> Bytes
215. crypto.hmac : HashAlgorithm -> Bytes -> a -> Bytes
216. crypto.hmacBytes : HashAlgorithm
-> Bytes
-> Bytes
-> Bytes
213. unique type io2.BufferMode
214. io2.BufferMode.BlockBuffering : BufferMode
215. io2.BufferMode.LineBuffering : BufferMode
216. io2.BufferMode.NoBuffering : BufferMode
217. io2.BufferMode.SizedBlockBuffering : Nat -> BufferMode
218. unique type io2.Failure
219. io2.Failure.Failure : Type -> Text -> Failure
220. unique type io2.FileMode
221. io2.FileMode.Append : FileMode
222. io2.FileMode.Read : FileMode
223. io2.FileMode.ReadWrite : FileMode
224. io2.FileMode.Write : FileMode
225. builtin type io2.Handle
226. builtin type io2.IO
227. io2.IO.clientSocket : Text
217. unique type io2.BufferMode
218. io2.BufferMode.BlockBuffering : BufferMode
219. io2.BufferMode.LineBuffering : BufferMode
220. io2.BufferMode.NoBuffering : BufferMode
221. io2.BufferMode.SizedBlockBuffering : Nat -> BufferMode
222. unique type io2.Failure
223. io2.Failure.Failure : Type -> Text -> Any -> Failure
224. unique type io2.FileMode
225. io2.FileMode.Append : FileMode
226. io2.FileMode.Read : FileMode
227. io2.FileMode.ReadWrite : FileMode
228. io2.FileMode.Write : FileMode
229. builtin type io2.Handle
230. builtin type io2.IO
231. io2.IO.clientSocket : Text
-> Text
->{IO} Either Failure Socket
228. io2.IO.closeFile : Handle ->{IO} Either Failure ()
229. io2.IO.closeSocket : Socket ->{IO} Either Failure ()
230. io2.IO.createDirectory : Text ->{IO} Either Failure ()
231. io2.IO.createTempDirectory : Text
232. io2.IO.closeFile : Handle ->{IO} Either Failure ()
233. io2.IO.closeSocket : Socket ->{IO} Either Failure ()
234. io2.IO.createDirectory : Text ->{IO} Either Failure ()
235. io2.IO.createTempDirectory : Text
->{IO} Either Failure Text
232. io2.IO.delay : Nat ->{IO} Either Failure ()
233. io2.IO.fileExists : Text ->{IO} Either Failure Boolean
234. io2.IO.forkComp : '{IO} Either Failure a ->{IO} ThreadId
235. io2.IO.getBuffering : Handle
236. io2.IO.delay : Nat ->{IO} Either Failure ()
237. io2.IO.fileExists : Text ->{IO} Either Failure Boolean
238. io2.IO.forkComp : '{IO} a ->{IO} ThreadId
239. io2.IO.getBuffering : Handle
->{IO} Either Failure BufferMode
236. io2.IO.getBytes : Handle
240. io2.IO.getBytes : Handle
-> Nat
->{IO} Either Failure Bytes
237. io2.IO.getCurrentDirectory : '{IO} Either Failure Text
238. io2.IO.getFileSize : Text ->{IO} Either Failure Nat
239. io2.IO.getFileTimestamp : Text ->{IO} Either Failure Nat
240. io2.IO.getTempDirectory : '{IO} Either Failure Text
241. io2.IO.handlePosition : Handle ->{IO} Either Failure Int
242. io2.IO.isDirectory : Text ->{IO} Either Failure Boolean
243. io2.IO.isFileEOF : Handle ->{IO} Either Failure Boolean
244. io2.IO.isFileOpen : Handle ->{IO} Either Failure Boolean
245. io2.IO.isSeekable : Handle ->{IO} Either Failure Boolean
246. io2.IO.kill : ThreadId ->{IO} Either Failure ()
247. io2.IO.listen : Socket ->{IO} Either Failure ()
248. io2.IO.openFile : Text
241. io2.IO.getCurrentDirectory : '{IO} Either Failure Text
242. io2.IO.getFileSize : Text ->{IO} Either Failure Nat
243. io2.IO.getFileTimestamp : Text ->{IO} Either Failure Nat
244. io2.IO.getTempDirectory : '{IO} Either Failure Text
245. io2.IO.handlePosition : Handle ->{IO} Either Failure Nat
246. io2.IO.isDirectory : Text ->{IO} Either Failure Boolean
247. io2.IO.isFileEOF : Handle ->{IO} Either Failure Boolean
248. io2.IO.isFileOpen : Handle ->{IO} Either Failure Boolean
249. io2.IO.isSeekable : Handle ->{IO} Either Failure Boolean
250. io2.IO.kill : ThreadId ->{IO} Either Failure ()
251. io2.IO.listen : Socket ->{IO} Either Failure ()
252. io2.IO.openFile : Text
-> FileMode
->{IO} Either Failure Handle
249. io2.IO.putBytes : Handle
253. io2.IO.putBytes : Handle
-> Bytes
->{IO} Either Failure ()
250. io2.IO.removeDirectory : Text ->{IO} Either Failure ()
251. io2.IO.removeFile : Text ->{IO} Either Failure ()
252. io2.IO.renameDirectory : Text
254. io2.IO.removeDirectory : Text ->{IO} Either Failure ()
255. io2.IO.removeFile : Text ->{IO} Either Failure ()
256. io2.IO.renameDirectory : Text
-> Text
->{IO} Either Failure ()
253. io2.IO.renameFile : Text -> Text ->{IO} Either Failure ()
254. io2.IO.seekHandle : Handle
257. io2.IO.renameFile : Text -> Text ->{IO} Either Failure ()
258. io2.IO.seekHandle : Handle
-> SeekMode
-> Int
->{IO} Either Failure ()
255. io2.IO.serverSocket : Text
259. io2.IO.serverSocket : Optional Text
-> Text
->{IO} Either Failure Socket
256. io2.IO.setBuffering : Handle
260. io2.IO.setBuffering : Handle
-> BufferMode
->{IO} Either Failure ()
257. io2.IO.setCurrentDirectory : Text
261. io2.IO.setCurrentDirectory : Text
->{IO} Either Failure ()
258. io2.IO.socketAccept : Socket ->{IO} Either Failure Socket
259. io2.IO.socketReceive : Socket
262. io2.IO.socketAccept : Socket ->{IO} Either Failure Socket
263. io2.IO.socketPort : Socket ->{IO} Either Failure Nat
264. io2.IO.socketReceive : Socket
-> Nat
->{IO} Either Failure Bytes
260. io2.IO.socketSend : Socket
265. io2.IO.socketSend : Socket
-> Bytes
->{IO} Either Failure ()
261. io2.IO.stdHandle : StdHandle -> Handle
262. io2.IO.systemTime : '{IO} Either Failure Nat
263. unique type io2.IOError
264. io2.IOError.AlreadyExists : IOError
265. io2.IOError.EOF : IOError
266. io2.IOError.IllegalOperation : IOError
267. io2.IOError.NoSuchThing : IOError
268. io2.IOError.PermissionDenied : IOError
269. io2.IOError.ResourceBusy : IOError
270. io2.IOError.ResourceExhausted : IOError
271. io2.IOError.UserError : IOError
272. builtin type io2.MVar
273. io2.MVar.isEmpty : MVar a ->{IO} Boolean
274. io2.MVar.new : a ->{IO} MVar a
275. io2.MVar.newEmpty : '{IO} MVar a
276. io2.MVar.put : MVar a -> a ->{IO} Either Failure ()
277. io2.MVar.read : MVar a ->{IO} Either Failure a
278. io2.MVar.swap : MVar a -> a ->{IO} Either Failure a
279. io2.MVar.take : MVar a ->{IO} Either Failure a
280. io2.MVar.tryPut : MVar a -> a ->{IO} Boolean
281. io2.MVar.tryRead : MVar a ->{IO} Optional a
282. io2.MVar.tryTake : MVar a ->{IO} Optional a
283. unique type io2.SeekMode
284. io2.SeekMode.AbsoluteSeek : SeekMode
285. io2.SeekMode.RelativeSeek : SeekMode
286. io2.SeekMode.SeekFromEnd : SeekMode
287. builtin type io2.Socket
288. unique type io2.StdHandle
289. io2.StdHandle.StdErr : StdHandle
290. io2.StdHandle.StdIn : StdHandle
291. io2.StdHandle.StdOut : StdHandle
292. builtin type io2.ThreadId
293. builtin type io2.Tls
294. builtin type io2.Tls.ClientConfig
295. io2.Tls.Config.defaultClient : Text
266. io2.IO.stdHandle : StdHandle -> Handle
267. io2.IO.systemTime : '{IO} Either Failure Nat
268. unique type io2.IOError
269. io2.IOError.AlreadyExists : IOError
270. io2.IOError.EOF : IOError
271. io2.IOError.IllegalOperation : IOError
272. io2.IOError.NoSuchThing : IOError
273. io2.IOError.PermissionDenied : IOError
274. io2.IOError.ResourceBusy : IOError
275. io2.IOError.ResourceExhausted : IOError
276. io2.IOError.UserError : IOError
277. builtin type io2.IOFailure##IOFailure
278. unique type io2.IOFailure#gro
279. builtin type io2.MVar
280. io2.MVar.isEmpty : MVar a ->{IO} Boolean
281. io2.MVar.new : a ->{IO} MVar a
282. io2.MVar.newEmpty : '{IO} MVar a
283. io2.MVar.put : MVar a -> a ->{IO} Either Failure ()
284. io2.MVar.read : MVar a ->{IO} Either Failure a
285. io2.MVar.swap : MVar a -> a ->{IO} Either Failure a
286. io2.MVar.take : MVar a ->{IO} Either Failure a
287. io2.MVar.tryPut : MVar a -> a ->{IO} Boolean
288. io2.MVar.tryRead : MVar a ->{IO} Optional a
289. io2.MVar.tryTake : MVar a ->{IO} Optional a
290. builtin type io2.STM
291. io2.STM.atomically : '{STM} a ->{IO} a
292. io2.STM.retry : '{STM} a
293. unique type io2.SeekMode
294. io2.SeekMode.AbsoluteSeek : SeekMode
295. io2.SeekMode.RelativeSeek : SeekMode
296. io2.SeekMode.SeekFromEnd : SeekMode
297. builtin type io2.Socket
298. unique type io2.StdHandle
299. io2.StdHandle.StdErr : StdHandle
300. io2.StdHandle.StdIn : StdHandle
301. io2.StdHandle.StdOut : StdHandle
302. io2.TLS.ClientConfig.ciphers.set : [##Tls.Cipher]
-> ClientConfig
-> ClientConfig
303. builtin type io2.TVar
304. io2.TVar.new : a ->{STM} TVar a
305. io2.TVar.newIO : a ->{IO} TVar a
306. io2.TVar.read : TVar a ->{STM} a
307. io2.TVar.readIO : TVar a ->{IO} a
308. io2.TVar.swap : TVar a -> a ->{STM} a
309. io2.TVar.write : TVar a -> a ->{STM} ()
310. builtin type io2.ThreadId
311. builtin type io2.Tls
312. builtin type io2.Tls.ClientConfig
313. io2.Tls.ClientConfig.certificates.set : [SignedCert]
-> ClientConfig
-> ClientConfig
314. io2.Tls.ClientConfig.default : Text
-> Bytes
-> ClientConfig
296. io2.Tls.Config.defaultServer : ServerConfig
297. builtin type io2.Tls.ServerConfig
298. io2.Tls.handshake : Tls ->{IO} Either Failure ()
299. io2.Tls.newClient : ClientConfig
315. io2.Tls.ClientConfig.versions.set : [##Tls.Version]
-> ClientConfig
-> ClientConfig
316. builtin type io2.Tls.PrivateKey
317. builtin type io2.Tls.ServerConfig
318. io2.Tls.ServerConfig.certificates.set : [SignedCert]
-> ServerConfig
-> ServerConfig
319. io2.Tls.ServerConfig.ciphers.set : [##Tls.Cipher]
-> ServerConfig
-> ServerConfig
320. io2.Tls.ServerConfig.default : [SignedCert]
-> PrivateKey
-> ServerConfig
321. io2.Tls.ServerConfig.versions.set : [##Tls.Version]
-> ServerConfig
-> ServerConfig
322. builtin type io2.Tls.SignedCert
323. io2.Tls.decodeCert : Bytes -> Either Failure SignedCert
324. io2.Tls.decodePrivateKey : Bytes -> [PrivateKey]
325. io2.Tls.encodeCert : SignedCert -> Bytes
326. io2.Tls.encodePrivateKey : PrivateKey -> Bytes
327. io2.Tls.handshake : Tls ->{IO} Either Failure ()
328. io2.Tls.newClient : ClientConfig
-> Socket
->{IO} Either Failure Tls
300. io2.Tls.newServer : ServerConfig
329. io2.Tls.newServer : ServerConfig
-> Socket
->{IO} Either Failure Tls
301. io2.Tls.receive : Tls ->{IO} Either Failure Bytes
302. io2.Tls.send : Tls -> Bytes ->{IO} Either Failure ()
303. io2.Tls.terminate : Tls ->{IO} Either Failure ()
304. unique type io2.TlsFailure
305. todo : a -> b
330. io2.Tls.receive : Tls ->{IO} Either Failure Bytes
331. io2.Tls.send : Tls -> Bytes ->{IO} Either Failure ()
332. io2.Tls.terminate : Tls ->{IO} Either Failure ()
333. builtin type io2.TlsFailure##TlsFailure
334. unique type io2.TlsFailure#o6b
335. metadata.isPropagated : IsPropagated
336. metadata.isTest : IsTest
337. todo : a -> b
.builtin> alias.many 94-104 .mylib

93
unison-src/transcripts/builtins-merge.output.md
View File

@ -9,49 +9,54 @@ The `builtins.merge` command adds the known builtins to a `builtin` subnamespace
.tmp> ls builtin
1. Any (builtin type)
2. Any/ (1 definition)
3. Boolean (builtin type)
4. Boolean/ (1 definition)
5. Bytes (builtin type)
6. Bytes/ (17 definitions)
7. Char (builtin type)
8. Char/ (2 definitions)
9. Code (builtin type)
10. Code/ (6 definitions)
11. Debug/ (1 definition)
12. Doc (type)
13. Doc/ (6 definitions)
14. Either (type)
15. Either/ (2 definitions)
16. Float (builtin type)
17. Float/ (36 definitions)
18. Int (builtin type)
19. Int/ (29 definitions)
20. Link (type)
21. Link/ (4 definitions)
22. List (builtin type)
23. List/ (10 definitions)
24. Nat (builtin type)
25. Nat/ (28 definitions)
26. Optional (type)
27. Optional/ (2 definitions)
28. Request (builtin type)
29. SeqView (type)
30. SeqView/ (2 definitions)
31. Test/ (3 definitions)
32. Text (builtin type)
33. Text/ (17 definitions)
34. Tuple (type)
35. Tuple/ (1 definition)
36. Unit (type)
37. Unit/ (1 definition)
38. Universal/ (6 definitions)
39. Value (builtin type)
40. Value/ (5 definitions)
41. bug (a -> b)
42. crypto/ (12 definitions)
43. io2/ (92 definitions)
44. todo (a -> b)
1. Any (builtin type)
2. Any/ (1 definition)
3. Boolean (builtin type)
4. Boolean/ (1 definition)
5. Bytes (builtin type)
6. Bytes/ (17 definitions)
7. Char (builtin type)
8. Char/ (2 definitions)
9. Code (builtin type)
10. Code/ (6 definitions)
11. Debug/ (1 definition)
12. Doc (type)
13. Doc/ (6 definitions)
14. Either (type)
15. Either/ (2 definitions)
16. Float (builtin type)
17. Float/ (36 definitions)
18. Int (builtin type)
19. Int/ (29 definitions)
20. IsPropagated (type)
21. IsPropagated/ (1 definition)
22. IsTest (type)
23. IsTest/ (1 definition)
24. Link (type)
25. Link/ (4 definitions)
26. List (builtin type)
27. List/ (10 definitions)
28. Nat (builtin type)
29. Nat/ (28 definitions)
30. Optional (type)
31. Optional/ (2 definitions)
32. Request (builtin type)
33. SeqView (type)
34. SeqView/ (2 definitions)
35. Test/ (3 definitions)
36. Text (builtin type)
37. Text/ (17 definitions)
38. Tuple (type)
39. Tuple/ (1 definition)
40. Unit (type)
41. Unit/ (1 definition)
42. Universal/ (6 definitions)
43. Value (builtin type)
44. Value/ (5 definitions)
45. bug (a -> b)
46. crypto/ (12 definitions)
47. io2/ (118 definitions)
48. metadata/ (2 definitions)
49. todo (a -> b)
```

19
unison-src/transcripts/deleteReplacements.md
View File

@ -44,3 +44,22 @@ type Foo = Foo | Bar
.> view.patch
```
```unison
bar = 3
type bar = Foo
```
```ucm
.> add
```
```unison
type bar = Foo | Bar
```
```ucm
.> update
.> view.patch
.> delete.type-replacement bar
.> view.patch
```

72
unison-src/transcripts/deleteReplacements.output.md
View File

@ -130,3 +130,75 @@ type Foo = Foo | Bar
This patch is empty.
```
```unison
bar = 3
type bar = Foo
```
```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`:
type bar
bar : ##Nat
```
```ucm
.> add
⍟ I've added these definitions:
type bar
bar : ##Nat
```
```unison
type bar = Foo | Bar
```
```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 names already exist. You can `update` them to your
new definition:
type bar
(also named Foo)
```
```ucm
.> update
⍟ I've updated these names to your new definition:
type bar
(also named Foo)
.> view.patch
Edited Types: bar#568rsi7o3g -> Foo
Tip: To remove entries from a patch, use
delete.term-replacement or delete.type-replacement, as
appropriate.
.> delete.type-replacement bar
Done.
.> view.patch
Edited Types: bar#568rsi7o3g -> Foo
Tip: To remove entries from a patch, use
delete.term-replacement or delete.type-replacement, as
appropriate.
```

4
unison-src/transcripts/emptyCodebase.output.md
View File

@ -23,7 +23,7 @@ Technically, the definitions all exist, but they have no names. `builtins.merge`
.foo> ls
1. builtin/ (305 definitions)
1. builtin/ (337 definitions)
```
And for a limited time, you can get even more builtin goodies:
@ -35,7 +35,7 @@ And for a limited time, you can get even more builtin goodies:
.foo> ls
1. builtin/ (468 definitions)
1. builtin/ (494 definitions)
```
More typically, you'd start out by pulling `base.

17
unison-src/transcripts/isPropagated-exists.md
View File

@ -1,13 +1,13 @@
This transcript tests that UCM can always access the definition of
`IsPropagated`, which is used internally.
This transcript tests that UCM can always access the definition of
`IsPropagated`/`isPropagated`, which is used internally.
```ucm:hide
.> alias.term ##Nat.+ +
.> alias.type ##Nat Nat
```
y depends on x
```unison
`y` depends on `x`,
```unison:hide
x = 3
y = x + 1
```
@ -16,13 +16,13 @@ y = x + 1
.> add
```
```unison
so the `update` of `x` causes a propagated update of `y`, and UCM links the
`isPropagated` metadata to such resulting terms:
```unison:hide
x = 4
```
The `update` of `x` causes a propagated update of `y`, and UCM links the
`isPropagated` metadata to such resulting terms:
```ucm
.> update
.> links y
@ -37,4 +37,3 @@ by running `builtins.merge` to have UCM add names for them.
.> links y
.> view 1
```

36
unison-src/transcripts/isPropagated-exists.output.md
View File

@ -1,24 +1,12 @@
This transcript tests that UCM can always access the definition of
`IsPropagated`, which is used internally.
This transcript tests that UCM can always access the definition of
`IsPropagated`/`isPropagated`, which is used internally.
y depends on x
`y` depends on `x`,
```unison
x = 3
y = x + 1
```
```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`:
x : Nat
y : Nat
```
```ucm
.> add
@ -28,25 +16,13 @@ y = x + 1
y : Nat
```
so the `update` of `x` causes a propagated update of `y`, and UCM links the
`isPropagated` metadata to such resulting terms:
```unison
x = 4
```
```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 names already exist. You can `update` them to your
new definition:
x : Nat
```
The `update` of `x` causes a propagated update of `y`, and UCM links the
`isPropagated` metadata to such resulting terms:
```ucm
.> update

18
unison-src/transcripts/isTest-exists.md Normal file
View File

@ -0,0 +1,18 @@
This transcript tests that UCM can always access the definition of
`IsTest`/`isTest`, which is used internally.
```ucm
.> builtins.merge
```
```unison:hide
test> pass = [Ok "Passed"]
```
```ucm
.> add
.> links pass
.> display 1
```
The definition and type of `isTest` should exist.

33
unison-src/transcripts/isTest-exists.output.md Normal file
View File

@ -0,0 +1,33 @@
This transcript tests that UCM can always access the definition of
`IsTest`/`isTest`, which is used internally.
```ucm
.> builtins.merge
Done.
```
```unison
test> pass = [Ok "Passed"]
```
```ucm
.> add
⍟ I've added these definitions:
pass : [Result]
.> links pass
1. builtin.metadata.isTest : IsTest
Tip: Try using `display 1` to display the first result or
`view 1` to view its source.
.> display 1
IsTest
```
The definition and type of `isTest should exist.

90
unison-src/transcripts/merges.output.md
View File

@ -112,13 +112,13 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
Note: The most recent namespace hash is immediately below this
message.
⊙ #aokhru3upu
⊙ #rq3jrbg57r
- Deletes:
feature1.y
⊙ #07lio3nger
⊙ #64jmhloeht
+ Adds / updates:
@ -129,26 +129,26 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
Original name New name(s)
feature1.y master.y
⊙ #jh0ai3ctth
⊙ #ncr9hv1q57
+ Adds / updates:
feature1.y
⊙ #srgjtgfm9a
⊙ #bbcrond13i
> Moves:
Original name New name
x master.x
⊙ #p7j317tb68
⊙ #311k7aet5l
+ Adds / updates:
x
⊙ #ce9gjk322r
⊙ #e3bhlpkn5h
+ Adds / updates:
@ -193,19 +193,22 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
builtin.Int.shiftRight builtin.Int.signum
builtin.Int.toFloat builtin.Int.toText
builtin.Int.trailingZeros builtin.Int.truncate0
builtin.Int.xor builtin.Link builtin.Link.Term##Link.Term
builtin.Link.Term#quh#0 builtin.Link.Type##Link.Type
builtin.Link.Type#quh#1 builtin.List builtin.List.++
builtin.List.+: builtin.List.:+ builtin.List.at
builtin.List.cons builtin.List.drop builtin.List.empty
builtin.List.size builtin.List.snoc builtin.List.take
builtin.Nat builtin.Nat.* builtin.Nat.+ builtin.Nat./
builtin.Nat.and builtin.Nat.complement builtin.Nat.drop
builtin.Nat.eq builtin.Nat.fromText builtin.Nat.gt
builtin.Nat.gteq builtin.Nat.increment builtin.Nat.isEven
builtin.Nat.isOdd builtin.Nat.leadingZeros builtin.Nat.lt
builtin.Nat.lteq builtin.Nat.mod builtin.Nat.or
builtin.Nat.popCount builtin.Nat.pow builtin.Nat.shiftLeft
builtin.Int.xor builtin.IsPropagated
builtin.IsPropagated.IsPropagated builtin.IsTest
builtin.IsTest.IsTest builtin.Link
builtin.Link.Term##Link.Term builtin.Link.Term#quh#0
builtin.Link.Type##Link.Type builtin.Link.Type#quh#1
builtin.List builtin.List.++ builtin.List.+:
builtin.List.:+ builtin.List.at builtin.List.cons
builtin.List.drop builtin.List.empty builtin.List.size
builtin.List.snoc builtin.List.take builtin.Nat
builtin.Nat.* builtin.Nat.+ builtin.Nat./ builtin.Nat.and
builtin.Nat.complement builtin.Nat.drop builtin.Nat.eq
builtin.Nat.fromText builtin.Nat.gt builtin.Nat.gteq
builtin.Nat.increment builtin.Nat.isEven builtin.Nat.isOdd
builtin.Nat.leadingZeros builtin.Nat.lt builtin.Nat.lteq
builtin.Nat.mod builtin.Nat.or builtin.Nat.popCount
builtin.Nat.pow builtin.Nat.shiftLeft
builtin.Nat.shiftRight builtin.Nat.sub builtin.Nat.toFloat
builtin.Nat.toInt builtin.Nat.toText
builtin.Nat.trailingZeros builtin.Nat.xor builtin.Optional
@ -263,35 +266,54 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
builtin.io2.IO.renameFile builtin.io2.IO.seekHandle
builtin.io2.IO.serverSocket builtin.io2.IO.setBuffering
builtin.io2.IO.setCurrentDirectory
builtin.io2.IO.socketAccept builtin.io2.IO.socketReceive
builtin.io2.IO.socketSend builtin.io2.IO.stdHandle
builtin.io2.IO.systemTime builtin.io2.IOError
builtin.io2.IOError.AlreadyExists builtin.io2.IOError.EOF
builtin.io2.IO.socketAccept builtin.io2.IO.socketPort
builtin.io2.IO.socketReceive builtin.io2.IO.socketSend
builtin.io2.IO.stdHandle builtin.io2.IO.systemTime
builtin.io2.IOError builtin.io2.IOError.AlreadyExists
builtin.io2.IOError.EOF
builtin.io2.IOError.IllegalOperation
builtin.io2.IOError.NoSuchThing
builtin.io2.IOError.PermissionDenied
builtin.io2.IOError.ResourceBusy
builtin.io2.IOError.ResourceExhausted
builtin.io2.IOError.UserError builtin.io2.MVar
builtin.io2.MVar.isEmpty builtin.io2.MVar.new
builtin.io2.MVar.newEmpty builtin.io2.MVar.put
builtin.io2.MVar.read builtin.io2.MVar.swap
builtin.io2.MVar.take builtin.io2.MVar.tryPut
builtin.io2.MVar.tryRead builtin.io2.MVar.tryTake
builtin.io2.IOError.UserError
builtin.io2.IOFailure##IOFailure builtin.io2.IOFailure#gro
builtin.io2.MVar builtin.io2.MVar.isEmpty
builtin.io2.MVar.new builtin.io2.MVar.newEmpty
builtin.io2.MVar.put builtin.io2.MVar.read
builtin.io2.MVar.swap builtin.io2.MVar.take
builtin.io2.MVar.tryPut builtin.io2.MVar.tryRead
builtin.io2.MVar.tryTake builtin.io2.STM
builtin.io2.STM.atomically builtin.io2.STM.retry
builtin.io2.SeekMode builtin.io2.SeekMode.AbsoluteSeek
builtin.io2.SeekMode.RelativeSeek
builtin.io2.SeekMode.SeekFromEnd builtin.io2.Socket
builtin.io2.StdHandle builtin.io2.StdHandle.StdErr
builtin.io2.StdHandle.StdIn builtin.io2.StdHandle.StdOut
builtin.io2.TLS.ClientConfig.ciphers.set builtin.io2.TVar
builtin.io2.TVar.new builtin.io2.TVar.newIO
builtin.io2.TVar.read builtin.io2.TVar.readIO
builtin.io2.TVar.swap builtin.io2.TVar.write
builtin.io2.ThreadId builtin.io2.Tls
builtin.io2.Tls.ClientConfig
builtin.io2.Tls.Config.defaultClient
builtin.io2.Tls.Config.defaultServer
builtin.io2.Tls.ServerConfig builtin.io2.Tls.handshake
builtin.io2.Tls.ClientConfig.certificates.set
builtin.io2.Tls.ClientConfig.default
builtin.io2.Tls.ClientConfig.versions.set
builtin.io2.Tls.PrivateKey builtin.io2.Tls.ServerConfig
builtin.io2.Tls.ServerConfig.certificates.set
builtin.io2.Tls.ServerConfig.ciphers.set
builtin.io2.Tls.ServerConfig.default
builtin.io2.Tls.ServerConfig.versions.set
builtin.io2.Tls.SignedCert builtin.io2.Tls.decodeCert
builtin.io2.Tls.decodePrivateKey
builtin.io2.Tls.encodeCert
builtin.io2.Tls.encodePrivateKey builtin.io2.Tls.handshake
builtin.io2.Tls.newClient builtin.io2.Tls.newServer
builtin.io2.Tls.receive builtin.io2.Tls.send
builtin.io2.Tls.terminate builtin.io2.TlsFailure
builtin.todo
builtin.io2.Tls.terminate
builtin.io2.TlsFailure##TlsFailure
builtin.io2.TlsFailure#o6b builtin.metadata.isPropagated
builtin.metadata.isTest builtin.todo
□ #7asfbtqmoj (start of history)

10
unison-src/transcripts/reflog.output.md
View File

@ -59,16 +59,16 @@ y = 2
most recent, along with the command that got us there. Try:
`fork 2 .old`
`fork #40kdvebdr6 .old` to make an old namespace
`fork #90u1kgvkts .old` to make an old namespace
accessible again,
`reset-root #40kdvebdr6` to reset the root namespace and
`reset-root #90u1kgvkts` to reset the root namespace and
its history to that of the
specified namespace.
1. #ootu4soq9i : add
2. #40kdvebdr6 : add
3. #ce9gjk322r : builtins.merge
1. #q752mbqfhn : add
2. #90u1kgvkts : add
3. #e3bhlpkn5h : builtins.merge
4. #7asfbtqmoj : (initial reflogged namespace)
```

16
unison-src/transcripts/squash.output.md
View File

@ -13,7 +13,7 @@ Let's look at some examples. We'll start with a namespace with just the builtins
□ #m40j6qtka9 (start of history)
□ #1jd6dhvs8p (start of history)
.> fork builtin builtin2
@ -42,21 +42,21 @@ Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, th
Note: The most recent namespace hash is immediately below this
message.
⊙ #mlkvjjn8bi
⊙ #878lsss0qo
> Moves:
Original name New name
Nat.frobnicate Nat.+
⊙ #vo8lt4lm8m
⊙ #brr50llg52
> Moves:
Original name New name
Nat.+ Nat.frobnicate
□ #m40j6qtka9 (start of history)
□ #1jd6dhvs8p (start of history)
```
If we merge that back into `builtin`, we get that same chain of history:
@ -71,21 +71,21 @@ If we merge that back into `builtin`, we get that same chain of history:
Note: The most recent namespace hash is immediately below this
message.
⊙ #mlkvjjn8bi
⊙ #878lsss0qo
> Moves:
Original name New name
Nat.frobnicate Nat.+
⊙ #vo8lt4lm8m
⊙ #brr50llg52
> Moves:
Original name New name
Nat.+ Nat.frobnicate
□ #m40j6qtka9 (start of history)
□ #1jd6dhvs8p (start of history)
```
Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged:
@ -106,7 +106,7 @@ Let's try again, but using a `merge.squash` (or just `squash`) instead. The hist
□ #m40j6qtka9 (start of history)
□ #1jd6dhvs8p (start of history)
```
The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect.