graphql-engine/server/src-lib/Hasura/PingSources.hs
2023-02-14 12:15:58 +00:00

36 lines
1.1 KiB
Haskell

module Hasura.PingSources
( runPingSources,
)
where
import Control.Concurrent.Extended qualified as Conc
import Data.Environment qualified as Env
import Hasura.Prelude
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.Source (SourcePingCache, SourcePingInfo (..))
import Hasura.SQL.AnyBackend qualified as AB
-- | A forever running IO loop that performs regular pings for DBs that need it
-- these are used to send a fingerprint to third parties that wish to attribute
-- users to Hasura
runPingSources ::
Env.Environment ->
(String -> IO ()) ->
IO SourcePingCache ->
IO a
runPingSources env pingLog fetchPingCacheIO =
forever $ do
pingCache <- liftIO fetchPingCacheIO
for_ pingCache $ \someSourcePingInfo ->
AB.dispatchAnyBackend @Backend
someSourcePingInfo
\(thisSourcePingInfo :: SourcePingInfo b) ->
runPingSource @b
env
pingLog
(_spiName thisSourcePingInfo)
(_spiConnection thisSourcePingInfo)
-- Sleep the thread for a minute
liftIO $ Conc.sleep $ seconds 60