nuthatch/test/DependencyProbe.hs

module Main (main) where

import           Control.Concurrent (threadDelay)
import           Control.Exception (bracket)
import           Control.Monad (unless)
import qualified Data.ByteString.Char8 as B8
import           Database.PostgreSQL.Simple
  ( Only (..)
  , close
  , connectPostgreSQL
  , execute_
  , query_
  )
import           Database.Redis
  ( ConnectInfo (..)
  , PortID (..)
  , Reply
  , Status
  , connect
  , defaultConnectInfo
  , disconnect
  , get
  , runRedis
  , set
  )
import           Nuthatch.Probe.Assert
import           Nuthatch.Probe.Curl
import           Nuthatch.Probe.Http hiding (get)
import qualified Nuthatch.Probe.Http as Http

main :: IO ()
main = do
  client <- newProbeClient
  verifyPostgres
  verifyCoordination "redis"
  verifyCoordination "dragonfly"
  verifyOidc client
  verifyTarget
    "Garage"
    "http://garage:3900"
    "garage"
    "GK00000000000000000000000000000000"
    "0000000000000000000000000000000000000000000000000000000000000000"
    False
  verifyTarget
    "VersityGW"
    "http://versitygw:10000"
    "us-east-1"
    "synthetic-s3-access"
    "synthetic-s3-secret"
    True
  putStrLn "Dependency product interfaces passed"

verifyPostgres :: IO ()
verifyPostgres =
  bracket
    (connectPostgreSQL
      "host=postgres port=5432 user=nuthatch password=synthetic-postgres dbname=nuthatch")
    close
    (\connection -> do
      _ <- execute_ connection
        "CREATE TEMP TABLE dependency_probe (value text NOT NULL)"
      _ <- execute_ connection
        "INSERT INTO dependency_probe VALUES ('passed')"
      values <- query_ connection
        "SELECT value FROM dependency_probe"
        :: IO [Only B8.ByteString]
      assertEqual "PostgreSQL product interface"
        [Only "passed"]
        values)

verifyCoordination :: String -> IO ()
verifyCoordination host =
  bracket
    (connect defaultConnectInfo
      { connectHost = host
      , connectPort = PortNumber 6379
      })
    disconnect
    (\connection -> do
      stored <- runRedis connection (set "nuthatch-probe" "passed")
        :: IO (Either Reply Status)
      assert "coordination write failed" (isRight stored)
      loaded <- runRedis connection (get "nuthatch-probe")
        :: IO (Either Reply (Maybe B8.ByteString))
      assertEqual (host <> " product interface")
        (Right (Just "passed"))
        loaded)

verifyOidc :: ProbeClient -> IO ()
verifyOidc client =
  mapM_
    (\(label, url, marker) ->
      retry label 30 $ do
        response <- Http.get client url
        pure
          ( probeStatus response == 200
          && marker `B8.isInfixOf` probeBody response
          ))
    [ ( "Keycloak discovery"
      , "http://keycloak.nuthatch.test:8080/realms/master/.well-known/openid-configuration"
      , "\"issuer\""
      )
    , ( "Keycloak keys"
      , "http://keycloak.nuthatch.test:8080/realms/master/protocol/openid-connect/certs"
      , "\"keys\""
      )
    , ( "ZITADEL discovery"
      , "http://zitadel.nuthatch.test:8080/.well-known/openid-configuration"
      , "\"issuer\""
      )
    , ( "ZITADEL keys"
      , "http://zitadel.nuthatch.test:8080/oauth/v2/keys"
      , "\"keys\""
      )
    ]

verifyTarget
  :: String
  -> String
  -> String
  -> String
  -> String
  -> Bool
  -> IO ()
verifyTarget label endpoint region accessKey secretKey createBucket = do
  let signed =
        [ "--aws-sigv4", "aws:amz:" <> region <> ":s3"
        , "--user", accessKey <> ":" <> secretKey
        ]
      bucket = endpoint <> "/nuthatch-fixture"
      payload = "nuthatch-dependency-compatibility-probe"
      payloadDigest =
        "d0d4c515c2723784b6ca1b22b97d89ae8229a9c2abcb9ca912b85c1f02e17303"
      emptyDigest =
        "e3b0c44298fc1c149afbf4c8996fb924"
          <> "27ae41e4649b934ca495991b7852b855"
  if createBucket
    then do
      created <- curl
        ( signed
        <> [ "--request", "PUT"
           , "--header", "X-Amz-Content-Sha256:" <> emptyDigest
           , bucket
           ]
        )
      assert
        ( label
        <> " bucket creation failed: "
        <> B8.unpack (probeBody created)
        ) $
          probeStatus created `elem` [200, 409]
    else pure ()
  uploaded <- retryResponse 30 $ curl
    ( signed
    <> [ "--request", "PUT"
       , "--header"
       , "X-Amz-Content-Sha256:" <> payloadDigest
       , "--data-binary", payload
       , bucket <> "/probe/payload"
       ]
    )
  assertEqual
    (label <> " upload: " <> B8.unpack (probeBody uploaded))
    200
    (probeStatus uploaded)
  downloaded <- curl
    ( signed
    <> [ "--header"
       , "X-Amz-Content-Sha256:" <> emptyDigest
       , bucket <> "/probe/payload"
       ]
    )
  assertEqual (label <> " download status") 200 (probeStatus downloaded)
  assertEqual (label <> " object body")
    (B8.pack payload)
    (probeBody downloaded)

retry :: String -> Int -> IO Bool -> IO ()
retry label attempts action =
  go attempts
  where
    go remaining = do
      succeeded <- action
      unless succeeded $
        if remaining <= 1
          then fail (label <> " did not become available")
          else threadDelay 1000000 >> go (remaining - 1)

retryResponse :: Int -> IO ProbeResponse -> IO ProbeResponse
retryResponse attempts action =
  go attempts
  where
    go remaining = do
      response <- action
      if probeStatus response == 200 || remaining <= 1
        then pure response
        else threadDelay 1000000 >> go (remaining - 1)

isRight :: Either left right -> Bool
isRight (Right _) = True
isRight (Left _) = False