removes timing code

agent/src/Handler/Register.hs

@@ -34,57 +34,43 @@ import           Settings
 
 
 postRegisterR :: Handler RegisterRes
-postRegisterR = handleS9ErrT . fromSys $ do
+postRegisterR = handleS9ErrT $ do
-    time "Start"
+    settings           <- getsYesod appSettings
-    settings   <- getsYesod appSettings
 
-    productKey <- liftIO . getProductKey . appFilesystemBase $ settings
+    productKey         <- liftIO . getProductKey . appFilesystemBase $ settings
-    time "Read Product Key"
+    req                <- requireCheckJsonBody
-    req <- requireCheckJsonBody
-    time "Parse JSON Body"
 
     -- Decrypt torkey and password. This acts as product key authentication.
-    torKeyFileContents <- lift $ decryptTorkey productKey req
+    torKeyFileContents <- decryptTorkey productKey req
-    time "Decrypt Tor Key"
+    password           <- decryptPassword productKey req
-    password <- lift $ decryptPassword productKey req
+    rsaKeyFileContents <- decryptRSAKey productKey req
-    time "Decrypt Password"
-    rsaKeyFileContents <- lift $ decryptRSAKey productKey req
-    time "Decrypto RSA"
 
     -- Check for existing registration.
-    lift $ checkExistingPasswordRegistration rootAccountName >>= \case
+    checkExistingPasswordRegistration rootAccountName >>= \case
         Nothing -> pure ()
         Just _  -> sendResponseStatus (Status 209 "Preexisting") ()
-    time "Check Password Registration"
 
     -- install new tor hidden service key and restart tor
-    registerResTorAddress <-
+    registerResTorAddress <- runM (injectFilesystemBaseFromContext settings $ bootupTor torKeyFileContents) >>= \case
-        lift $ runM (injectFilesystemBaseFromContext settings $ bootupTor torKeyFileContents) >>= \case
+        Just t  -> pure t
-            Just t  -> pure t
+        Nothing -> throwE TorServiceTimeoutE
-            Nothing -> throwE TorServiceTimeoutE
-    time "Bootstrap Tor Hidden Service"
 
     -- install new ssl CA cert + nginx conf and restart nginx
     registerResCert <-
         runM . handleS9ErrC . liftEither <=< liftIO . runM . injectFilesystemBaseFromContext settings $ do
             bootupHttpNginx
             runError @S9Error $ bootupSslNginx rsaKeyFileContents
-    time "Bootstrap SSL Configuration"
 
     -- create an hmac of the torAddress + caCert for front end
     registerResTorAddressSig <- produceProofOfKey productKey registerResTorAddress
-    time "Sign Tor Address"
+    registerResCertSig       <- produceProofOfKey productKey registerResCert
-    registerResCertSig <- produceProofOfKey productKey registerResCert
-    time "Sign Certificate"
 
     -- must match CN in config/csr.conf
     let registerResCertName = root_CA_CERT_NAME
     registerResLanAddress <- runM . injectFilesystemBaseFromContext settings $ getStart9AgentHostnameLocal
-    time "Fetch Agent Hostname"
 
     -- registration successful, save the password hash
-    registerResClaimedAt <- lift $ saveAccountRegistration rootAccountName password
+    registerResClaimedAt  <- saveAccountRegistration rootAccountName password
-    time "Save Account Registration"
     pure RegisterRes { .. }
 
 

agent/src/Handler/Register/Nginx.hs

@@ -22,21 +22,8 @@ import           Lib.Synchronizers
 import           Lib.SystemPaths
 import           Lib.Tor
 import           System.Posix                   ( removeLink )
-import           Data.String.Interpolate.IsString
-                                                ( i )
 import           Lib.SystemCtl
 
-time :: MonadIO m => Text -> StateT UTCTime m ()
-time t = do
-    last <- Startlude.get
-    now  <- liftIO getCurrentTime
-    putStrLn @Text [i|#{t}: #{diffUTCTime now last}|]
-    put now
-
-fromSys :: MonadIO m => StateT UTCTime m a -> m a
-fromSys m = liftIO getCurrentTime >>= evalStateT m
-
-
 -- Left error, Right CA cert for hmac signing
 bootupSslNginx :: (HasFilesystemBase sig m, Has (Error S9Error) sig m, Has (Lift IO) sig m, MonadIO m)
                => ByteString
@@ -96,7 +83,7 @@ bootupHttpNginx :: (HasFilesystemBase sig m, MonadIO m) => m ()
 bootupHttpNginx = installAmbassadorUiNginxHTTP "start9-ambassador.conf"
 
 writeSslKeyAndCert :: (MonadIO m, HasFilesystemBase sig m, Has (Error S9Error) sig m) => ByteString -> m Text
-writeSslKeyAndCert rsaKeyFileContents = fromSys $ do
+writeSslKeyAndCert rsaKeyFileContents = do
     directory     <- toS <$> getAbsoluteLocationFor sslDirectory
     caKeyPath     <- toS <$> getAbsoluteLocationFor rootCaKeyPath
     caConfPath    <- toS <$> getAbsoluteLocationFor rootCaOpenSslConfPath
@@ -112,13 +99,10 @@ writeSslKeyAndCert rsaKeyFileContents = fromSys $ do
 
     let hostname = sid <> ".local"
 
-    time "SSL Start"
     liftIO $ createDirectoryIfMissing False directory
     liftIO $ BS.writeFile caKeyPath rsaKeyFileContents
-    time "Write SSL Root Key"
 
     (exit, str1, str2) <- writeRootCaCert caConfPath caKeyPath caCertPath
-    time "Generate SSL Root Cert"
     liftIO $ do
         putStrLn @Text "openssl logs"
         putStrLn @Text "exit code: "