server: add the ability to force refresh of dynamic db connection str…

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/10713
GitOrigin-RevId: 7aa286141a27c11609614349cad05041e55b2a0f

docs/docs/security/dynamic-secrets.mdx

@@ -92,3 +92,16 @@ reference.
 
 Dynamic secrets can be used in template variables for data connectors. See
 [Template variables](/databases/database-config/data-connector-config.mdx/#template) for reference.
+
+## Forcing secret refresh
+
+If the environment variable `HASURA_SECRETS_BLOCKING_FORCE_REFRESH_URL=<url>`
+is set, on each connection failure the server will POST to the specified URL the payload:
+
+```
+{"filename": <path>}
+```
+
+It is expected that the responding server will return only after refreshing the
+secret at the given filepath. [hasura-secret-refresh](https://github.com/hasura/hasura-secret-refresh) 
+follows this spec.

server/lib/pg-client/pg-client.cabal

@@ -65,6 +65,9 @@ library
     , ekg-prometheus
     , hashable
     , hashtables
+    -- for our HASURA_SECRETS_BLOCKING_FORCE_REFRESH_URL hook
+    , http-client
+    , http-types
     , mmorph
     , monad-control
     , mtl

server/lib/pg-client/src/Database/PG/Query/Connection.hs

@@ -48,13 +48,14 @@ where
 
 import Control.Concurrent.Interrupt (interruptOnAsyncException)
 import Control.Exception.Safe (Exception, SomeException (..), catch, throwIO)
+import Control.Monad (unless)
 import Control.Monad.Except (MonadError (throwError))
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (ExceptT, runExceptT, withExceptT)
 import Control.Retry (RetryPolicyM)
 import Control.Retry qualified as Retry
-import Data.Aeson (ToJSON (toJSON), Value (String), genericToJSON, object, (.=))
+import Data.Aeson (ToJSON (toJSON), Value (String), encode, genericToJSON, object, (.=))
 import Data.Aeson.Casing (aesonDrop, snakeCase)
 import Data.Aeson.TH (mkToJSON)
 import Data.Bool (bool)
@@ -77,6 +78,9 @@ import Data.Word (Word16, Word32)
 import Database.PostgreSQL.LibPQ qualified as PQ
 import Database.PostgreSQL.Simple.Options qualified as Options
 import GHC.Generics (Generic)
+import Network.HTTP.Client
+import Network.HTTP.Types.Status (statusCode)
+import System.Environment (lookupEnv)
 import Prelude
 
 {-# ANN module ("HLint: ignore Use tshow" :: String) #-}
@@ -209,6 +213,7 @@ readConnErr conn = do
 pgRetrying ::
   (MonadIO m) =>
   Maybe String ->
+  -- | An action to perform on error
   IO () ->
   PGRetryPolicyM m ->
   PGLogger ->
@@ -242,6 +247,36 @@ initPQConn ::
   IO PQ.Connection
 initPQConn ci logger = do
   host <- extractHost (ciDetails ci)
+  -- if this is a dynamic connection, we'll signal to refresh the secret (if
+  -- configured) during each retry, ensuring we don't make too many connection
+  -- attempts with the wrong credentials and risk getting locked out
+  resetFn <- do
+    mbUrl <- lookupEnv "HASURA_SECRETS_BLOCKING_FORCE_REFRESH_URL"
+    case (mbUrl, ciDetails ci) of
+      (Just url, CDDynamicDatabaseURI path) -> do
+        manager <- newManager defaultManagerSettings
+
+        -- Create the request
+        let body = encode $ object ["filename" .= path]
+        initialRequest <- parseRequest url
+        let request =
+              initialRequest
+                { method = "POST",
+                  requestBody = RequestBodyLBS body,
+                  requestHeaders = [("Content-Type", "application/json")]
+                }
+
+        -- The action to perform on each retry. This must only return after
+        -- the secrets file has been refreshed.
+        return $ do
+          status <- statusCode . responseStatus <$> httpLbs request manager
+          unless (status >= 200 && status < 300) $
+            logger $
+              PLERetryMsg $
+                object
+                  ["message" .= String "Forcing refresh of secret file at HASURA_SECRETS_BLOCKING_FORCE_REFRESH_URL seems to have failed. Retrying anyway."]
+      _ -> pure $ pure ()
+
   -- Retry if postgres connection error occurs
   pgRetrying host resetFn retryP logger $ do
     -- Initialise the connection
@@ -252,7 +287,6 @@ initPQConn ci logger = do
     let connOk = s == PQ.ConnectionOk
     bool (whenConnNotOk conn) (whenConnOk conn) connOk
   where
-    resetFn = return ()
     retryP = mkPGRetryPolicy $ ciRetries ci
 
     whenConnNotOk conn = Left . PGConnErr <$> readConnErr conn