mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-10 20:00:27 +03:00
Fix some of the TLS error handling
this is a partial fix for #2834 more will have to come. Now there is a cert there valid for 10 years and we load it and the private key with now problem, the call to decode the cert now is checking for exceptions and is properly handling the case when we successfully decode 0 certs. Now for some reason the last section of the transcript where we try to do handshaking, we are Segfaulting on the one of the sides of the handshake. I haven't figured out why yet.
This commit is contained in:
Stew O'Connor
parent
3336bbbb43
commit
e6fc1be1e6
@ -1850,11 +1850,14 @@ declareForeigns = do
|
||||
|
||||
let wrapFailure t = Failure Ty.tlsFailureRef (Util.Text.pack t) unitValue
|
||||
decoded :: Bytes.Bytes -> Either String PEM
|
||||
decoded bytes = fmap head $ pemParseLBS $ Bytes.toLazyByteString bytes
|
||||
decoded bytes = case pemParseLBS $ Bytes.toLazyByteString bytes of
|
||||
Right (pem : _) -> Right pem
|
||||
Right _ -> Left "no PEM found"
|
||||
Left l -> Left l
|
||||
asCert :: PEM -> Either String X.SignedCertificate
|
||||
asCert pem = X.decodeSignedCertificate $ pemContent pem
|
||||
in
|
||||
declareForeign "Tls.decodeCert.impl.v3" boxToEFBox . mkForeign $
|
||||
declareForeign "Tls.decodeCert.impl.v3" boxToEFBox . mkForeignTls $
|
||||
\(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes
|
||||
|
||||
declareForeign "Tls.encodeCert" boxDirect . mkForeign $
|
||||
|
||||
@ -23,6 +23,14 @@ Exception.toEither.handler = cases
|
||||
Exception.toEither : '{ε, Exception} a -> {ε} Either Failure a
|
||||
Exception.toEither a = handle !a with Exception.toEither.handler
|
||||
|
||||
Exception.unsafeRun! : '{g, Exception} a ->{g} a
|
||||
Exception.unsafeRun! e =
|
||||
h : Request {Exception} a -> a
|
||||
h = cases
|
||||
{raise fail -> _} -> bug fail
|
||||
{ a } -> a
|
||||
handle !e with h
|
||||
|
||||
structural ability Throw e where
|
||||
throw : e -> a
|
||||
|
||||
@ -31,6 +39,17 @@ List.all f = cases
|
||||
[] -> true
|
||||
h +: t -> f h && all f t
|
||||
|
||||
List.foldLeft : (b ->{g} a ->{g} b) -> b -> [a] ->{g} b
|
||||
List.foldLeft f b as =
|
||||
go b i =
|
||||
match List.at i as with
|
||||
None -> b
|
||||
Some a ->
|
||||
use Nat +
|
||||
go (f b a) (i + 1)
|
||||
go b 0
|
||||
|
||||
|
||||
List.filter: (a -> Boolean) -> [a] -> [a]
|
||||
List.filter f all =
|
||||
go acc = cases
|
||||
|
||||
@ -1,13 +1,42 @@
|
||||
# Tests for TLS builtins
|
||||
|
||||
```ucm:hide
|
||||
.> builtins.merge
|
||||
.> builtins.mergeio
|
||||
.> cd builtin
|
||||
.> load unison-src/transcripts-using-base/base.u
|
||||
.> add
|
||||
```
|
||||
|
||||
```unison:hide
|
||||
-- generated with:
|
||||
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 365 -out cert.pem
|
||||
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 3650 -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"
|
||||
join strs = List.foldLeft (a -> b -> b ++ a ++ "\n") "" strs
|
||||
|
||||
self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk1rv2Sx5XSK17BZSV4t7gwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjEwMTIyMDkxMTE3WhcNMjIwMTIyMDkxMTE3WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMGumn5L\nGMLP9pBBdPaEpetPeVncSTVVP+SA2t7cn9FTI1mNmdlcIzI2NngjFgrFwIAiAa18\nWmC+TNPk1EZkouVJfhjwdrJXeB0Rc72GrjD+L+z4jS04AmRW0eiVeuvOJnv/g1nA\nxNtuqE7mEceFu0Eim81LDx6XcBjcA+RDfv7Azd9u/J64bR6SgupNrfvVb79nuk6L\ntBdgYRrxgdI2S5EpjjoLhjyh5Yc6VJtAq7XnUYu7JC7vhud5wYM3goF3P2fLIoIJ\nOkGwmlSL07Ordymzkvx2c3XNQ2BpPJan2Q7e9tpNTwxjun91zuE0nymYa1KKJKzX\nG+eLheUIFcF6zFMCAwEAAaNTMFEwHQYDVR0OBBYEFFE3RQYASDWtwSdXL+qtQrjy\nH4SZMB8GA1UdIwQYMBaAFFE3RQYASDWtwSdXL+qtQrjyH4SZMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAH7D8W68cR0QvNNPugCY7lPvA/F94Qam\nwCC2A55edcagfjqFy77xx4Ljrd2TC19yiSzyeeJ+YuohbcipLce90BaaaiYq9aah\n5DICDCUhm1qbhJzqNB2Lqgl4aN+jRMeRVC+rpQBYBNmdPBqdv/k+T2uyghwmLWXe\n/AxCjCLA0zoYzOMytS86veD6CQbF5DpSTZx5dyZTeGhk2izhoM8cgiu+/7YncAbJ\nt7b7UT5Yu3+z1hAdUF5Q21bkEksGBC8UW0G0PMy8XNRMuMsz+2LC39u3u7QyX/+e\nuQGST3aCreV27zd0lrF8LHjwD2XcjVVzHy46VYQvf1r+6gatedDBjqc=\n-----END CERTIFICATE-----\n"
|
||||
self_signed_key_pem="-----BEGIN PRIVATE KEY-----\nMIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQDtV0Lqk9i5DKJG\ne5zwDFuxHxSxhOygCuq6Jl4xonsjl4hdvXxUUiuqxGGbv4x9HSvavpHwyriGiIRQ\noIjanWiNK9Jp6VDYWOvErnTG/+Rfm1vCoUKQvn8lDrD9knSPUoTz3Cz7JS8FE/rr\nFR3IRyXa0gpXmvIwX16SeCS/Lb/Le9o1HJh9DrkxVyoFq3zlX1OE0AVV0a014IDB\nNprqLITwiVzyDPQkP8rbJF9WPI5afzW8+3+v5UanIFknOOPaJl8pf3gmqI5g8fxk\n/SSMlPgnLd1Fi7h90gBygdpJw3do3/ZA1IOvmFQ+LXE1xtqU1Ay3f3At3DiJgTxP\n8mwBYdtdAgMBAAECggEBAMo85QRF3xIvtcchZeUWYrtWpKdvgMIPC1x7fSAGN69o\nXAakg+DF8/ebRyET435o8QmAAZOQ6hOZGEYrxPGj14cTpEQjT4RKoPwDO/al7c+Z\n7mK2TqZP7L+C+UXZGgFWa3vwTVPjp2FIWTMf1zTli1geSjnECkM1wLxGK+nL7fZQ\nesHXPkJJG5AqzA84bJ/fY5OQ/dfcCxnHEv5XpHPq6VFgXg7jtcNbr1R9EBiQfreN\nU7Hd38R77jYjL1fT71HwEUQ0cwavfxTu0jZFXJxEC7CC1J65QXUguZXLf9vwgSB0\nm0gZgeJlQ905bDJrxUcqCFxdROy/SndP6qFnJSCsfwECgYEA+2cld/WCieUGstJd\njsIrJ6f/e+uuOSTnGTtnsBX6KoiHdcg3sVVVK18xI9El9V+YX9SjN37XeGFe/Wzu\ngE3M4A3Jqz7cgdNj/PaKjqQwJWNbcJnL5ku6eQvcAIpc5gAZxXVCPIbY1ZpeYcsh\nMwr3cOEpQu8UVFBbn/OeJ1r07dECgYEA8a5J3Ls5PSxXq8NDrkAxt3vUJIWLGQQJ\nbV2aGDI2XP2N+vh2WML9rlFeyyBOeRxK9TsErVOaEeOcQZV97//fzIGxCU+SXyiC\nnVMXT2U1mzOu5qPfzLO5Ga4sunxqKDman6NM2IPw2NPA7zMWNQMEIHAerwYZzjm5\nB5tFcMA8e80CgYBgF8rwkTz2LD5lN5dfK8SHAeXbnfgYC4zxzg0R9zSJ8WmlkYQI\nGk/VpisIP7c8lO+PIZ3JZohBkSZXw71d+V7n/R0qgXqTfRNo62uGnidxAws+fOq8\n+hEql2feJQThPQScvvc0X26eJsUQqC3mbripwsacuPmSSKzc9Kds741TIQKBgQCd\nXnG2CytATAliTKlbY218HmOKzHJAfcJttk9KhhekAW5cB0F4lq98vHtPJOA0OFoO\nyLlI63EdSOpMQj1Y83IUxjYy699Rmx1BuAMrral0P/kZMYfe0QAsWp/BZpXxT2EB\npeG58l/3sBqnJsrFBgu/24H/UaeoAyoaa96Rhntb2QKBgQCSEkcUnzTvoUyMFN14\n8NttxOUZiSsCmgoXk6Rk2QKyCPsJocGS4BffGt3kOMcotz/0YsvM1TBBLB7vIaAy\nE1eWLBxK4yYeS8dKXwiCZn170yaJyjoBwZC1RgqQiKa5Y22Di7KjJoMa4Da8Tk4z\nFbE5dBApbLhvNTyQ7BHZxlfmdg==\n-----END PRIVATE KEY-----"
|
||||
|
||||
self_signed_cert_pem2 = join [
|
||||
"-----BEGIN CERTIFICATE-----",
|
||||
"MIIDVTCCAj2gAwIBAgIUdMNT5sYMfDJYH48Rh8LrlN+5wwgwDQYJKoZIhvcNAQEL",
|
||||
"BQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv",
|
||||
"bjELMAkGA1UEBhMCVVMwHhcNMjIwMTI0MjAxNzQ2WhcNMzIwMTIyMjAxNzQ2WjA6",
|
||||
"MRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw",
|
||||
"CQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAO1XQuqT",
|
||||
"2LkMokZ7nPAMW7EfFLGE7KAK6romXjGieyOXiF29fFRSK6rEYZu/jH0dK9q+kfDK",
|
||||
"uIaIhFCgiNqdaI0r0mnpUNhY68SudMb/5F+bW8KhQpC+fyUOsP2SdI9ShPPcLPsl",
|
||||
"LwUT+usVHchHJdrSClea8jBfXpJ4JL8tv8t72jUcmH0OuTFXKgWrfOVfU4TQBVXR",
|
||||
"rTXggME2muoshPCJXPIM9CQ/ytskX1Y8jlp/Nbz7f6/lRqcgWSc449omXyl/eCao",
|
||||
"jmDx/GT9JIyU+Cct3UWLuH3SAHKB2knDd2jf9kDUg6+YVD4tcTXG2pTUDLd/cC3c",
|
||||
"OImBPE/ybAFh210CAwEAAaNTMFEwHQYDVR0OBBYEFIfwxpuqtqxfCpaJGW32jH2J",
|
||||
"NbnYMB8GA1UdIwQYMBaAFIfwxpuqtqxfCpaJGW32jH2JNbnYMA8GA1UdEwEB/wQF",
|
||||
"MAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKh7EDo5XjSd6J190WGH3V8v49J0Sh8M",
|
||||
"P7APe1eL8eTkW1Vh7/QCOhRpkSnyCz2OxJjjeFVAsCO3aLxlRM6wQZQKXu45iM2U",
|
||||
"iPmv7ECS5xUn7LqRZd/JG1P6jvRPtBC1+oqA+NNDe27wzQp3rWyDG3pWZga8jJfW",
|
||||
"q+2xQ+s6GfzszxYZ/8MLn4zaUSymnOA+70yQ8czXkSO7MT2jJ7QDX8jxuJPZZARW",
|
||||
"uXeAYPRqD+b4MjdBATEtxgPTDWEi8gtfHFGUgInFhD4hOu+D3NLiE6lfR5brUqpQ",
|
||||
"Z4v8prCI8OjGSUx1dIJhqQHB5O0vdaxO0hkVdfqDVE93UrGBPwBRDlo=",
|
||||
"-----END CERTIFICATE-----"]
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
@ -19,7 +48,7 @@ self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk
|
||||
First lets make sure we can load our cert and private key
|
||||
|
||||
```unison
|
||||
test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
|
||||
test> match (decodeCert.impl (toUtf8 self_signed_cert_pem2) with
|
||||
Left (Failure _ t _) -> [Fail t]
|
||||
Right _ -> [Ok "succesfully decoded self_signed_pem"]
|
||||
|
||||
@ -39,7 +68,7 @@ serverThread portVar toSend = 'let
|
||||
go: '{io2.IO, Exception}()
|
||||
go = 'let
|
||||
-- load our self signed cert
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem)
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem2)
|
||||
|
||||
-- assume there is exactly one key decoded from our Bytes
|
||||
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
|
||||
@ -68,9 +97,13 @@ serverThread portVar toSend = 'let
|
||||
-- attach TLS to our TCP connection
|
||||
tls = newServer tlsconfig sock'
|
||||
|
||||
printLine "oooooooooooooooo"
|
||||
-- try to handshake the TLS connection with the client
|
||||
handshake tls
|
||||
match handshake.impl tls with
|
||||
Right _ -> ()
|
||||
Left (Failure _ t _) -> printLine ("error " ++ t)
|
||||
|
||||
printLine "iiiiiiiiiiiiiii"
|
||||
-- send our message over our tls channel
|
||||
send tls (toUtf8 toSend)
|
||||
terminate tls
|
||||
@ -94,17 +127,21 @@ testClient cert hostname portVar _ =
|
||||
port = take portVar
|
||||
|
||||
-- create a tcp connection with the server
|
||||
watch ("client connecting to port: " ++ (toText port)) ()
|
||||
sock = clientSocket "127.0.0.1" (Nat.toText port)
|
||||
|
||||
-- attach the TLS client to the TCP socket
|
||||
tls = newClient tlsconfig sock
|
||||
watch ("client connecting to port: " ++ (toText port)) ()
|
||||
|
||||
printLine "5555555555555555555"
|
||||
-- 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
|
||||
match handshake.impl tls with
|
||||
Right _ -> ()
|
||||
Left (Failure _ t _) -> printLine ("error " ++ t)
|
||||
|
||||
printLine "666666666666666666"
|
||||
-- receive a message from the server
|
||||
fromUtf8 (receive tls)
|
||||
|
||||
@ -114,14 +151,17 @@ testConnectSelfSigned _ =
|
||||
-- Server
|
||||
portVar = !MVar.newEmpty
|
||||
toSend = "12345"
|
||||
forkComp (serverThread portVar toSend)
|
||||
tid = forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem)
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem2)
|
||||
received = !(testClient (Some cert) "test.unison.cloud" portVar)
|
||||
|
||||
kill.impl tid
|
||||
|
||||
expectU "should have reaped what we've sown" toSend received
|
||||
|
||||
|
||||
runTest test
|
||||
|
||||
-- this client will trust whatever certs the system trusts
|
||||
@ -141,11 +181,12 @@ testCAReject _ =
|
||||
-- Server
|
||||
portVar = !MVar.newEmpty
|
||||
toSend = "12345"
|
||||
forkComp (serverThread portVar toSend)
|
||||
tid = forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
testClient None "test.unison.cloud" portVar |> toEither |> checkError |> emit
|
||||
|
||||
kill.impl tid
|
||||
|
||||
runTest test
|
||||
|
||||
@ -154,6 +195,7 @@ testCAReject _ =
|
||||
-- server presents an cert with unexpected hostname
|
||||
testCNReject : '{io2.IO}[Result]
|
||||
testCNReject _ =
|
||||
unsafeRun! '(printLine "aaaaaaaaaaaaaaaaaaaa")
|
||||
checkError : Either Failure a -> Result
|
||||
checkError = cases
|
||||
Right _ -> Fail "expected a handshake exception"
|
||||
@ -164,18 +206,23 @@ testCNReject _ =
|
||||
-- Server
|
||||
portVar = !MVar.newEmpty
|
||||
toSend = "12345"
|
||||
forkComp (serverThread portVar toSend)
|
||||
tid = forkComp (serverThread portVar toSend)
|
||||
unsafeRun! '(printLine "started tid")
|
||||
|
||||
|
||||
-- Client
|
||||
testClient None "wrong.host.name" portVar |> toEither |> checkError |> emit
|
||||
unsafeRun! '(printLine "started client")
|
||||
|
||||
kill.impl tid
|
||||
unsafeRun! '(printLine "killed")
|
||||
|
||||
runTest test
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
.> io.test testConnectSelfSigned
|
||||
--.> io.test testConnectSelfSigned
|
||||
.> io.test testCAReject
|
||||
.> io.test testCNReject
|
||||
--.> io.test testCNReject
|
||||
```
|
||||
|
||||
@ -2,12 +2,61 @@
|
||||
|
||||
```unison
|
||||
-- generated with:
|
||||
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 365 -out cert.pem
|
||||
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 3650 -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"
|
||||
join strs = List.foldLeft (a -> b -> b ++ a ++ "\n") "" strs
|
||||
|
||||
self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk1rv2Sx5XSK17BZSV4t7gwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjEwMTIyMDkxMTE3WhcNMjIwMTIyMDkxMTE3WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMGumn5L\nGMLP9pBBdPaEpetPeVncSTVVP+SA2t7cn9FTI1mNmdlcIzI2NngjFgrFwIAiAa18\nWmC+TNPk1EZkouVJfhjwdrJXeB0Rc72GrjD+L+z4jS04AmRW0eiVeuvOJnv/g1nA\nxNtuqE7mEceFu0Eim81LDx6XcBjcA+RDfv7Azd9u/J64bR6SgupNrfvVb79nuk6L\ntBdgYRrxgdI2S5EpjjoLhjyh5Yc6VJtAq7XnUYu7JC7vhud5wYM3goF3P2fLIoIJ\nOkGwmlSL07Ordymzkvx2c3XNQ2BpPJan2Q7e9tpNTwxjun91zuE0nymYa1KKJKzX\nG+eLheUIFcF6zFMCAwEAAaNTMFEwHQYDVR0OBBYEFFE3RQYASDWtwSdXL+qtQrjy\nH4SZMB8GA1UdIwQYMBaAFFE3RQYASDWtwSdXL+qtQrjyH4SZMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAH7D8W68cR0QvNNPugCY7lPvA/F94Qam\nwCC2A55edcagfjqFy77xx4Ljrd2TC19yiSzyeeJ+YuohbcipLce90BaaaiYq9aah\n5DICDCUhm1qbhJzqNB2Lqgl4aN+jRMeRVC+rpQBYBNmdPBqdv/k+T2uyghwmLWXe\n/AxCjCLA0zoYzOMytS86veD6CQbF5DpSTZx5dyZTeGhk2izhoM8cgiu+/7YncAbJ\nt7b7UT5Yu3+z1hAdUF5Q21bkEksGBC8UW0G0PMy8XNRMuMsz+2LC39u3u7QyX/+e\nuQGST3aCreV27zd0lrF8LHjwD2XcjVVzHy46VYQvf1r+6gatedDBjqc=\n-----END CERTIFICATE-----\n"
|
||||
self_signed_key_pem = join [
|
||||
"-----BEGIN PRIVATE KEY-----",
|
||||
"MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQDtV0Lqk9i5DKJG",
|
||||
"e5zwDFuxHxSxhOygCuq6Jl4xonsjl4hdvXxUUiuqxGGbv4x9HSvavpHwyriGiIRQ",
|
||||
"oIjanWiNK9Jp6VDYWOvErnTG/+Rfm1vCoUKQvn8lDrD9knSPUoTz3Cz7JS8FE/rr",
|
||||
"FR3IRyXa0gpXmvIwX16SeCS/Lb/Le9o1HJh9DrkxVyoFq3zlX1OE0AVV0a014IDB",
|
||||
"NprqLITwiVzyDPQkP8rbJF9WPI5afzW8+3+v5UanIFknOOPaJl8pf3gmqI5g8fxk",
|
||||
"/SSMlPgnLd1Fi7h90gBygdpJw3do3/ZA1IOvmFQ+LXE1xtqU1Ay3f3At3DiJgTxP",
|
||||
"8mwBYdtdAgMBAAECggEBAMo85QRF3xIvtcchZeUWYrtWpKdvgMIPC1x7fSAGN69o",
|
||||
"XAakg+DF8/ebRyET435o8QmAAZOQ6hOZGEYrxPGj14cTpEQjT4RKoPwDO/al7c+Z",
|
||||
"7mK2TqZP7L+C+UXZGgFWa3vwTVPjp2FIWTMf1zTli1geSjnECkM1wLxGK+nL7fZQ",
|
||||
"esHXPkJJG5AqzA84bJ/fY5OQ/dfcCxnHEv5XpHPq6VFgXg7jtcNbr1R9EBiQfreN",
|
||||
"U7Hd38R77jYjL1fT71HwEUQ0cwavfxTu0jZFXJxEC7CC1J65QXUguZXLf9vwgSB0",
|
||||
"m0gZgeJlQ905bDJrxUcqCFxdROy/SndP6qFnJSCsfwECgYEA+2cld/WCieUGstJd",
|
||||
"jsIrJ6f/e+uuOSTnGTtnsBX6KoiHdcg3sVVVK18xI9El9V+YX9SjN37XeGFe/Wzu",
|
||||
"gE3M4A3Jqz7cgdNj/PaKjqQwJWNbcJnL5ku6eQvcAIpc5gAZxXVCPIbY1ZpeYcsh",
|
||||
"Mwr3cOEpQu8UVFBbn/OeJ1r07dECgYEA8a5J3Ls5PSxXq8NDrkAxt3vUJIWLGQQJ",
|
||||
"bV2aGDI2XP2N+vh2WML9rlFeyyBOeRxK9TsErVOaEeOcQZV97//fzIGxCU+SXyiC",
|
||||
"nVMXT2U1mzOu5qPfzLO5Ga4sunxqKDman6NM2IPw2NPA7zMWNQMEIHAerwYZzjm5",
|
||||
"B5tFcMA8e80CgYBgF8rwkTz2LD5lN5dfK8SHAeXbnfgYC4zxzg0R9zSJ8WmlkYQI",
|
||||
"Gk/VpisIP7c8lO+PIZ3JZohBkSZXw71d+V7n/R0qgXqTfRNo62uGnidxAws+fOq8",
|
||||
"+hEql2feJQThPQScvvc0X26eJsUQqC3mbripwsacuPmSSKzc9Kds741TIQKBgQCd",
|
||||
"XnG2CytATAliTKlbY218HmOKzHJAfcJttk9KhhekAW5cB0F4lq98vHtPJOA0OFoO",
|
||||
"yLlI63EdSOpMQj1Y83IUxjYy699Rmx1BuAMrral0P/kZMYfe0QAsWp/BZpXxT2EB",
|
||||
"peG58l/3sBqnJsrFBgu/24H/UaeoAyoaa96Rhntb2QKBgQCSEkcUnzTvoUyMFN14",
|
||||
"8NttxOUZiSsCmgoXk6Rk2QKyCPsJocGS4BffGt3kOMcotz/0YsvM1TBBLB7vIaAy",
|
||||
"E1eWLBxK4yYeS8dKXwiCZn170yaJyjoBwZC1RgqQiKa5Y22Di7KjJoMa4Da8Tk4z",
|
||||
"FbE5dBApbLhvNTyQ7BHZxlfmdg==",
|
||||
"-----END PRIVATE KEY-----"]
|
||||
|
||||
self_signed_cert_pem2 = join [
|
||||
"-----BEGIN CERTIFICATE-----",
|
||||
"MIIDVTCCAj2gAwIBAgIUdMNT5sYMfDJYH48Rh8LrlN+5wwgwDQYJKoZIhvcNAQEL",
|
||||
"BQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv",
|
||||
"bjELMAkGA1UEBhMCVVMwHhcNMjIwMTI0MjAxNzQ2WhcNMzIwMTIyMjAxNzQ2WjA6",
|
||||
"MRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw",
|
||||
"CQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAO1XQuqT",
|
||||
"2LkMokZ7nPAMW7EfFLGE7KAK6romXjGieyOXiF29fFRSK6rEYZu/jH0dK9q+kfDK",
|
||||
"uIaIhFCgiNqdaI0r0mnpUNhY68SudMb/5F+bW8KhQpC+fyUOsP2SdI9ShPPcLPsl",
|
||||
"LwUT+usVHchHJdrSClea8jBfXpJ4JL8tv8t72jUcmH0OuTFXKgWrfOVfU4TQBVXR",
|
||||
"rTXggME2muoshPCJXPIM9CQ/ytskX1Y8jlp/Nbz7f6/lRqcgWSc449omXyl/eCao",
|
||||
"jmDx/GT9JIyU+Cct3UWLuH3SAHKB2knDd2jf9kDUg6+YVD4tcTXG2pTUDLd/cC3c",
|
||||
"OImBPE/ybAFh210CAwEAAaNTMFEwHQYDVR0OBBYEFIfwxpuqtqxfCpaJGW32jH2J",
|
||||
"NbnYMB8GA1UdIwQYMBaAFIfwxpuqtqxfCpaJGW32jH2JNbnYMA8GA1UdEwEB/wQF",
|
||||
"MAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKh7EDo5XjSd6J190WGH3V8v49J0Sh8M",
|
||||
"P7APe1eL8eTkW1Vh7/QCOhRpkSnyCz2OxJjjeFVAsCO3aLxlRM6wQZQKXu45iM2U",
|
||||
"iPmv7ECS5xUn7LqRZd/JG1P6jvRPtBC1+oqA+NNDe27wzQp3rWyDG3pWZga8jJfW",
|
||||
"q+2xQ+s6GfzszxYZ/8MLn4zaUSymnOA+70yQ8czXkSO7MT2jJ7QDX8jxuJPZZARW",
|
||||
"uXeAYPRqD+b4MjdBATEtxgPTDWEi8gtfHFGUgInFhD4hOu+D3NLiE6lfR5brUqpQ",
|
||||
"Z4v8prCI8OjGSUx1dIJhqQHB5O0vdaxO0hkVdfqDVE93UrGBPwBRDlo=",
|
||||
"-----END CERTIFICATE-----"]
|
||||
```
|
||||
|
||||
# Using an alternative certificate store
|
||||
@ -15,7 +64,7 @@ self_signed_cert_pem = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUZI9WPZk
|
||||
First lets make sure we can load our cert and private key
|
||||
|
||||
```unison
|
||||
test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
|
||||
test> match (decodeCert.impl (toUtf8 self_signed_cert_pem2) with
|
||||
Left (Failure _ t _) -> [Fail t]
|
||||
Right _ -> [Ok "succesfully decoded self_signed_pem"]
|
||||
|
||||
@ -34,7 +83,7 @@ test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
||||
1 | test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
|
||||
1 | test> match (decodeCert.impl (toUtf8 self_signed_cert_pem2) with
|
||||
|
||||
✅ Passed succesfully decoded self_signed_pem
|
||||
|
||||
@ -53,7 +102,7 @@ serverThread portVar toSend = 'let
|
||||
go: '{io2.IO, Exception}()
|
||||
go = 'let
|
||||
-- load our self signed cert
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem)
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem2)
|
||||
|
||||
-- assume there is exactly one key decoded from our Bytes
|
||||
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with k +: _ -> k
|
||||
@ -128,14 +177,17 @@ testConnectSelfSigned _ =
|
||||
-- Server
|
||||
portVar = !MVar.newEmpty
|
||||
toSend = "12345"
|
||||
forkComp (serverThread portVar toSend)
|
||||
tid = forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem)
|
||||
cert = decodeCert (toUtf8 self_signed_cert_pem2)
|
||||
received = !(testClient (Some cert) "test.unison.cloud" portVar)
|
||||
|
||||
kill.impl tid
|
||||
|
||||
expectU "should have reaped what we've sown" toSend received
|
||||
|
||||
|
||||
runTest test
|
||||
|
||||
-- this client will trust whatever certs the system trusts
|
||||
@ -155,11 +207,12 @@ testCAReject _ =
|
||||
-- Server
|
||||
portVar = !MVar.newEmpty
|
||||
toSend = "12345"
|
||||
forkComp (serverThread portVar toSend)
|
||||
tid = forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
testClient None "test.unison.cloud" portVar |> toEither |> checkError |> emit
|
||||
|
||||
kill.impl tid
|
||||
|
||||
runTest test
|
||||
|
||||
@ -178,11 +231,12 @@ testCNReject _ =
|
||||
-- Server
|
||||
portVar = !MVar.newEmpty
|
||||
toSend = "12345"
|
||||
forkComp (serverThread portVar toSend)
|
||||
tid = forkComp (serverThread portVar toSend)
|
||||
|
||||
-- Client
|
||||
testClient None "wrong.host.name" portVar |> toEither |> checkError |> emit
|
||||
|
||||
kill.impl tid
|
||||
|
||||
runTest test
|
||||
```
|
||||
@ -219,35 +273,7 @@ testCNReject _ =
|
||||
-> '{IO, Exception} Text
|
||||
testConnectSelfSigned : '{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.
|
||||
|
||||
--.> io.test testConnectSelfSigned
|
||||
--.> io.test testCAReject
|
||||
--.> io.test testCNReject
|
||||
```
|
||||
|
||||
Loading…
Reference in New Issue
Block a user