Merge pull request #66 from Start9Labs/spike/registration-timing

Spike/registration timing

agent/config/settings.yml

@@ -34,6 +34,6 @@ database:
   database: "start9_agent.sqlite3"
   poolsize: "_env:YESOD_SQLITE_POOLSIZE:10"
 
-app-mgr-version-spec: "=0.2.5"
+app-mgr-version-spec: "=0.2.6"
 
 #analytics: UA-YOURCODE

agent/migrations/0.2.5::0.2.6

@@ -0,0 +1 @@
+SELECT TRUE;

agent/package.yaml

@@ -1,5 +1,5 @@
 name: ambassador-agent
-version: 0.2.5
+version: 0.2.6
 
 default-extensions:
 - NoImplicitPrelude

agent/src/Application.hs

@@ -19,6 +19,7 @@ module Application
     , handler
     , runDb
     , getAgentCtx
+    , sleep
     )
 where
 
@@ -65,6 +66,7 @@ import           Lib.WebServer
 import           Model
 import           Settings
 import Lib.Background
+import qualified Daemon.SslRenew as SSLRenew
 
 appMain :: IO ()
 appMain = do
@@ -81,10 +83,10 @@ appMain = do
                 die . toS $ "Invalid Port: " <> n
         ["--git-hash"] -> do
             putStrLn @Text $embedGitRevision
-            exitWith ExitSuccess
+            exitSuccess
         ["--version"] -> do
             putStrLn @Text (show agentVersion)
