Merge pull request #69 from Start9Labs/agent/bugfix/ecc-synchronizer

actually adds ecc sync to the list

agent/src/Application.hs

@@ -206,7 +206,7 @@ startupSequence foundation = do
     waitForUpdateSignal foundation
 
 sleep :: Integer -> IO ()
-sleep n = let (full, r) = (n * 1_000_000) `divMod` (fromIntegral $ (maxBound :: Int)) in
+sleep n = let (full, r) = (n * 1_000_000) `divMod` fromIntegral (maxBound :: Int) in
     replicateM_ (fromIntegral full) (threadDelay maxBound) *> threadDelay (fromIntegral r)
 
 --------------------------------------------------------------

agent/src/Daemon/SslRenew.hs

@@ -13,8 +13,8 @@ import           Lib.Ssl
 import           Daemon.ZeroConf                ( getStart9AgentHostname )
 import           Lib.Tor
 import           Control.Carrier.Lift
-import           System.Directory               ( renameDirectory
+import           System.Directory               ( removePathForcibly
-                                                , removeDirectory
+                                                , renameDirectory
                                                 )
 import           Lib.SystemCtl
 import qualified Lib.Notifications             as Notifications
@@ -25,10 +25,11 @@ import           Constants
 renewSslLeafCert :: AgentCtx -> IO ()
 renewSslLeafCert ctx = do
     let base = appFilesystemBase . appSettings $ ctx
-    hn  <- injectFilesystemBase base getStart9AgentHostname
+    sid <- injectFilesystemBase base getStart9AgentHostname
+    let hostname = sid <> ".local"
     tor <- injectFilesystemBase base getAgentHiddenServiceUrl
     putStr @Text "SSL Renewal Required? "
-    needsRenew <- doesSslNeedRenew (toS $ entityCertPath hn `relativeTo` base)
+    needsRenew <- doesSslNeedRenew (toS $ entityCertPath sid `relativeTo` base)
     print needsRenew
     when needsRenew $ runM . injectFilesystemBase base $ do
         intCaKeyPath   <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath
@@ -36,9 +37,9 @@ renewSslLeafCert ctx = do
         intCaCertPath  <- toS <$> getAbsoluteLocationFor intermediateCaCertPath
 
         sslDirTmp      <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> sslDirectory)
-        entKeyPathTmp  <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath hn)
+        entKeyPathTmp  <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath sid)
-        entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath hn)
+        entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath sid)
-        entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath hn)
+        entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath sid)
 
         (ec, out, err) <- writeLeafCert
             DeriveCertificate { applicantConfPath = entConfPathTmp
@@ -49,7 +50,7 @@ renewSslLeafCert ctx = do
                               , signingCertPath   = intCaCertPath
                               , duration          = 365
                               }
-            hn
+            hostname
             tor
         liftIO $ do
             putStrLn @Text "openssl logs"
@@ -66,7 +67,7 @@ renewSslLeafCert ctx = do
                     $ Notifications.emit (AppId "EmbassyOS") agentVersion
                     $ Notifications.CertRenewFailed (ExitFailure n) out err
         let sslDir = toS $ sslDirectory `relativeTo` base
-        liftIO $ removeDirectory sslDir
+        liftIO $ removePathForcibly sslDir
         liftIO $ renameDirectory sslDirTmp sslDir
         liftIO $ systemCtl RestartService "nginx" $> ()
 

agent/src/Handler/Register/Nginx.hs

@@ -22,7 +22,6 @@ 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)
@@ -157,73 +156,3 @@ 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/Error.hs

@@ -198,7 +198,7 @@ toStatus = \case
     NoCompliantAgentE _    -> status404
     PersistentE       _    -> status500
     WifiConnectionE        -> status500
-    AppMgrParseE _ _ _     -> status500
+    AppMgrParseE{}         -> status500
     AppMgrInvalidConfigE _ -> status400
     AppMgrE        _ _     -> status500
     AppMgrVersionE _ _     -> status500
@@ -220,28 +220,28 @@ toStatus = \case
         (AppStatusTmp    NeedsConfig, Start) -> status403
         (AppStatusTmp    NeedsConfig, Stop ) -> status200
         (AppStatusTmp    _          , _    ) -> status403
