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 :: forall a.
Environment -> (String -> IO ()) -> IO SourcePingCache -> IO a
runPingSources Environment
env String -> IO ()
pingLog IO SourcePingCache
fetchPingCacheIO =
  IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO a) -> IO () -> IO a
forall a b. (a -> b) -> a -> b
$ do
    SourcePingCache
pingCache <- IO SourcePingCache -> IO SourcePingCache
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SourcePingCache
fetchPingCacheIO
    SourcePingCache -> (BackendSourcePingInfo -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ SourcePingCache
pingCache ((BackendSourcePingInfo -> IO ()) -> IO ())
-> (BackendSourcePingInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BackendSourcePingInfo
someSourcePingInfo ->
      forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend
        BackendSourcePingInfo
someSourcePingInfo
        \(SourcePingInfo b
thisSourcePingInfo :: SourcePingInfo b) ->
          forall (b :: BackendType).
Backend b =>
Environment
-> (String -> IO ())
-> SourceName
-> SourceConnConfiguration b
-> IO ()
runPingSource @b
            Environment
env
            String -> IO ()
pingLog
            (SourcePingInfo b -> SourceName
forall (b :: BackendType). SourcePingInfo b -> SourceName
_spiName SourcePingInfo b
thisSourcePingInfo)
            (SourcePingInfo b -> SourceConnConfiguration b
forall (b :: BackendType).
SourcePingInfo b -> SourceConnConfiguration b
_spiConnection SourcePingInfo b
thisSourcePingInfo)

    -- Sleep the thread for a minute
    IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DiffTime -> IO ()
Conc.sleep (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ Seconds -> DiffTime
seconds Seconds
60