return RegisterRes on 209

agent/src/Handler/Hosts.hs

@@ -5,26 +5,24 @@ module Handler.Hosts where
 import           Startlude               hiding ( ask )
 
 import           Control.Carrier.Lift           ( runM )
-import           Control.Carrier.Error.Church
 import           Data.Conduit
 import qualified Data.Conduit.Binary           as CB
 import           Data.Time.ISO8601
 import           Yesod.Core              hiding ( expiresAt )
 
 import           Foundation
-import           Daemon.ZeroConf
+import           Handler.Register               ( checkExistingPasswordRegistration
-import           Handler.Register               ( produceProofOfKey
+                                                , getRegistration
-                                                , checkExistingPasswordRegistration
                                                 )
 import           Handler.Types.Hosts
-import           Handler.Types.Register
 import           Lib.Crypto
 import           Lib.Error
 import           Lib.Password                   ( rootAccountName )
 import           Lib.ProductKey
-import           Lib.Ssl
+import           Lib.SystemPaths                ( injectFilesystemBaseFromContext
-import           Lib.SystemPaths
+                                                , rootCaCertPath
-import           Lib.Tor
+                                                , SystemPath(relativeTo)
+                                                )
 import           Settings
 
 getHostsR :: Handler HostsRes
@@ -59,23 +57,7 @@ verifyTimestampNotExpired expirationTimestamp = do
         Nothing         -> throwE $ TTLExpirationE "invalid timestamp"
         Just expiration -> when (expiration < now) (throwE $ TTLExpirationE "expired")
 
-getRegistration :: (MonadIO m, HasFilesystemBase sig m, Has (Error S9Error) sig m) => Text -> UTCTime -> m RegisterRes
-getRegistration productKey registerResClaimedAt = do
-    torAddress <- getAgentHiddenServiceUrlMaybe >>= \case
-        Nothing -> throwError $ NotFoundE "prior registration" "torAddress"
-        Just t  -> pure $ t
-    caCert <- readSystemPath rootCaCertPath >>= \case
-        Nothing -> throwError $ NotFoundE "prior registration" "cert"
-        Just t  -> pure t
 
-    -- create an hmac of the torAddress + caCert for front end
-    registerResTorAddressSig <- produceProofOfKey productKey torAddress
-    registerResCertSig       <- produceProofOfKey productKey caCert
-
-    let registerResCertName = root_CA_CERT_NAME
-    registerResLanAddress <- getStart9AgentHostnameLocal
-
-    pure RegisterRes { .. }
 
 getCertificateR :: Handler TypedContent
 getCertificateR = do

agent/src/Handler/Register.hs

@@ -5,7 +5,10 @@ module Handler.Register where
 
 import           Startlude               hiding ( ask )
 
-import           Control.Carrier.Error.Either   ( runError )
+import           Control.Carrier.Error.Either   ( runError
+                                                , Error
+                                                , throwError
+                                                )
 import           Control.Carrier.Lift
 import           Control.Effect.Throw           ( liftEither )
 import           Crypto.Cipher.Types
@@ -29,6 +32,7 @@ import           Lib.Password
 import           Lib.ProductKey
 import           Lib.Ssl
 import           Lib.SystemPaths
+import           Lib.Tor
 import           Model
 import           Settings
 
@@ -46,8 +50,11 @@ postRegisterR = handleS9ErrT $ do
 
     -- Check for existing registration.
     checkExistingPasswordRegistration rootAccountName >>= \case
-        Nothing -> pure ()
+        Nothing        -> pure ()
-        Just _  -> sendResponseStatus (Status 209 "Preexisting") ()
+        Just claimedAt -> do
+            res <- mapExceptT (liftIO . runM . injectFilesystemBaseFromContext settings)
+                $ getRegistration productKey claimedAt
+            sendResponseStatus (Status 209 "Preexisting") res
 
     -- install new tor hidden service key and restart tor
     registerResTorAddress <- runM (injectFilesystemBaseFromContext settings $ bootupTor torKeyFileContents) >>= \case
@@ -139,3 +146,21 @@ produceProofOfKey key message = do
     salt <- random16
     let hmac = computeHmac key message salt
     pure $ HmacSig hmac message salt
+
+getRegistration :: (MonadIO m, HasFilesystemBase sig m, Has (Error S9Error) sig m) => Text -> UTCTime -> m RegisterRes
+getRegistration productKey registerResClaimedAt = do
+    torAddress <- getAgentHiddenServiceUrlMaybe >>= \case
+        Nothing -> throwError $ NotFoundE "prior registration" "torAddress"
+        Just t  -> pure $ t
+    caCert <- readSystemPath rootCaCertPath >>= \case
+        Nothing -> throwError $ NotFoundE "prior registration" "cert"
+        Just t  -> pure t
+
+    -- create an hmac of the torAddress + caCert for front end
+    registerResTorAddressSig <- produceProofOfKey productKey torAddress
+    registerResCertSig       <- produceProofOfKey productKey caCert
+
+    let registerResCertName = root_CA_CERT_NAME
+    registerResLanAddress <- getStart9AgentHostnameLocal
+
+    pure RegisterRes { .. }