-    UpdateSelfE _ _             -> status500
+    UpdateSelfE _ _         -> status500
-    InvalidSshKeyE _            -> status400
+    InvalidSshKeyE _        -> status400
-    InvalidSsidE                -> status400
+    InvalidSsidE            -> status400
-    InvalidPskE                 -> status400
+    InvalidPskE             -> status400
-    InvalidRequestE _ _         -> status400
+    InvalidRequestE _ _     -> status400
-    NotFoundE       _ _         -> status404
+    NotFoundE       _ _     -> status404
-    UpdateInProgressE           -> status403
+    UpdateInProgressE       -> status403
-    TemporarilyForbiddenE _ _ _ -> status403
+    TemporarilyForbiddenE{} -> status403
-    TorServiceTimeoutE          -> status500
+    TorServiceTimeoutE      -> status500
-    NginxSslE _                 -> status500
+    NginxSslE _             -> status500
-    WifiOrphaningE              -> status403
+    WifiOrphaningE          -> status403
-    ManifestParseE _ _          -> status500
+    ManifestParseE _ _      -> status500
-    NoPasswordExistsE           -> status401
+    NoPasswordExistsE       -> status401
-    MissingFileE        _       -> status500
+    MissingFileE        _   -> status500
-    ClientCryptographyE _       -> status401
+    ClientCryptographyE _   -> status401
-    TTLExpirationE      _       -> status403
+    TTLExpirationE      _   -> status403
-    EnvironmentValE     _       -> status500
+    EnvironmentValE     _   -> status500
-    HostsParamsE        _       -> status400
+    HostsParamsE        _   -> status400
-    BackupE _ _                 -> status500
+    BackupE _ _             -> status500
-    BackupPassInvalidE          -> status403
+    BackupPassInvalidE      -> status403
-    InternalE _                 -> status500
+    InternalE _             -> status500
-    OpenSslE _ _ _ _            -> status500
+    OpenSslE{}              -> status500
 
 handleS9ErrC :: (MonadHandler m, MonadLogger m) => ErrorC S9Error m a -> m a
 handleS9ErrC action =
@@ -251,12 +251,11 @@ handleS9ErrC action =
     in  runErrorC action handleIt pure
 
 handleS9ErrT :: (MonadHandler m, MonadLogger m) => S9ErrT m a -> m a
-handleS9ErrT action = do
+handleS9ErrT action = runExceptT action >>= \case
-    runExceptT action >>= \case
+    Left e -> do
-        Left e -> do
+        $logError $ show e
-            $logError $ show e
+        toStatus >>= sendResponseStatus $ e
-            toStatus >>= sendResponseStatus $ e
+    Right a -> pure a
-        Right a -> pure a
 
 runS9ErrT :: MonadIO m => S9ErrT m a -> m (Either S9Error a)
 runS9ErrT = runExceptT

agent/src/Lib/Synchronizers.hs

@@ -5,7 +5,9 @@
 {-# LANGUAGE TemplateHaskell      #-}
 module Lib.Synchronizers where
 
-import           Startlude               hiding ( check )
+import           Startlude               hiding ( check
+                                                , err
+                                                )
 import qualified Startlude.ByteStream          as ByteStream
 import qualified Startlude.ByteStream.Char8    as ByteStream
 
@@ -62,7 +64,7 @@ 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 )
+import           Control.Effect.Error    hiding ( run )
 
 
 data Synchronizer = Synchronizer
@@ -116,6 +118,7 @@ sync_0_2_6 = Synchronizer
     , syncPrepSslRootCaDir
     , syncPrepSslIntermediateCaDir
     , syncPersistLogs
+    , syncConvertEcdsaCerts
     ]
 
 syncCreateAgentTmp :: SyncOp
@@ -445,12 +448,93 @@ syncConvertEcdsaCerts :: SyncOp
 syncConvertEcdsaCerts = SyncOp "Convert Intermediate Cert to ECDSA P256" check migrate False
     where
         check = do
-            fs     <- asks $ appFilesystemBase . appSettings
+            fs <- asks $ appFilesystemBase . appSettings
-            header <- liftIO $ headMay . lines <$> readFile (toS $ intermediateCaKeyPath `relativeTo` fs)
+            let intCertKey = toS $ intermediateCaKeyPath `relativeTo` fs
-            pure $ case header of
+            exists <- liftIO $ doesPathExist intCertKey
-                Nothing -> False
+            if exists
-                Just y  -> "BEGIN RSA PRIVATE KEY" `T.isInfixOf` y
+                then do
-        migrate = replaceDerivativeCerts
+                    header <- liftIO $ headMay . lines <$> readFile intCertKey
+                    pure $ case header of
+                        Nothing -> False
+                        Just y  -> "BEGIN RSA PRIVATE KEY" `T.isInfixOf` y
+                else pure False
+        migrate = cantFail $ do
+            base <- asks $ appFilesystemBase . appSettings
+            (runM . runExceptT) (injectFilesystemBase base replaceDerivativeCerts) >>= \case
+                Left  e  -> failUpdate e
+                Right () -> pure ()
+
+
+replaceDerivativeCerts :: (HasFilesystemBase sig m, Fused.Has (Error S9Error) sig m, MonadIO m) => m ()
+replaceDerivativeCerts = do
+    sid <- getStart9AgentHostname
+    let hostname = sid <> ".local"
+    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 sid)
+    entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath sid)
+    entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath sid)
+    liftIO $ createDirectoryIfMissing True sslDirTmp
+    liftIO $ BS.writeFile entConfPathTmp (domain_CSR_CONF hostname)
+
+    -- 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
+                          }
+        hostname
+        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 $ removePathForcibly sslDir
+    liftIO $ renameDirectory sslDirTmp sslDir
+    liftIO $ systemCtl RestartService "nginx" $> ()
 
 failUpdate :: S9Error -> ExceptT Void (ReaderT AgentCtx IO) ()
 failUpdate e = do