content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  module Glean.Util.ThriftSource (
    ThriftSource,
    ThriftSourceException(..),
  
    -- * Creation
    config,
    configDefault,
    file,
    value,
    once,
    mutable,
    parse,
  
    -- ** With a custom deserializer
    Deserializer,
    configWithDeserializer,
    configWithDeserializerDefault,
    fileWithDeserializer,
    parseWithDeserializer,
    genericConfig,
  
    -- * Reading
    withValue,
    load,
    loadDefault
  ) where
  
  import Control.Exception
  import qualified Data.ByteString as BS
  import Data.Default
  import Data.Text (Text)
  import qualified Data.Text as Text
  import Data.Typeable (Typeable)
  
  import Thrift.Protocol (ThriftSerializable)
  import Thrift.Protocol.JSON (deserializeJSON)
  
  import Glean.Util.ConfigProvider as Config
  import Glean.Util.Observed as Observed
  
  -- | A source of values that may change over time.
  data ThriftSource a = ThriftSource
    { thriftSourceWith
        :: forall cfg b . (ConfigProvider cfg)
        => cfg
        -> (Observed a -> IO b)
        -> IO b
    , thriftSourceLoad :: forall cfg . (ConfigProvider cfg) => cfg -> IO a
    , thriftSourceShow :: String
    }
  
  -- | Load a configuration value from a source. The value isn't cached - use
  -- 'withValue' and 'Observed.get' for that.
  load
    :: (ConfigProvider cfg, Typeable a)
    => cfg
    -> ThriftSource a
    -> IO a
  load cfg t = thriftSourceLoad t cfg
  
  -- | Subscribe to a 'ThriftSource' - 'get' will produce the current value.
  --
  -- If actions are added to the 'Observed' via 'doOnUpdate', no further
  -- instances of the actions will be initiated after 'withValue'
  -- returns.
  --
  withValue
    :: (ConfigProvider cfg, Typeable a)
    => cfg
    -> ThriftSource a
    -> (Observed a -> IO b)
    -> IO b
  withValue cfg t = thriftSourceWith t cfg
  
  instance Show (ThriftSource a) where
    show = thriftSourceShow
  
  instance Functor ThriftSource where
    fmap f ThriftSource{..} = ThriftSource
      { thriftSourceWith = \cfg g -> thriftSourceWith cfg (\ob -> g (fmap f ob))
      , thriftSourceLoad = \cfg -> fmap f $ thriftSourceLoad cfg
      , .. }
  
  instance Default a => Default (ThriftSource a) where
    def = value def
  
  newtype ThriftSourceException = ThriftSourceException Text
    deriving(Show)
  
  instance Exception ThriftSourceException
  
  -- | A 'ThriftSource' whose value is obtained by looking up the given
  -- key using the 'ConfigProvider'.
  config
    :: Typeable a
    => ThriftSerializable a
    => Text
    -> ThriftSource a
  config path = configWithDeserializer path deserializeJSON
  
  -- | As 'config', except that 'Data.Default.def' is used if the config
  -- is missing.
  configDefault
    :: (Typeable a, Default a)
    => ThriftSerializable a
    => Text
    -> ThriftSource a
  configDefault path = configWithDeserializerDefault path deserializeJSON
  
  -- | A 'ThriftSource' whose value is obtained by looking up the given
  -- key using the 'ConfigProvider', and converting it using the given
  -- 'Deserializer'
  configWithDeserializer
    :: Typeable a
    => Text
    -> Deserializer a
    -> ThriftSource a
  configWithDeserializer path d = genericConfig path d (const return) Nothing
  
  -- | As 'configWithDeserializer' except that 'Data.Default.def' is
  -- used if the config is missing.
  configWithDeserializerDefault
    :: (Typeable a, Default a)
    => Text
    -> Deserializer a
    -> ThriftSource a
  configWithDeserializerDefault path d =
    genericConfig path d (const return) (Just def)
  
  genericConfig
    :: (Typeable c)
    => Text
    -> Deserializer c
    -> (forall cfg. ConfigProvider cfg => cfg -> c -> IO a)
    -> Maybe a
    -> ThriftSource a
  genericConfig key deserializer mkValue maybDefault = ThriftSource
    { thriftSourceWith = \cfg ->
        configWithValue cfg key deserializer mkValue maybDefault
    , thriftSourceLoad = \cfg ->
        configLoad cfg key deserializer mkValue maybDefault
    , thriftSourceShow = "ThriftSource Fixed"
    }
  
  file :: ThriftSerializable a => FilePath -> ThriftSource a
  file path = fileWithDeserializer path deserializeJSON
  
  fileWithDeserializer :: FilePath -> Deserializer a -> ThriftSource a
  fileWithDeserializer path deserializer = once $ do
    b <- BS.readFile path
    case deserializer b of
      Left err -> throwIO $ ThriftSourceException $ Text.pack $
        "invalid Thrift value in file '" ++ path ++ "': " ++ err
      Right a -> return a
  
  value :: a -> ThriftSource a
  value = once . return
  
  once :: IO a -> ThriftSource a
  once io = ThriftSource
    { thriftSourceWith = \_ f -> do x <- io; f (fixedValue x)
    , thriftSourceLoad = \_ -> io
    , thriftSourceShow = "ThriftSource Fixed"
    }
  
  changes :: Observed a -> ThriftSource a
  changes ob = ThriftSource
    { thriftSourceWith = \_ f -> f ob
    , thriftSourceLoad = \_ -> Observed.get ob
    , thriftSourceShow = "ThriftSource Changes"
    }
  
  mutable :: a -> IO (ThriftSource a, (a -> a) -> IO ())
  mutable x = do
    (ob, onUpdate) <- changingValue x
    return (changes ob, onUpdate)
  
  -- | Parser for  \"config:PATH\" and \"file:PATH\" providers
  parse
    :: (Typeable a, ThriftSerializable a)
    => String
    -> Either String (ThriftSource a)
  parse s = parseWithDeserializer s deserializeJSON
  
  -- | Parser for  \"config:PATH\" and \"file:PATH\" providers with a
  -- custom deserializer.
  parseWithDeserializer
    :: Typeable a
    => String
    -> Deserializer a
    -> Either String (ThriftSource a)
  parseWithDeserializer s des = case break (==':') s of
    ("config",':':path) ->
      Right $ configWithDeserializer (Text.pack path) des
    ("file",':':path) -> Right $ fileWithDeserializer path des
    (p,':':_) -> Left $ "unsupported Thrift provider '" ++ p ++ "'"
    _ -> Left $ "invalid Thrift source '" ++ s ++ "'"
  
  -- | Subscribe to a 'ThriftSource' - 'get' will produce the current value.
  --
  -- If actions are added to the 'Observed' via 'doOnUpdate', no further
  -- instances of the actions will be initiated after 'withValue'
  -- returns.
  --
  configWithValue
    :: (ConfigProvider cfg, Typeable c)
    => cfg
    -> Text
    -> Deserializer c
    -> (forall cfg. ConfigProvider cfg => cfg -> c -> IO a)
    -> Maybe a
    -> (Observed a -> IO b)
    -> IO b
  
  configWithValue cfgapi path deserialize mkValue maybeDefault action =
    do
      (ob, onUpdate) <- changingValue
        (error "ThriftSource.withValue: internal error")
      let
        callback new = do a <- mkValue cfgapi new; onUpdate (const a)
        acquire =
          (Just <$> subscribe cfgapi path callback deserialize)
            `catch` \e -> if
              | isConfigFailure cfgapi e, Just val <- maybeDefault -> do
                onUpdate (const val)
                return Nothing
              | otherwise -> throwIO e
      bracket acquire (mapM (cancel cfgapi)) $ const $ action ob
  
  configLoad
    :: (ConfigProvider cfg, Typeable c)
    => cfg
    -> Text
    -> Deserializer c
    -> (forall cfg. ConfigProvider cfg => cfg -> c -> IO a)
    -> Maybe a
    -> IO a
  configLoad cfgapi path deserialize mkValue maybeDefault =
    (do c <- Config.get cfgapi path deserialize; mkValue cfgapi c)
      `catch` \e -> if
        | isConfigFailure cfgapi e, Just val <- maybeDefault ->
          return val
        | otherwise -> throwIO e
  
  -- | Like 'load', but if the value cannot be retrieved then fall back
  -- to using the default value given by the 'Default' instance.
  loadDefault
    :: (ConfigProvider cfg, Default a, Typeable a)
    => cfg
    -> ThriftSource a
    -> IO a
  loadDefault cfgAPI ts =
    load cfgAPI ts `catch` \e ->
      if isConfigFailure cfgAPI e then return def else throwIO e
  