fixes ssl renewal, replaces rsa with ecdsa for derivative certs

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 v = (Notification now Nothing appId version (toCode ty) (toTitle ty) (toMessage appId version ty))
+    let k = NotificationKey uuid
+    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

@@ -9,6 +9,7 @@ module Lib.Ssl
   , writeLeafCert
   , root_CA_OPENSSL_CONF
   , intermediate_CA_OPENSSL_CONF
+  , segment
   )
 where
 

agent/src/Lib/Synchronizers.hs

@@ -87,7 +87,7 @@ 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
@@ -141,7 +141,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 +172,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 +234,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
-                Nothing -> pure True
-                Just co -> pure $ if co == contents then False else True
+            pure $ case conf of
+                Nothing -> True
+                Just co -> co /= contents
         migrate = do
             base <- asks $ appFilesystemBase . appSettings
             void . liftIO $ createDirectoryIfMissing True (takeDirectory (toS $ confLocation `relativeTo` base))
@@ -330,7 +330,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 +372,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
-        nginxEnabledConf b = toS $ (nginxSitesEnabled fileName) `relativeTo` b
+        nginxAvailableConf b = toS $ nginxSitesAvailable fileName `relativeTo` b
+        nginxEnabledConf b = toS $ nginxSitesEnabled fileName `relativeTo` b
 
 syncOpenHttpPorts :: SyncOp
 syncOpenHttpPorts = SyncOp "Open Hidden Service Port 80" check migrate False
@@ -426,6 +426,47 @@ 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
+
+-- syncConvertEcdsaLeafCert :: SyncOp
+-- syncConvertEcdsaLeafCert = SyncOp "Convert Intermediate Cert to ECDSA P256" check migrate False
+--     where
+--         check = do
+--             fs     <- asks $ appFilesystemBase . appSettings
+--             h      <- injectFilesystemBase fs getStart9AgentHostname
+--             header <- liftIO $ headMay . lines <$> readFile (toS $ entityKeyPath h `relativeTo` fs)
+--             pure $ case header of
+--                 Nothing -> False
+--                 Just y  -> "BEGIN RSA PRIVATE" `T.isInfixOf` y
+--         migrate = do
+--             base <- asks $ appFilesystemBase . appSettings
+--             _
+
+-- syncRotateExpiringCerts :: SyncOp
+-- syncRotateExpiringCerts = _
+
 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
-    pure contents
+    liftIO . readFile . toS $ loadPath
 
 writeSystemPath :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> Text -> m ()
 writeSystemPath path contents = do