Start9/start-os
2
0
Fork 0
mirror of https://github.com/Start9Labs/start-os.git synced 2026-03-26 10:21:52 +00:00
Code Issues Packages Projects Releases Wiki Activity

return RegisterRes on 209

Browse Source
This commit is contained in:
Aiden McClelland
2020-12-04 18:50:03 -07:00
committed by Keagan McClelland
parent 414d8ae54a
commit 7d493e12d3
2 changed files with 34 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
agent/src/Handler/Hosts.hs
View File

@@ -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 ( produceProofOfKey
, checkExistingPasswordRegistration
import Handler.Register ( checkExistingPasswordRegistration
, getRegistration
)
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
import Lib.Tor
import Lib.SystemPaths ( injectFilesystemBaseFromContext
, rootCaCertPath
, 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

31
agent/src/Handler/Register.hs
View File

@@ -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 ()
Just _ -> sendResponseStatus (Status 209 "Preexisting") ()
Nothing -> pure ()
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 { .. }