chain of two certificates - offline (identity) and online; switch certificates to v3 (#238)

src/Simplex/Messaging/Agent.hs

@@ -105,13 +105,13 @@ runSMPAgent t cfg = do
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
 runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, agentCertificateFile, agentPrivateKeyFile} = do
+runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, agentCertificateFile, agentPrivateKeyFile} = do
   runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
   where
     smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
     smpAgent _ = do
       -- tlsServerParams not in env to avoid breaking functional api w/t key and certificate generation
-      tlsServerParams <- liftIO $ loadTLSServerParams agentCertificateFile agentPrivateKeyFile
+      tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile agentCertificateFile agentPrivateKeyFile
       runTransportServer started tcpPort tlsServerParams $ \(h :: c) -> do
         liftIO . putLn h $ "Welcome to SMP agent v" <> currentSMPVersionStr
         c <- getAgentClient

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -32,6 +32,7 @@ data AgentConfig = AgentConfig
     smpCfg :: SMPClientConfig,
     retryInterval :: RetryInterval,
     reconnectInterval :: RetryInterval,
+    caCertificateFile :: FilePath,
     agentPrivateKeyFile :: FilePath,
     agentCertificateFile :: FilePath
   }
@@ -63,7 +64,8 @@ defaultAgentConfig =
             increaseAfter = 10_000_000,
             maxInterval = 10_000_000
           },
-      -- ! we do not generate these key and certificate
+      -- ! we do not generate these
+      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
       agentPrivateKeyFile = "/etc/opt/simplex-agent/agent.key",
       agentCertificateFile = "/etc/opt/simplex-agent/agent.crt"
     }

src/Simplex/Messaging/Server/Env/STM.hs

@@ -32,6 +32,7 @@ data ServerConfig = ServerConfig
     msgIdBytes :: Int,
     storeLog :: Maybe (StoreLog 'ReadMode),
     blockSize :: Int,
+    caCertificateFile :: FilePath,
     serverPrivateKeyFile :: FilePath,
     serverCertificateFile :: FilePath
   }
@@ -92,13 +93,13 @@ newSubscription = do
   return Sub {subThread = NoSub, delivered}
 
 newEnv :: forall m. (MonadUnliftIO m, MonadRandom m) => ServerConfig -> m Env
-newEnv config = do
+newEnv config@ServerConfig {caCertificateFile, serverCertificateFile, serverPrivateKeyFile} = do
   server <- atomically $ newServer (serverTbqSize config)
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
   idsDrg <- drgNew >>= newTVarIO
   s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
-  tlsServerParams <- liftIO $ loadTLSServerParams (serverCertificateFile config) (serverPrivateKeyFile config)
+  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile serverCertificateFile serverPrivateKeyFile
   return Env {config, server, queueStore, msgStore, idsDrg, storeLog = s', tlsServerParams}
   where
     restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)

src/Simplex/Messaging/Transport.hs

@@ -213,13 +213,13 @@ startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err
       ctx <- connectTLS clientParams sock
       getClientConnection ctx
 
-loadTLSServerParams :: FilePath -> FilePath -> IO T.ServerParams
-loadTLSServerParams certificateFile privateKeyFile =
+loadTLSServerParams :: FilePath -> FilePath -> FilePath -> IO T.ServerParams
+loadTLSServerParams caCertificateFile certificateFile privateKeyFile =
   fromCredential <$> loadServerCredential
   where
     loadServerCredential :: IO T.Credential
     loadServerCredential =
-      T.credentialLoadX509 certificateFile privateKeyFile >>= \case
+      T.credentialLoadX509Chain certificateFile [caCertificateFile] privateKeyFile >>= \case
         Right credential -> pure credential
         Left _ -> putStrLn "invalid credential" >> exitFailure
     fromCredential :: T.Credential -> T.ServerParams
@@ -288,8 +288,9 @@ mkTLSClientParams host port keyHash = do
 
 validateCertificateChain :: Maybe C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
 validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
-validateCertificateChain keyHash host port cc@(X.CertificateChain sc@[cert]) =
-  let fp = XV.getFingerprint cert X.HashSHA256
+validateCertificateChain _ _ _ (X.CertificateChain [_]) = pure [XV.EmptyChain]
+validateCertificateChain keyHash host port cc@(X.CertificateChain sc@[_, caCert]) =
+  let fp = XV.getFingerprint caCert X.HashSHA256
    in if maybe True (sameFingerprint fp) keyHash
         then x509validate
         else pure [XV.UnknownCA]
@@ -299,11 +300,11 @@ validateCertificateChain keyHash host port cc@(X.CertificateChain sc@[cert]) =
     x509validate = XV.validate X.HashSHA256 hooks checks certStore cache serviceID cc
       where
         hooks = XV.defaultHooks
-        checks = XV.defaultChecks {XV.checkLeafV3 = False} -- TODO create v3 certificates? https://stackoverflow.com/a/18242720
+        checks = XV.defaultChecks
         certStore = XS.makeCertificateStore sc
-        cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the offline certificate (TODO 2 certificates)
+        cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the identity certificate (ca.crt)
         serviceID = (host, port)
-validateCertificateChain _ _ _ (X.CertificateChain (_ : _)) = pure [XV.AuthorityTooDeep]
+validateCertificateChain _ _ _ _ = pure [XV.AuthorityTooDeep]
 
 supportedParameters :: T.Supported
 supportedParameters =