-            exitWith ExitSuccess
+            exitSuccess
         _ -> pure settings
     createDirectoryIfMissing False (toS $ agentDataDirectory `relativeTo` appFilesystemBase settings')
 
@@ -187,6 +189,10 @@ startupSequence foundation = do
         void . forkIO . forever $ forkIO (runReaderT AppNotifications.fetchAndSave foundation) >> threadDelay 5_000_000
         withAgentVersionLog_ "App notifications refreshing"
 
+        withAgentVersionLog_ "Initializing SSL certificate renewal loop"
+        void . forkIO . forever $ forkIO (SSLRenew.renewSslLeafCert foundation) *> sleep 86_400
+        withAgentVersionLog_ "SSL Renewal daemon started"
+
         -- reloading avahi daemon
         -- DRAGONS! make sure this step happens AFTER system synchronization
         withAgentVersionLog_ "Publishing Agent to Avahi Daemon"
@@ -199,6 +205,10 @@ startupSequence foundation = do
     withAgentVersionLog_ "Listening for Self-Update Signal"
     waitForUpdateSignal foundation
 
+sleep :: Integer -> IO ()
+sleep n = let (full, r) = (n * 1_000_000) `divMod` (fromIntegral $ (maxBound :: Int)) in
+    replicateM_ (fromIntegral full) (threadDelay maxBound) *> threadDelay (fromIntegral r)
+
 --------------------------------------------------------------
 -- Functions for DevelMain.hs (a way to run the AgentCtx from GHCi)
 --------------------------------------------------------------

agent/src/Daemon/SslRenew.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Daemon.SslRenew where
+
+import           Startlude               hiding ( err )
+
+import           Data.String.Interpolate        ( i )
+import           System.Process                 ( system )
+
+import           Foundation
+import           Lib.SystemPaths
+import           Settings
+import           Lib.Ssl
+import           Daemon.ZeroConf                ( getStart9AgentHostname )
+import           Lib.Tor
+import           Control.Carrier.Lift
+import           System.Directory               ( renameDirectory
+                                                , removeDirectory
+                                                )
+import           Lib.SystemCtl
+import qualified Lib.Notifications             as Notifications
+import           Database.Persist.Sql           ( runSqlPool )
+import           Lib.Types.Core
+import           Constants
+
+renewSslLeafCert :: AgentCtx -> IO ()
+renewSslLeafCert ctx = do
+    let base = appFilesystemBase . appSettings $ ctx
+    hn  <- injectFilesystemBase base getStart9AgentHostname
+    tor <- injectFilesystemBase base getAgentHiddenServiceUrl
+    putStr @Text "SSL Renewal Required? "
+    needsRenew <- doesSslNeedRenew (toS $ entityCertPath hn `relativeTo` base)
+    print needsRenew
+    when needsRenew $ runM . injectFilesystemBase base $ do
+        intCaKeyPath   <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath
+        intCaConfPath  <- toS <$> getAbsoluteLocationFor intermediateCaOpenSslConfPath
+        intCaCertPath  <- toS <$> getAbsoluteLocationFor intermediateCaCertPath
+
+        sslDirTmp      <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> sslDirectory)
+        entKeyPathTmp  <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath hn)
+        entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath hn)
+        entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath hn)
+
+        (ec, out, err) <- writeLeafCert
+            DeriveCertificate { applicantConfPath = entConfPathTmp
+                              , applicantKeyPath  = entKeyPathTmp
+                              , applicantCertPath = entCertPathTmp
+                              , signingConfPath   = intCaConfPath
+                              , signingKeyPath    = intCaKeyPath
+                              , signingCertPath   = intCaCertPath
+                              , duration          = 365
+                              }
+            hn
+            tor
+        liftIO $ do
+            putStrLn @Text "openssl logs"
+            putStrLn @Text "exit code: "
+            print ec
+            putStrLn @String $ "stdout: " <> out
+            putStrLn @String $ "stderr: " <> err
+        case ec of
+            ExitSuccess -> pure ()
+            ExitFailure n ->
+                liftIO
+                    . void
+                    $ flip runSqlPool (appConnPool ctx)
+                    $ Notifications.emit (AppId "EmbassyOS") agentVersion
+                    $ Notifications.CertRenewFailed (ExitFailure n) out err
+        let sslDir = toS $ sslDirectory `relativeTo` base
+        liftIO $ removeDirectory sslDir
+        liftIO $ renameDirectory sslDirTmp sslDir
+        liftIO $ systemCtl RestartService "nginx" $> ()
+
+
+doesSslNeedRenew :: FilePath -> IO Bool
+doesSslNeedRenew cert = do
+    ec <- liftIO $ system [i|openssl x509 -checkend 2592000 -noout -in #{cert}|]
+    pure $ ec /= ExitSuccess

agent/src/Handler/Register.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 module Handler.Register where
 
@@ -55,7 +56,7 @@ postRegisterR = handleS9ErrT $ do
 
     -- install new ssl CA cert + nginx conf and restart nginx
     registerResCert <-
-        runM . handleS9ErrC . (>>= liftEither) . liftIO . runM . injectFilesystemBaseFromContext settings $ do
+        runM . handleS9ErrC . liftEither <=< liftIO . runM . injectFilesystemBaseFromContext settings $ do
             bootupHttpNginx
             runError @S9Error $ bootupSslNginx rsaKeyFileContents
 

agent/src/Handler/Register/Nginx.hs

@@ -5,6 +5,7 @@ module Handler.Register.Nginx where
 
 import           Startlude               hiding ( ask
                                                 , catchError
+                                                , err
                                                 )
 
 import           Control.Carrier.Error.Church
@@ -21,6 +22,7 @@ import           Lib.Synchronizers
 import           Lib.SystemPaths
 import           Lib.Tor
 import           System.Posix                   ( removeLink )
+import           Lib.SystemCtl
 
 -- Left error, Right CA cert for hmac signing
 bootupSslNginx :: (HasFilesystemBase sig m, Has (Error S9Error) sig m, Has (Lift IO) sig m, MonadIO m)
@@ -54,13 +56,13 @@ resetSslState = do
     traverse_
         (liftIO . removePathForcibly . toS . flip relativeTo base)
         [ rootCaKeyPath
-        , relBase $ (rootCaCertPath `relativeTo` "/") <> ".csr"
+        , relBase $ (rootCaCertPath `relativeTo` base) <> ".csr"
         , rootCaCertPath
         , intermediateCaKeyPath
-        , relBase $ (intermediateCaCertPath `relativeTo` "/") <> ".csr"
+        , relBase $ (intermediateCaCertPath `relativeTo` base) <> ".csr"
         , intermediateCaCertPath
         , entityKeyPath host
-        , relBase $ (entityCertPath host `relativeTo` "/") <> ".csr"
+        , relBase $ (entityCertPath host `relativeTo` base) <> ".csr"
         , entityCertPath host
         , entityConfPath host
         , nginxSitesAvailable nginxSslConf
@@ -74,10 +76,9 @@ resetSslState = do
             >>= traverse_ removePathForcibly
         writeFile (toS $ flip relativeTo base $ rootCaDirectory <> "/index.txt")         ""
         writeFile (toS $ flip relativeTo base $ intermediateCaDirectory <> "/index.txt") ""
-    _ <- liftIO $ try @SomeException . removeLink . toS $ (nginxSitesEnabled nginxSslConf) `relativeTo` base
+    _ <- liftIO $ try @SomeException . removeLink . toS $ nginxSitesEnabled nginxSslConf `relativeTo` base
     pure ()
 
-
 bootupHttpNginx :: (HasFilesystemBase sig m, MonadIO m) => m ()
 bootupHttpNginx = installAmbassadorUiNginxHTTP "start9-ambassador.conf"
 
@@ -156,3 +157,73 @@ writeSslKeyAndCert rsaKeyFileContents = do
         ExitFailure ec -> throwError $ OpenSslE "leaf" ec str1' str2'
 
     readSystemPath' rootCaCertPath
+
+replaceDerivativeCerts :: (HasFilesystemBase sig m, Has (Error S9Error) sig m, MonadIO m) => m ()
+replaceDerivativeCerts = do
+    hn             <- getStart9AgentHostname
+    tor            <- getAgentHiddenServiceUrl
+
+    caKeyPath      <- toS <$> getAbsoluteLocationFor rootCaKeyPath
+    caConfPath     <- toS <$> getAbsoluteLocationFor rootCaOpenSslConfPath
+    caCertPath     <- toS <$> getAbsoluteLocationFor rootCaCertPath
+
+    intCaKeyPath   <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath
+    intCaConfPath  <- toS <$> getAbsoluteLocationFor intermediateCaOpenSslConfPath
+    intCaCertPath  <- toS <$> getAbsoluteLocationFor intermediateCaCertPath
+
+    sslDirTmp      <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> sslDirectory)
+    entKeyPathTmp  <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath hn)
+    entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath hn)
+    entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath hn)
+    liftIO $ createDirectoryIfMissing True sslDirTmp
+    liftIO $ BS.writeFile entConfPathTmp (domain_CSR_CONF hn)
+
+    -- ensure duplicate certificates are acceptable
+    base <- Fused.ask @"filesystemBase"
+    liftIO $ BS.writeFile (toS $ (rootCaDirectory <> "index.txt.attr") `relativeTo` base) "unique_subject = no\n"
+    liftIO $ BS.writeFile (toS $ (intermediateCaDirectory <> "index.txt.attr") `relativeTo` base)
+                          "unique_subject = no\n"
+
+    (ec, out, err) <- writeIntermediateCert DeriveCertificate { applicantConfPath = intCaConfPath
+                                                              , applicantKeyPath  = intCaKeyPath
+                                                              , applicantCertPath = intCaCertPath
+                                                              , signingConfPath   = caConfPath
+                                                              , signingKeyPath    = caKeyPath
+                                                              , signingCertPath   = caCertPath
+                                                              , duration          = 3650
+                                                              }
+    liftIO $ do
+        putStrLn @Text "openssl logs"
+        putStrLn @Text "exit code: "
+        print ec
+        putStrLn @String $ "stdout: " <> out
+        putStrLn @String $ "stderr: " <> err
+    case ec of
+        ExitSuccess   -> pure ()
+        ExitFailure n -> throwError $ OpenSslE "leaf" n out err
+
+    (ec', out', err') <- writeLeafCert
+        DeriveCertificate { applicantConfPath = entConfPathTmp
+                          , applicantKeyPath  = entKeyPathTmp
+                          , applicantCertPath = entCertPathTmp
+                          , signingConfPath   = intCaConfPath
+                          , signingKeyPath    = intCaKeyPath
+                          , signingCertPath   = intCaCertPath
+                          , duration          = 365
+                          }
+        hn
+        tor
+    liftIO $ do
+        putStrLn @Text "openssl logs"
+        putStrLn @Text "exit code: "
+        print ec
+        putStrLn @String $ "stdout: " <> out'
+        putStrLn @String $ "stderr: " <> err'
+    case ec' of
+        ExitSuccess   -> pure ()
+        ExitFailure n -> throwError $ OpenSslE "leaf" n out' err'
+
+    sslDir <- toS <$> getAbsoluteLocationFor sslDirectory
+    liftIO $ removeDirectory sslDir
+    liftIO $ renameDirectory sslDirTmp sslDir
+    liftIO $ systemCtl RestartService "nginx" $> ()

agent/src/Lib/Notifications.hs

@@ -19,8 +19,8 @@ emit :: MonadIO m => AppId -> Version -> AgentNotification -> SqlPersistT m (Ent
 emit appId version ty = do
     uuid <- liftIO nextRandom
     now  <- liftIO getCurrentTime
-    let k = (NotificationKey uuid)
+    let k = NotificationKey uuid
-    let v = (Notification now Nothing appId version (toCode ty) (toTitle ty) (toMessage appId version ty))
+    let v = Notification now Nothing appId version (toCode ty) (toTitle ty) (toMessage appId version ty)
     insertKey k v
     putStrLn $ toMessage appId version ty
     pure $ Entity k v
@@ -42,6 +42,7 @@ data AgentNotification =
     | RestoreFailed S9Error
     | RestartFailed S9Error
     | DockerFuckening
+    | CertRenewFailed ExitCode String String
 
 -- CODES
 -- RULES:
@@ -54,6 +55,7 @@ data AgentNotification =
 -- The second digit indicates where the error was originated from as follows
 -- 0: Originates from Agent
 -- 1: Originates from App (Not presently used)
+-- 2: Originates from Agent ABOUT THE AGENT
 --
 -- The remaining section of the code may be as long as you want but must be at least one digit
 -- EXAMPLES:
@@ -78,6 +80,7 @@ toCode (InstallFailedS9Error _)        = "303"
 toCode (BackupFailed         _)        = "304"
 toCode (RestoreFailed        _)        = "305"
 toCode (RestartFailed        _)        = "306"
+toCode CertRenewFailed{}               = "320"
 
 toTitle :: AgentNotification -> Text
 toTitle InstallSuccess                  = "Install succeeded"
@@ -90,6 +93,7 @@ toTitle (BackupFailed                _) = "Backup failed"
 toTitle (RestoreFailed               _) = "Restore failed"
 toTitle (RestartFailed               _) = "Restart failed"
 toTitle DockerFuckening                 = "App unstoppable"
+toTitle CertRenewFailed{}               = "Embassy Certificate Renewal Failed"
 
 toMessage :: AppId -> Version -> AgentNotification -> Text
 toMessage appId version InstallSuccess = [i|Successfully installed #{appId} at version #{version}|]
@@ -107,3 +111,10 @@ toMessage appId _version (BackupFailed  reason) = [i|Failed to back up #{appId}:
 toMessage appId _version (RestoreFailed reason) = [i|Failed to restore #{appId}: #{errorMessage $ toError reason}|]
 toMessage appId _version (RestartFailed reason) =
     [i|Failed to restart #{appId}: #{errorMessage $ toError reason}. Please manually restart|]
+toMessage _ version (CertRenewFailed ec o e) = [i|Failed to renew SSL Certificates for EmbassyOS (#{version})
+ExitCode: #{ec}
+Stdout:
+#{o}
+Stderr:
+#{e}
+|]

agent/src/Lib/Ssl.hs

@@ -1,6 +1,17 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE QuasiQuotes #-}
-module Lib.Ssl where
+module Lib.Ssl
+    ( DeriveCertificate(..)
+    , root_CA_CERT_NAME
+    , writeRootCaCert
+    , writeIntermediateCert
+    , domain_CSR_CONF
+    , writeLeafCert
+    , root_CA_OPENSSL_CONF
+    , intermediate_CA_OPENSSL_CONF
+    , segment
+    )
+where
 
 import           Startlude
 
@@ -295,7 +306,7 @@ data DeriveCertificate = DeriveCertificate
 writeIntermediateCert :: MonadIO m => DeriveCertificate -> m (ExitCode, String, String)
 writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do
     -- openssl genrsa -out dump/int.key 4096
-    segment $ openssl [i|genrsa -out #{applicantKeyPath} 4096|]
+    segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|]
     -- openssl req -new -config dump/int-csr.conf -key dump/int.key -nodes -out dump/int.csr
     segment $ openssl [i|req -new
                              -config #{applicantConfPath}
@@ -317,7 +328,7 @@ writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do
 
 writeLeafCert :: MonadIO m => DeriveCertificate -> Text -> Text -> m (ExitCode, String, String)
 writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $ do
-    segment $ openssl [i|genrsa -out #{applicantKeyPath} 4096|]
+    segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|]
     segment $ openssl [i|req -config #{applicantConfPath}
                              -key #{applicantKeyPath}
                              -new
@@ -336,11 +347,11 @@ writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $
                             |]
     liftIO $ readFile signingCertPath >>= appendFile applicantCertPath
 
-openssl :: Text -> IO (ExitCode, String, String)
+openssl :: MonadIO m => Text -> m (ExitCode, String, String)
-openssl = ($ "") . readProcessWithExitCode "openssl" . fmap toS . words
+openssl = liftIO . ($ "") . readProcessWithExitCode "openssl" . fmap toS . words
 {-# INLINE openssl #-}
 
-interpret :: ExceptT ExitCode (StateT (String, String) IO) () -> IO (ExitCode, String, String)
+interpret :: MonadIO m => ExceptT ExitCode (StateT (String, String) m) () -> m (ExitCode, String, String)
 interpret = fmap (over _1 (either id (const ExitSuccess)) . regroup) . flip runStateT ("", "") . runExceptT
 {-# INLINE interpret #-}
 
@@ -348,8 +359,8 @@ regroup :: (a, (b, c)) -> (a, b, c)
 regroup (a, (b, c)) = (a, b, c)
 {-# INLINE regroup #-}
 
-segment :: IO (ExitCode, String, String) -> ExceptT ExitCode (StateT (String, String) IO) ()
+segment :: MonadIO m => m (ExitCode, String, String) -> ExceptT ExitCode (StateT (String, String) m) ()
-segment action = liftIO action >>= \case
+segment action = (lift . lift) action >>= \case
     (ExitSuccess, o, e) -> modify (bimap (<> o) (<> e))
     (ec         , o, e) -> modify (bimap (<> o) (<> e)) *> throwE ec
 {-# INLINE segment #-}

agent/src/Lib/Synchronizers.hs

@@ -61,6 +61,8 @@ import           Settings
 import           Util.File
 import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
 import           Daemon.ZeroConf                ( getStart9AgentHostname )
+import qualified Data.Text                     as T
+import           Handler.Register.Nginx         ( replaceDerivativeCerts )
 
 
 data Synchronizer = Synchronizer
@@ -87,16 +89,16 @@ parseKernelVersion = do
     major' <- decimal
     minor' <- char '.' *> decimal
     patch' <- char '.' *> decimal
-    arch   <- string "-v7l+" *> pure ArmV7 <|> string "-v8+" *> pure ArmV8
+    arch   <- string "-v7l+" $> ArmV7 <|> string "-v8+" $> ArmV8
     pure $ KernelVersion (Version (major', minor', patch', 0)) arch
 
 synchronizer :: Synchronizer
-synchronizer = sync_0_2_5
+synchronizer = sync_0_2_6
 {-# INLINE synchronizer #-}
 
-sync_0_2_5 :: Synchronizer
+sync_0_2_6 :: Synchronizer
-sync_0_2_5 = Synchronizer
+sync_0_2_6 = Synchronizer
-    "0.2.5"
+    "0.2.6"
     [ syncCreateAgentTmp
     , syncCreateSshDir
     , syncRemoveAvahiSystemdDependency
@@ -141,7 +143,7 @@ syncCreateSshDir = SyncOp "Create SSH directory" check migrate False
 syncRemoveAvahiSystemdDependency :: SyncOp
 syncRemoveAvahiSystemdDependency = SyncOp "Remove Avahi Systemd Dependency" check migrate False
     where
-        wanted = decodeUtf8 $ $(embedFile "config/agent.service")
+        wanted = decodeUtf8 $(embedFile "config/agent.service")
         check  = do
             base    <- asks $ appFilesystemBase . appSettings
             content <- liftIO $ readFile (toS $ agentServicePath `relativeTo` base)
@@ -172,7 +174,7 @@ sync32BitKernel = SyncOp "32 Bit Kernel Switch" check migrate True
         check          = do
             settings <- asks appSettings
             cfg      <- injectFilesystemBaseFromContext settings getBootCfgPath
-            liftIO . run $ fmap isNothing $ (shell [i|grep "arm_64bit=0" #{cfg} || true|] $| conduit await)
+            liftIO . run $ isNothing <$> (shell [i|grep "arm_64bit=0" #{cfg} || true|] $| conduit await)
         migrate = do
             base <- asks $ appFilesystemBase . appSettings
             let tmpFile = bootConfigTempPath `relativeTo` base
@@ -234,9 +236,9 @@ syncWriteConf name contents' confLocation = SyncOp [i|Write #{name} Conf|] check
                 liftIO
                 $       (Just <$> readFile (toS $ confLocation `relativeTo` base))
                 `catch` (\(e :: IOException) -> if isDoesNotExistError e then pure Nothing else throwIO e)
-            case conf of
+            pure $ case conf of
-                Nothing -> pure True
+                Nothing -> True
-                Just co -> pure $ if co == contents then False else True
+                Just co -> co /= contents
         migrate = do
             base <- asks $ appFilesystemBase . appSettings
             void . liftIO $ createDirectoryIfMissing True (takeDirectory (toS $ confLocation `relativeTo` base))
@@ -330,7 +332,7 @@ syncInstallAmbassadorUI = SyncOp "Install Ambassador UI" check migrate False
         streamUntar root stream = Conduit.runConduit $ Conduit.fromBStream stream .| Conduit.untar \f -> do
             let path = toS . (toS root </>) . joinPath . drop 1 . splitPath . B8.unpack . Conduit.filePath $ f
             print path
-            if (Conduit.fileType f == Conduit.FTDirectory)
+            if Conduit.fileType f == Conduit.FTDirectory
                 then liftIO $ createDirectoryIfMissing True path
                 else Conduit.sinkFile path
 
@@ -372,8 +374,8 @@ installAmbassadorUiNginx mSslOverrides fileName = do
     void . liftIO $ systemCtl RestartService "nginx"
     where
         ambassadorUiClientManifiest b = toS $ (ambassadorUiPath <> "/client-manifest.yaml") `relativeTo` b
-        nginxAvailableConf b = toS $ (nginxSitesAvailable fileName) `relativeTo` b
+        nginxAvailableConf b = toS $ nginxSitesAvailable fileName `relativeTo` b
-        nginxEnabledConf b = toS $ (nginxSitesEnabled fileName) `relativeTo` b
+        nginxEnabledConf b = toS $ nginxSitesEnabled fileName `relativeTo` b
 
 syncOpenHttpPorts :: SyncOp
 syncOpenHttpPorts = SyncOp "Open Hidden Service Port 80" check migrate False
@@ -426,6 +428,30 @@ syncPersistLogs :: SyncOp
 syncPersistLogs =
     (syncWriteConf "Journald" $(embedFile "config/journald.conf") journaldConfig) { syncOpRequiresReboot = True }
 
+syncRepairSsl :: SyncOp
+syncRepairSsl = SyncOp "Repair SSL Certs" check migrate False
+    where
+        check = do
+            base <- asks $ appFilesystemBase . appSettings
+            let p = toS $ sslDirectory `relativeTo` base
+            liftIO $ not <$> doesDirectoryExist p
+        migrate = do
+            base <- asks $ appFilesystemBase . appSettings
+            let newCerts = toS $ (agentTmpDirectory <> sslDirectory) `relativeTo` base
+            liftIO $ renameDirectory newCerts (toS $ sslDirectory `relativeTo` base)
+            liftIO $ systemCtl RestartService "nginx" $> ()
+
+syncConvertEcdsaCerts :: SyncOp
+syncConvertEcdsaCerts = SyncOp "Convert Intermediate Cert to ECDSA P256" check migrate False
+    where
+        check = do
+            fs     <- asks $ appFilesystemBase . appSettings
+            header <- liftIO $ headMay . lines <$> readFile (toS $ intermediateCaKeyPath `relativeTo` fs)
+            pure $ case header of
+                Nothing -> False
+                Just y  -> "BEGIN RSA PRIVATE KEY" `T.isInfixOf` y
+        migrate = replaceDerivativeCerts
+
 failUpdate :: S9Error -> ExceptT Void (ReaderT AgentCtx IO) ()
 failUpdate e = do
     ref <- asks appIsUpdateFailed

agent/src/Lib/SystemPaths.hs

@@ -76,18 +76,15 @@ getAbsoluteLocationFor path = do
 readSystemPath :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> m (Maybe Text)
 readSystemPath path = do
     loadPath <- getAbsoluteLocationFor path
-    contents <-
+    liftIO
-        liftIO
         $       (Just <$> readFile (toS loadPath))
         `catch` (\(e :: IOException) -> if isDoesNotExistError e then pure Nothing else throwIO e)
-    pure contents
 
 -- like the above, but throws IO error if file not found
 readSystemPath' :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> m Text
 readSystemPath' path = do
     loadPath <- getAbsoluteLocationFor path
-    contents <- liftIO . readFile . toS $ loadPath
+    liftIO . readFile . toS $ loadPath
-    pure contents
 
 writeSystemPath :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> Text -> m ()
 writeSystemPath path contents = do