Bound authentication probe startup synchronization
This commit is contained in:
parent
9ad8d27adf
commit
b196f9e17b
2 changed files with 36 additions and 7 deletions
|
|
@ -1,14 +1,16 @@
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
|
import Control.Concurrent (threadDelay)
|
||||||
|
import Control.Exception (throwIO, try)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base16 as B16
|
import qualified Data.ByteString.Base16 as B16
|
||||||
import qualified Data.ByteString.Char8 as B8
|
import qualified Data.ByteString.Char8 as B8
|
||||||
import Data.List (find)
|
import Data.List (find)
|
||||||
import System.Entropy (getEntropy)
|
|
||||||
import Nuthatch.Probe.Assert
|
import Nuthatch.Probe.Assert
|
||||||
import Nuthatch.Probe.Curl
|
import Nuthatch.Probe.Curl
|
||||||
import Nuthatch.Probe.Oidc
|
import Nuthatch.Probe.Oidc
|
||||||
import Nuthatch.Probe.ProductClient
|
import Nuthatch.Probe.ProductClient
|
||||||
|
import System.Entropy (getEntropy)
|
||||||
import System.IO.Temp (withSystemTempDirectory)
|
import System.IO.Temp (withSystemTempDirectory)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
|
@ -17,6 +19,7 @@ main =
|
||||||
context <- newProbeContext directory
|
context <- newProbeContext directory
|
||||||
runId <- B8.unpack . B16.encode <$> getEntropy 8
|
runId <- B8.unpack . B16.encode <$> getEntropy 8
|
||||||
verifyCredentialScope
|
verifyCredentialScope
|
||||||
|
waitForApplication context
|
||||||
verifyPublicBoundary context
|
verifyPublicBoundary context
|
||||||
userA <- requireEnv "NUTHATCH_OIDC_USER_A"
|
userA <- requireEnv "NUTHATCH_OIDC_USER_A"
|
||||||
sessionA <- login context True userA "a"
|
sessionA <- login context True userA "a"
|
||||||
|
|
@ -28,6 +31,25 @@ main =
|
||||||
verifyLogout context sessionA
|
verifyLogout context sessionA
|
||||||
putStrLn "OIDC application boundary passed"
|
putStrLn "OIDC application boundary passed"
|
||||||
|
|
||||||
|
waitForApplication :: ProbeContext -> IO ()
|
||||||
|
waitForApplication context = go 30
|
||||||
|
where
|
||||||
|
go :: Int -> IO ()
|
||||||
|
go remaining = do
|
||||||
|
result <-
|
||||||
|
try (curl
|
||||||
|
[ "--connect-timeout", "1"
|
||||||
|
, "--max-time", "2"
|
||||||
|
, probeBase context <> "/readyz"
|
||||||
|
])
|
||||||
|
:: IO (Either CurlTransportFailure CurlResponse)
|
||||||
|
case result of
|
||||||
|
Right _ -> pure ()
|
||||||
|
Left failure
|
||||||
|
| curlTransportExitCode failure == 7 && remaining > 1 ->
|
||||||
|
threadDelay 1000000 >> go (remaining - 1)
|
||||||
|
| otherwise -> throwIO failure
|
||||||
|
|
||||||
verifyCredentialScope :: IO ()
|
verifyCredentialScope :: IO ()
|
||||||
verifyCredentialScope = do
|
verifyCredentialScope = do
|
||||||
endpoint <- requireEnv "NUTHATCH_S3_ENDPOINT"
|
endpoint <- requireEnv "NUTHATCH_S3_ENDPOINT"
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,6 @@
|
||||||
module Nuthatch.Probe.Curl
|
module Nuthatch.Probe.Curl
|
||||||
( CurlResponse (..)
|
( CurlResponse (..)
|
||||||
|
, CurlTransportFailure (..)
|
||||||
, cookieValue
|
, cookieValue
|
||||||
, curl
|
, curl
|
||||||
, curlToFile
|
, curlToFile
|
||||||
|
|
@ -7,6 +8,7 @@ module Nuthatch.Probe.Curl
|
||||||
, headerValues
|
, headerValues
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Exception (Exception, throwIO)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Char8 as B8
|
import qualified Data.ByteString.Char8 as B8
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
|
|
@ -23,6 +25,13 @@ data CurlResponse = CurlResponse
|
||||||
, curlBody :: BS.ByteString
|
, curlBody :: BS.ByteString
|
||||||
} deriving stock (Eq, Show)
|
} deriving stock (Eq, Show)
|
||||||
|
|
||||||
|
data CurlTransportFailure = CurlTransportFailure
|
||||||
|
{ curlTransportExitCode :: Int
|
||||||
|
, curlTransportStderr :: String
|
||||||
|
} deriving stock (Eq, Show)
|
||||||
|
|
||||||
|
instance Exception CurlTransportFailure
|
||||||
|
|
||||||
curl :: [String] -> IO CurlResponse
|
curl :: [String] -> IO CurlResponse
|
||||||
curl arguments =
|
curl arguments =
|
||||||
withSystemTempDirectory "nuthatch-curl" $ \directory -> do
|
withSystemTempDirectory "nuthatch-curl" $ \directory -> do
|
||||||
|
|
@ -56,12 +65,10 @@ runCurl outputPath arguments =
|
||||||
case exitCode of
|
case exitCode of
|
||||||
ExitSuccess -> pure ()
|
ExitSuccess -> pure ()
|
||||||
ExitFailure code ->
|
ExitFailure code ->
|
||||||
fail
|
throwIO CurlTransportFailure
|
||||||
( "curl transport failed with exit "
|
{ curlTransportExitCode = code
|
||||||
<> show code
|
, curlTransportStderr = stderrText
|
||||||
<> ": "
|
}
|
||||||
<> stderrText
|
|
||||||
)
|
|
||||||
headers <- parseHeaders <$> BS.readFile headersPath
|
headers <- parseHeaders <$> BS.readFile headersPath
|
||||||
pure CurlResponse
|
pure CurlResponse
|
||||||
{ curlStatus = status
|
{ curlStatus = status
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue