Merge pull request #5854 from unisonweb/tls-certs

add some new builtins for TLS

Author: stew

parser-typechecker/src/Unison/Builtin.hs

@@ -936,7 +936,11 @@ ioBuiltins =
     ("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.ClientConfig.certificates.get", tlsClientConfig --> list tlsSignedCert),
     ("Tls.ServerConfig.certificates.set", list tlsSignedCert --> tlsServerConfig --> tlsServerConfig),
+    ("Tls.ServerConfig.certificates.get", tlsServerConfig --> list tlsSignedCert),
+    ("Tls.ClientConfig.validation.disableHostNameValidation", tlsClientConfig --> tlsClientConfig),
+    ("Tls.ClientConfig.validation.disableCertificateValidation", tlsClientConfig --> tlsClientConfig),
     ("Tls.ClientConfig.versions.set", list tlsVersion --> tlsClientConfig --> tlsClientConfig),
     ("Tls.ServerConfig.versions.set", list tlsVersion --> tlsServerConfig --> tlsServerConfig),
     ("Clock.internals.monotonic.v1", unit --> iof timeSpec),

unison-runtime/package.yaml

@@ -107,6 +107,7 @@ library:
     - crypton-x509
     - crypton-x509-store
     - crypton-x509-system
+    - crypton-x509-validation
 
 tests:
   runtime-tests:

unison-runtime/src/Unison/Runtime/Builtin.hs

@@ -1094,8 +1094,11 @@ declareForeigns = do
   declareForeign Tracked 2 Tls_ClientConfig_default
   declareForeign Tracked 2 Tls_ServerConfig_default
   declareForeign Tracked 2 Tls_ClientConfig_certificates_set
-
   declareForeign Tracked 2 Tls_ServerConfig_certificates_set
+  declareForeign Tracked 1 Tls_ClientConfig_certificates_get
+  declareForeign Tracked 1 Tls_ServerConfig_certificates_get
+  declareForeign Tracked 1 Tls_ClientConfig_validation_disableHostNameValidation
+  declareForeign Tracked 1 Tls_ClientConfig_validation_disableCertificateValidation
 
   declareForeign Tracked 1 TVar_new
 

unison-runtime/src/Unison/Runtime/Foreign/Function.hs

@@ -67,6 +67,7 @@ import Data.Vector qualified as Vector
 import Data.X509 qualified as X
 import Data.X509.CertificateStore qualified as X
 import Data.X509.Memory qualified as X
+import Data.X509.Validation as X
 import GHC.ByteOrder (ByteOrder (..), targetByteOrder)
 import GHC.Conc qualified as STM
 import GHC.Exts (Int (..), indexWord8ArrayAsWord16#, indexWord8ArrayAsWord32#, indexWord8ArrayAsWord64#, readWord8ArrayAsWord16#, readWord8ArrayAsWord32#, readWord8ArrayAsWord64#, writeWord8ArrayAsWord16#, writeWord8ArrayAsWord32#, writeWord8ArrayAsWord64#)
@@ -479,11 +480,28 @@ foreignCallHelper = \case
         updateClient certs client = client {TLS.clientShared = ((clientShared client) {TLS.sharedCAStore = certs})}
      in mkForeign $
           \(certs :: [X.SignedCertificate], params :: ClientParams) -> pure $ updateClient (X.makeCertificateStore certs) params
+  Tls_ClientConfig_certificates_get ->
+    mkForeign $
+      \(client :: TLS.ClientParams) -> pure $ X.listCertificates $ TLS.sharedCAStore $ TLS.clientShared client
+  Tls_ClientConfig_validation_disableHostNameValidation ->
+    let customChecks = X.defaultChecks {checkFQHN = False}
+        customHooks = def {TLS.onServerCertificate = X.validate X.HashSHA256 defaultHooks customChecks}
+     in mkForeign $
+          \(params :: TLS.ClientParams) ->
+            pure $ params {TLS.clientHooks = customHooks}
+  Tls_ClientConfig_validation_disableCertificateValidation ->
+    let customHooks = def {TLS.onServerCertificate = \_ _ _ _ -> pure []}
+     in mkForeign $
+          \(params :: TLS.ClientParams) ->
+            pure $ params {TLS.clientHooks = customHooks}
   Tls_ServerConfig_certificates_set ->
     let updateServer :: X.CertificateStore -> TLS.ServerParams -> TLS.ServerParams
         updateServer certs client = client {TLS.serverShared = ((serverShared client) {TLS.sharedCAStore = certs})}
      in mkForeign $
           \(certs :: [X.SignedCertificate], params :: ServerParams) -> pure $ updateServer (X.makeCertificateStore certs) params
+  Tls_ServerConfig_certificates_get ->
+    mkForeign $
+      \(params :: ServerParams) -> pure $ X.listCertificates $ TLS.sharedCAStore $ serverShared params
   TVar_new -> mkForeign $
     \(c :: Val) -> unsafeSTMToIO $ STM.newTVar c
   TVar_read -> mkForeign $

unison-runtime/src/Unison/Runtime/Foreign/Function/Type.hs

@@ -105,7 +105,11 @@ data ForeignFunc
   | Tls_ClientConfig_default
   | Tls_ServerConfig_default
   | Tls_ClientConfig_certificates_set
+  | Tls_ClientConfig_certificates_get
+  | Tls_ClientConfig_validation_disableHostNameValidation
+  | Tls_ClientConfig_validation_disableCertificateValidation
   | Tls_ServerConfig_certificates_set
+  | Tls_ServerConfig_certificates_get
   | TVar_new
   | TVar_read
   | TVar_write
@@ -407,6 +411,10 @@ foreignFuncBuiltinName = \case
   Tls_ServerConfig_default -> "Tls.ServerConfig.default"
   Tls_ClientConfig_certificates_set -> "Tls.ClientConfig.certificates.set"
   Tls_ServerConfig_certificates_set -> "Tls.ServerConfig.certificates.set"
+  Tls_ClientConfig_certificates_get -> "Tls.ClientConfig.certificates.get"
+  Tls_ServerConfig_certificates_get -> "Tls.ServerConfig.certificates.get"
+  Tls_ClientConfig_validation_disableCertificateValidation -> "Tls.ClientConfig.validation.disableCertificateValidation"
+  Tls_ClientConfig_validation_disableHostNameValidation -> "Tls.ClientConfig.validation.disableHostNameValidation"
   TVar_new -> "TVar.new"
   TVar_read -> "TVar.read"
   TVar_write -> "TVar.write"

unison-runtime/unison-runtime.cabal

@@ -120,6 +120,7 @@ library
     , crypton-x509
     , crypton-x509-store
     , crypton-x509-system
+    , crypton-x509-validation
     , cryptonite
     , data-default
     , data-memocombinators