packages feed

freckle-app 1.18.2.0 → 1.19.0.0

raw patch · 8 files changed

+22/−576 lines, 8 filesdep +freckle-envdep −envparsedep −hw-kafka-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: freckle-env

Dependencies removed: envparse, hw-kafka-client

API changes (from Hackage documentation)

- Freckle.App.Env: (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
- Freckle.App.Env: (<>) :: Semigroup a => a -> a -> a
- Freckle.App.Env: (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
- Freckle.App.Env: EmptyError :: Error
- Freckle.App.Env: Off :: a -> Off a
- Freckle.App.Env: On :: a -> On a
- Freckle.App.Env: TimeoutMilliseconds :: Int -> Timeout
- Freckle.App.Env: TimeoutSeconds :: Int -> Timeout
- Freckle.App.Env: UnreadError :: String -> Error
- Freckle.App.Env: UnsetError :: Error
- Freckle.App.Env: asum :: (Foldable t, Alternative f) => t (f a) -> f a
- Freckle.App.Env: auto :: (AsUnread e, Read a) => Reader e a
- Freckle.App.Env: char :: AsUnread e => Reader e Char
- Freckle.App.Env: class () => AsEmpty e
- Freckle.App.Env: class () => AsUnread e
- Freckle.App.Env: class () => AsUnset e
- Freckle.App.Env: class () => HasHelp (t :: Type -> Type)
- Freckle.App.Env: data () => Error
- Freckle.App.Env: data () => Flag a
- Freckle.App.Env: data () => Info e
- Freckle.App.Env: data () => Mod (t :: Type -> Type) a
- Freckle.App.Env: data () => Parser e a
- Freckle.App.Env: data Timeout
- Freckle.App.Env: data () => Var a
- Freckle.App.Env: def :: a -> Mod Var a
- Freckle.App.Env: defaultErrorHandler :: (AsUnset e, AsEmpty e, AsUnread e) => ErrorHandler e
- Freckle.App.Env: desc :: String -> Info e -> Info e
- Freckle.App.Env: eitherReader :: (String -> Either String a) -> Reader Error a
- Freckle.App.Env: empty :: AsEmpty e => e
- Freckle.App.Env: flag :: Off a -> On a -> String -> Mod Flag a -> Parser Error a
- Freckle.App.Env: footer :: String -> Info e -> Info e
- Freckle.App.Env: handleError :: ErrorHandler e -> Info x -> Info e
- Freckle.App.Env: header :: String -> Info e -> Info e
- Freckle.App.Env: help :: forall (t :: Type -> Type) a. HasHelp t => String -> Mod t a
- Freckle.App.Env: helpDef :: (a -> String) -> Mod Var a
- Freckle.App.Env: helpDoc :: Parser e a -> String
- Freckle.App.Env: infixr 1 <=<
- Freckle.App.Env: infixr 6 <>
- Freckle.App.Env: instance GHC.Classes.Eq Freckle.App.Env.Timeout
- Freckle.App.Env: instance GHC.Show.Show Freckle.App.Env.Timeout
- Freckle.App.Env: keyValue :: Char -> Reader Error (Text, Text)
- Freckle.App.Env: keyValues :: Reader Error [(Text, Text)]
- Freckle.App.Env: newtype Off a
- Freckle.App.Env: newtype On a
- Freckle.App.Env: nonempty :: (AsEmpty e, IsString s) => Reader e s
- Freckle.App.Env: optional :: Alternative f => f a -> f (Maybe a)
- Freckle.App.Env: parse :: AsUnset e => (Info Error -> Info e) -> Parser e a -> IO a
- Freckle.App.Env: parseOr :: AsUnset e => (String -> IO a) -> (Info Error -> Info e) -> Parser e b -> IO (Either a b)
- Freckle.App.Env: parsePure :: AsUnset e => Parser e a -> [(String, String)] -> Either [(String, e)] a
- Freckle.App.Env: prefixed :: String -> Parser e a -> Parser e a
- Freckle.App.Env: sensitive :: Parser e a -> Parser e a
- Freckle.App.Env: splitOn :: Char -> Reader e [String]
- Freckle.App.Env: splitOnParse :: Char -> Reader e a -> Reader e [a]
- Freckle.App.Env: str :: IsString s => Reader e s
- Freckle.App.Env: switch :: String -> Mod Flag Bool -> Parser e Bool
- Freckle.App.Env: time :: String -> Reader Error UTCTime
- Freckle.App.Env: timeout :: Reader Error Timeout
- Freckle.App.Env: tryEmpty :: AsEmpty e => e -> Maybe ()
- Freckle.App.Env: tryUnread :: AsUnread e => e -> Maybe String
- Freckle.App.Env: tryUnset :: AsUnset e => e -> Maybe ()
- Freckle.App.Env: type ErrorHandler e = String -> e -> Maybe String
- Freckle.App.Env: type Reader e a = String -> Either e a
- Freckle.App.Env: unread :: AsUnread e => String -> e
- Freckle.App.Env: unset :: AsUnset e => e
- Freckle.App.Env: var :: AsUnset e => Reader e a -> String -> Mod Var a -> Parser e a
- Freckle.App.Kafka.Consumer: KafkaConsumerConfig :: NonEmpty BrokerAddress -> ConsumerGroupId -> TopicName -> OffsetReset -> Millis -> Map Text Text -> KafkaConsumerConfig
- Freckle.App.Kafka.Consumer: [kafkaConsumerConfigAutoCommitInterval] :: KafkaConsumerConfig -> Millis
- Freckle.App.Kafka.Consumer: [kafkaConsumerConfigBrokerAddresses] :: KafkaConsumerConfig -> NonEmpty BrokerAddress
- Freckle.App.Kafka.Consumer: [kafkaConsumerConfigExtraSubscriptionProps] :: KafkaConsumerConfig -> Map Text Text
- Freckle.App.Kafka.Consumer: [kafkaConsumerConfigGroupId] :: KafkaConsumerConfig -> ConsumerGroupId
- Freckle.App.Kafka.Consumer: [kafkaConsumerConfigOffsetReset] :: KafkaConsumerConfig -> OffsetReset
- Freckle.App.Kafka.Consumer: [kafkaConsumerConfigTopic] :: KafkaConsumerConfig -> TopicName
- Freckle.App.Kafka.Consumer: class HasKafkaConsumer env
- Freckle.App.Kafka.Consumer: data KafkaConsumerConfig
- Freckle.App.Kafka.Consumer: envKafkaConsumerConfig :: Parser Error KafkaConsumerConfig
- Freckle.App.Kafka.Consumer: instance GHC.Exception.Type.Exception Freckle.App.Kafka.Consumer.KafkaMessageDecodeError
- Freckle.App.Kafka.Consumer: instance GHC.Show.Show Freckle.App.Kafka.Consumer.KafkaConsumerConfig
- Freckle.App.Kafka.Consumer: instance GHC.Show.Show Freckle.App.Kafka.Consumer.KafkaMessageDecodeError
- Freckle.App.Kafka.Consumer: kafkaConsumerL :: HasKafkaConsumer env => Lens' env KafkaConsumer
- Freckle.App.Kafka.Consumer: runConsumer :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadLogger m, MonadTracer m, HasKafkaConsumer env, FromJSON a, HasCallStack) => Timeout -> (a -> m ()) -> m ()
- Freckle.App.Kafka.Consumer: withKafkaConsumer :: (MonadUnliftIO m, HasCallStack) => KafkaConsumerConfig -> (KafkaConsumer -> m a) -> m a
- Freckle.App.Kafka.Producer: KafkaProducerPool :: Pool KafkaProducer -> KafkaProducerPool
- Freckle.App.Kafka.Producer: KafkaProducerPoolConfig :: Int -> NominalDiffTime -> Int -> KafkaProducerPoolConfig
- Freckle.App.Kafka.Producer: NullKafkaProducerPool :: KafkaProducerPool
- Freckle.App.Kafka.Producer: [kafkaProducerPoolConfigIdleTimeout] :: KafkaProducerPoolConfig -> NominalDiffTime
- Freckle.App.Kafka.Producer: [kafkaProducerPoolConfigSize] :: KafkaProducerPoolConfig -> Int
- Freckle.App.Kafka.Producer: [kafkaProducerPoolConfigStripes] :: KafkaProducerPoolConfig -> Int
- Freckle.App.Kafka.Producer: class HasKafkaProducerPool env
- Freckle.App.Kafka.Producer: createKafkaProducerPool :: NonEmpty BrokerAddress -> KafkaProducerPoolConfig -> IO (Pool KafkaProducer)
- Freckle.App.Kafka.Producer: data KafkaProducerPool
- Freckle.App.Kafka.Producer: data KafkaProducerPoolConfig
- Freckle.App.Kafka.Producer: envKafkaBrokerAddresses :: Parser Error (NonEmpty BrokerAddress)
- Freckle.App.Kafka.Producer: envKafkaProducerPoolConfig :: Parser Error KafkaProducerPoolConfig
- Freckle.App.Kafka.Producer: instance Freckle.App.Kafka.Producer.HasKafkaProducerPool site => Freckle.App.Kafka.Producer.HasKafkaProducerPool (Yesod.Core.Types.HandlerData child site)
- Freckle.App.Kafka.Producer: instance GHC.Show.Show Freckle.App.Kafka.Producer.KafkaProducerPoolConfig
- Freckle.App.Kafka.Producer: kafkaProducerPoolL :: HasKafkaProducerPool env => Lens' env KafkaProducerPool
- Freckle.App.Kafka.Producer: produceKeyedOn :: (MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m, HasKafkaProducerPool env, ToJSON key, ToJSON value) => TopicName -> NonEmpty value -> (value -> key) -> m ()
- Freckle.App.Kafka.Producer: produceKeyedOnAsync :: (MonadMask m, MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m, HasKafkaProducerPool env, ToJSON key, ToJSON value) => TopicName -> NonEmpty value -> (value -> key) -> m ()

Files

CHANGELOG.md view
@@ -1,6 +1,15 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.18.2.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.19.0.0...main) -## [v1.18.2.0](https://github.com/freckle/freckle-app/compare/v1.18.1.0...v1.18.2.0)+## [v1.19.0.0](https://github.com/freckle/freckle-app/compare/freckle-app-v1.18.2.0...freckle-app-v1.19.0.0)++- Removed `Freckle.App.Kafka(.*)`; this is now available from the `freckle-kafka`+  package. If you are using `freckle-app` but not Kafka, you no longer need+  to also install the native Kafka library to build `freckle-app`. Please see+  opening the change log entry in `freckle-kafka` for notes on how to upgrade.+- `Freckle.App.Env` is now a re-export from the new `freckle-env` package.+  Its API has not changed.++## [v1.18.2.0](https://github.com/freckle/freckle-app/compare/v1.18.1.0...freckle-app-v1.18.2.0)  - Add `Freckle.App.Test.Properties.PersistValue` (`prop_roundTripPersistValue`) - Support and require `Blammo` `>= 2` to accommodate the extraction of the
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2021 Renaissance Learning Inc+Copyright (c) 2021-2024 Renaissance Learning Inc  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
freckle-app.cabal view
@@ -1,6 +1,6 @@-cabal-version:      1.18+cabal-version:      1.22 name:               freckle-app-version:            1.18.2.0+version:            1.19.0.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education@@ -31,7 +31,6 @@         Freckle.App.Database         Freckle.App.Dotenv         Freckle.App.Ecs-        Freckle.App.Env         Freckle.App.Exception         Freckle.App.Exception.MonadThrow         Freckle.App.Exception.MonadUnliftIO@@ -48,9 +47,6 @@         Freckle.App.Http.Paginate         Freckle.App.Http.Retry         Freckle.App.Json.Empty-        Freckle.App.Kafka-        Freckle.App.Kafka.Consumer-        Freckle.App.Kafka.Producer         Freckle.App.Memcached         Freckle.App.Memcached.CacheKey         Freckle.App.Memcached.CacheTTL@@ -82,6 +78,7 @@         Network.Wai.Middleware.Stats         Yesod.Core.Lens +    reexported-modules: Freckle.App.Env     hs-source-dirs:     library     other-modules:      Paths_freckle_app     default-language:   GHC2021@@ -123,12 +120,12 @@         doctest >=0.20.1,         dotenv >=0.10.0.0,         ekg-core >=0.1.1.7,-        envparse >=0.5.0,         errors >=2.3.0,         exceptions >=0.10.4,         extra >=1.7.13,         faktory >=1.1.2.4,         filepath >=1.4.2.2,+        freckle-env >=0.0.0.0,         hashable >=1.4.2.0,         hs-opentelemetry-api >=0.1.0.0,         hs-opentelemetry-instrumentation-persistent >=0.1.0.0,@@ -142,7 +139,6 @@         http-conduit >=2.3.5,         http-link-header >=1.2.1,         http-types >=0.12.3,-        hw-kafka-client >=5.0.0,         immortal >=0.3,         lens >=5.1.1,         memcache >=0.3.0.1,@@ -261,6 +257,7 @@         conduit >=1.3.5,         errors >=2.3.0,         freckle-app,+        freckle-env >=0.0.0.0,         hs-opentelemetry-api >=0.1.0.0,         hspec >=2.10.10,         hspec-expectations-json >=1.0.0.7,
− library/Freckle/App/Env.hs
@@ -1,172 +0,0 @@--- | Parse the shell environment for configuration------ A minor extension of [envparse](https://hackage.haskell.org/package/envparse).------ Usage:------ > import Freckle.App.Env--- >--- > data Config = Config -- Example--- >   { cBatchSize :: Natural--- >   , cDryRun :: Bool--- >   , cLogLevel :: LogLevel--- >   }--- >--- > loadConfig :: IO Config--- > loadConfig = parse $ Config--- >   <$> var auto "BATCH_SIZE" (def 1)--- >   <*> switch "DRY_RUN" mempty--- >   <*> flag (Off LevelInfo) (On LevelDebug) "DEBUG" mempty-module Freckle.App.Env-  ( module Env--    -- * Replacements-  , Off (..)-  , On (..)-  , flag--    -- * Extensions-  , Timeout (..)-  , eitherReader-  , time-  , keyValues-  , keyValue-  , splitOnParse-  , timeout-  ) where--import Freckle.App.Prelude--import Control.Error.Util (note)-import Data.Char (isDigit)-import Data.Text qualified as T-import Data.Time (defaultTimeLocale, parseTimeM)-import Env hiding (flag)-import Env qualified-import Prelude qualified as Unsafe (read)---- | Designates the value of a parameter when a flag is not provided.-newtype Off a = Off a---- | Designates the value of a parameter when a flag is provided.-newtype On a = On a---- | Parse a simple flag------ If the variable is present and non-empty in the environment, the active value--- is returned, otherwise the default is used.------ >>> import Blammo.Logging (LogLevel(..))------ >>> flag (Off LevelInfo) (On LevelDebug) "DEBUG" mempty `parsePure` [("DEBUG", "1")]--- Right LevelDebug------ >>> flag (Off LevelInfo) (On LevelDebug) "DEBUG" mempty `parsePure` [("DEBUG", "")]--- Right LevelInfo------ >>> flag (Off LevelInfo) (On LevelDebug) "DEBUG" mempty `parsePure` []--- Right LevelInfo------ N.B. only the empty string is falsey:------ >>> flag (Off LevelInfo) (On LevelDebug) "DEBUG" mempty `parsePure` [("DEBUG", "false")]--- Right LevelDebug------ >>> flag (Off LevelInfo) (On LevelDebug) "DEBUG" mempty `parsePure` [("DEBUG", "no")]--- Right LevelDebug-flag :: Off a -> On a -> String -> Mod Flag a -> Parser Error a-flag (Off f) (On t) n m = Env.flag f t n m---- | Create a 'Reader' from a simple parser function------ This is a building-block for other 'Reader's-eitherReader :: (String -> Either String a) -> Reader Error a-eitherReader f s = first (unread . suffix) $ f s- where-  suffix x = x <> ": " <> show s---- | Read a time value using the given format------ >>> var (time "%Y-%m-%d") "TIME" mempty `parsePure` [("TIME", "1985-02-12")]--- Right 1985-02-12 00:00:00 UTC------ >>> var (time "%Y-%m-%d") "TIME" mempty `parsePure` [("TIME", "10:00PM")]--- Left [("TIME",UnreadError "unable to parse time as %Y-%m-%d: \"10:00PM\"")]-time :: String -> Reader Error UTCTime-time fmt =-  eitherReader $-    note ("unable to parse time as " <> fmt)-      . parseTimeM True defaultTimeLocale fmt---- | Read key-value pairs------ >>> var keyValues "TAGS" mempty `parsePure` [("TAGS", "foo:bar,baz:bat")]--- Right [("foo","bar"),("baz","bat")]------ Value-less keys are not supported:------ >>> var keyValues "TAGS" mempty `parsePure` [("TAGS", "foo,baz:bat")]--- Left [("TAGS",UnreadError "Key foo has no value: \"foo\"")]------ Nor are key-less values:------ >>> var keyValues "TAGS" mempty `parsePure` [("TAGS", "foo:bar,:bat")]--- Left [("TAGS",UnreadError "Value bat has no key: \":bat\"")]-keyValues :: Reader Error [(Text, Text)]-keyValues = splitOnParse ',' $ keyValue ':'--keyValue :: Char -> Reader Error (Text, Text)-keyValue c =-  eitherReader $ go . second (T.drop 1) . T.breakOn (T.singleton c) . pack- where-  go = \case-    (k, v) | T.null v -> Left $ "Key " <> unpack k <> " has no value"-    (k, v) | T.null k -> Left $ "Value " <> unpack v <> " has no key"-    (k, v) -> Right (k, v)---- | Use 'splitOn' then call the given 'Reader' on each element------ @--- 'splitOnParse' c pure == 'splitOn' c--- @------ >>> var (splitOnParse @Error ',' nonempty) "X" mempty `parsePure` [("X", "a,b")]--- Right ["a","b"]------ >>> var (splitOnParse @Error ',' nonempty) "X" mempty `parsePure` [("X", ",,")]--- Left [("X",EmptyError)]-splitOnParse :: Char -> Reader e a -> Reader e [a]-splitOnParse c p = traverse p <=< splitOn c---- | Represents a timeout in seconds or milliseconds-data Timeout-  = TimeoutSeconds Int-  | TimeoutMilliseconds Int-  deriving stock (Show, Eq)---- | Read a timeout value as seconds or milliseconds------ >>> var timeout "TIMEOUT" mempty `parsePure` [("TIMEOUT", "10")]--- Right (TimeoutSeconds 10)------ >>> var timeout "TIMEOUT" mempty `parsePure` [("TIMEOUT", "10s")]--- Right (TimeoutSeconds 10)------ >>> var timeout "TIMEOUT" mempty `parsePure` [("TIMEOUT", "10ms")]--- Right (TimeoutMilliseconds 10)------ >>> var timeout "TIMEOUT" mempty `parsePure` [("TIMEOUT", "20m")]--- Left [("TIMEOUT",UnreadError "must be {digits}(s|ms): \"20m\"")]------ >>> var timeout "TIMEOUT" mempty `parsePure` [("TIMEOUT", "2m0")]--- Left [("TIMEOUT",UnreadError "must be {digits}(s|ms): \"2m0\"")]-timeout :: Reader Error Timeout-timeout = eitherReader $ parseTimeout . span isDigit- where-  parseTimeout = \case-    ("", _) -> Left "must be {digits}(s|ms)"-    (digits, "") -> Right $ TimeoutSeconds $ Unsafe.read digits-    (digits, "s") -> Right $ TimeoutSeconds $ Unsafe.read digits-    (digits, "ms") ->-      Right $ TimeoutMilliseconds $ Unsafe.read digits-    _ -> Left "must be {digits}(s|ms)"
− library/Freckle/App/Kafka.hs
@@ -1,7 +0,0 @@-module Freckle.App.Kafka-  ( module Freckle.App.Kafka.Consumer-  , module Freckle.App.Kafka.Producer-  ) where--import Freckle.App.Kafka.Consumer-import Freckle.App.Kafka.Producer
− library/Freckle/App/Kafka/Consumer.hs
@@ -1,215 +0,0 @@-{-# LANGUAGE ApplicativeDo #-}--module Freckle.App.Kafka.Consumer-  ( HasKafkaConsumer (..)-  , withKafkaConsumer-  , KafkaConsumerConfig (..)-  , envKafkaConsumerConfig-  , runConsumer-  ) where--import Freckle.App.Prelude--import Blammo.Logging-import Control.Lens (Lens', view)-import Control.Monad (forever)-import Data.Aeson-import Data.ByteString (ByteString)-import Data.List.NonEmpty qualified as NE-import Data.Map.Strict qualified as Map-import Data.Text qualified as T-import Env qualified-import Freckle.App.Async-import Freckle.App.Env-import Freckle.App.Exception (annotatedExceptionMessageFrom)-import Freckle.App.Kafka.Producer (envKafkaBrokerAddresses)-import Freckle.App.OpenTelemetry-import Freckle.App.OpenTelemetry.ThreadContext-import Kafka.Consumer hiding-  ( Timeout-  , closeConsumer-  , newConsumer-  , runConsumer-  , subscription-  )-import Kafka.Consumer qualified as Kafka-import UnliftIO.Exception (bracket)--data KafkaConsumerConfig = KafkaConsumerConfig-  { kafkaConsumerConfigBrokerAddresses :: NonEmpty BrokerAddress-  -- ^ The list of host/port pairs for establishing the initial connection-  -- to the Kafka cluster.-  ---  -- This is the `bootstrap.servers` Kafka consumer configuration property.-  , kafkaConsumerConfigGroupId :: ConsumerGroupId-  -- ^ The consumer group id to which the consumer belongs.-  ---  -- This is the `group.id` Kafka consumer configuration property.-  , kafkaConsumerConfigTopic :: TopicName-  -- ^ The topic name polled for messages by the Kafka consumer.-  , kafkaConsumerConfigOffsetReset :: OffsetReset-  -- ^ The offset reset parameter used when there is no initial offset in Kafka.-  ---  -- This is the `auto.offset.reset` Kafka consumer configuration property.-  , kafkaConsumerConfigAutoCommitInterval :: Millis-  -- ^ The interval that offsets are auto-committed to Kafka.-  ---  -- This sets the `auto.commit.interval.ms` and `enable.auto.commit` Kafka-  -- consumer configuration properties.-  , kafkaConsumerConfigExtraSubscriptionProps :: Map Text Text-  -- ^ Extra properties used to configure the Kafka consumer.-  }-  deriving stock (Show)--envKafkaTopic-  :: Env.Parser Env.Error TopicName-envKafkaTopic =-  Env.var-    (eitherReader readKafkaTopic)-    "KAFKA_TOPIC"-    mempty--readKafkaTopic :: String -> Either String TopicName-readKafkaTopic t = case T.pack t of-  "" -> Left "Kafka topics cannot be empty"-  x -> Right $ TopicName x--envKafkaOffsetReset-  :: Env.Parser Env.Error OffsetReset-envKafkaOffsetReset =-  Env.var-    (eitherReader readKafkaOffsetReset)-    "KAFKA_OFFSET_RESET"-    $ Env.def Earliest--readKafkaOffsetReset :: String -> Either String OffsetReset-readKafkaOffsetReset t = case T.pack t of-  "earliest" -> Right Earliest-  "latest" -> Right Latest-  _ -> Left "Kafka offset reset must be one of earliest or latest"--envKafkaConsumerConfig-  :: Env.Parser Env.Error KafkaConsumerConfig-envKafkaConsumerConfig = do-  brokerAddresses <- envKafkaBrokerAddresses-  consumerGroupId <- Env.var Env.nonempty "KAFKA_CONSUMER_GROUP_ID" mempty-  kafkaTopic <- envKafkaTopic-  kafkaOffsetReset <- envKafkaOffsetReset-  kafkaAutoOffsetInterval <--    fromIntegral . timeoutMs <$$> Env.var timeout "KAFKA_AUTO_COMMIT_INTERVAL" $-      Env.def $-        TimeoutMilliseconds 5000-  kafkaExtraProps <--    Env.var-      (fmap Map.fromList . keyValues)-      "KAFKA_EXTRA_SUBSCRIPTION_PROPS"-      (Env.def mempty)-  pure $-    KafkaConsumerConfig-      brokerAddresses-      consumerGroupId-      kafkaTopic-      kafkaOffsetReset-      kafkaAutoOffsetInterval-      kafkaExtraProps--class HasKafkaConsumer env where-  kafkaConsumerL :: Lens' env KafkaConsumer--consumerProps :: KafkaConsumerConfig -> ConsumerProperties-consumerProps KafkaConsumerConfig {..} =-  brokersList brokers-    <> groupId kafkaConsumerConfigGroupId-    <> autoCommit kafkaConsumerConfigAutoCommitInterval-    <> logLevel KafkaLogInfo- where-  brokers = NE.toList kafkaConsumerConfigBrokerAddresses--subscription :: KafkaConsumerConfig -> Subscription-subscription KafkaConsumerConfig {..} =-  topics [kafkaConsumerConfigTopic]-    <> offsetReset kafkaConsumerConfigOffsetReset-    <> extraSubscriptionProps kafkaConsumerConfigExtraSubscriptionProps--withKafkaConsumer-  :: (MonadUnliftIO m, HasCallStack)-  => KafkaConsumerConfig-  -> (KafkaConsumer -> m a)-  -> m a-withKafkaConsumer config = bracket newConsumer closeConsumer- where-  (props, sub) = (consumerProps &&& subscription) config-  newConsumer = either throwM pure =<< Kafka.newConsumer props sub-  closeConsumer = maybe (pure ()) throwM <=< Kafka.closeConsumer--timeoutMs :: Timeout -> Int-timeoutMs = \case-  TimeoutSeconds s -> s * 1000-  TimeoutMilliseconds ms -> ms--data KafkaMessageDecodeError = KafkaMessageDecodeError-  { input :: ByteString-  , errors :: String-  }-  deriving stock (Show)--instance Exception KafkaMessageDecodeError where-  displayException KafkaMessageDecodeError {..} =-    mconcat-      [ "Unable to decode JSON"-      , "\n  input:  " <> unpack (decodeUtf8 input)-      , "\n  errors: " <> errors-      ]--runConsumer-  :: ( MonadMask m-     , MonadUnliftIO m-     , MonadReader env m-     , MonadLogger m-     , MonadTracer m-     , HasKafkaConsumer env-     , FromJSON a-     , HasCallStack-     )-  => Timeout-  -> (a -> m ())-  -> m ()-runConsumer pollTimeout onMessage =-  withTraceContext $ immortalCreateLogged $ forever $ do-    consumer <- view kafkaConsumerL--    flip catches handlers $ inSpan "kafka.consumer" consumerSpanArguments $ do-      mRecord <- fromKafkaError =<< pollMessage consumer kTimeout--      for_ (crValue =<< mRecord) $ \bs -> do-        a <--          inSpan "kafka.consumer.message.decode" defaultSpanArguments $-            either (throwM . KafkaMessageDecodeError bs) pure $-              eitherDecodeStrict bs-        inSpan "kafka.consumer.message.handle" defaultSpanArguments $ onMessage a- where-  kTimeout = Kafka.Timeout $ timeoutMs pollTimeout--  handlers =-    [ ExceptionHandler $-        logErrorNS "kafka"-          . annotatedExceptionMessageFrom @KafkaError-            (const "Error polling for message from Kafka")-    , ExceptionHandler $-        logErrorNS "kafka"-          . annotatedExceptionMessageFrom @KafkaMessageDecodeError-            (const "Could not decode message value")-    ]--fromKafkaError-  :: (MonadIO m, MonadLogger m, HasCallStack)-  => Either KafkaError a-  -> m (Maybe a)-fromKafkaError =-  either-    ( \case-        KafkaResponseError RdKafkaRespErrTimedOut ->-          Nothing <$ logDebug "Polling timeout"-        err -> throwM err-    )-    $ pure . Just
− library/Freckle/App/Kafka/Producer.hs
@@ -1,168 +0,0 @@-{-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE NamedFieldPuns #-}--module Freckle.App.Kafka.Producer-  ( envKafkaBrokerAddresses-  , KafkaProducerPoolConfig (..)-  , envKafkaProducerPoolConfig-  , KafkaProducerPool (..)-  , HasKafkaProducerPool (..)-  , createKafkaProducerPool-  , produceKeyedOn-  , produceKeyedOnAsync-  ) where--import Freckle.App.Prelude--import Blammo.Logging-import Control.Lens (Lens', view)-import Data.Aeson (ToJSON, encode)-import Data.ByteString.Lazy (toStrict)-import Data.HashMap.Strict qualified as HashMap-import Data.List.NonEmpty qualified as NE-import Data.Pool (Pool)-import Data.Pool qualified as Pool-import Data.Text qualified as T-import Freckle.App.Async (async)-import Freckle.App.Env qualified as Env-import Freckle.App.OpenTelemetry-import Kafka.Producer-import OpenTelemetry.Trace qualified as Trace-import UnliftIO (withRunInIO)-import Yesod.Core.Lens-import Yesod.Core.Types (HandlerData)--envKafkaBrokerAddresses-  :: Env.Parser Env.Error (NonEmpty BrokerAddress)-envKafkaBrokerAddresses =-  Env.var-    (Env.eitherReader readKafkaBrokerAddresses)-    "KAFKA_BROKER_ADDRESSES"-    mempty--readKafkaBrokerAddresses :: String -> Either String (NonEmpty BrokerAddress)-readKafkaBrokerAddresses t = case NE.nonEmpty $ T.splitOn "," $ T.pack t of-  Just xs@(x NE.:| _)-    | x /= "" -> Right $ BrokerAddress <$> xs-  _ -> Left "Broker Address cannot be empty"--data KafkaProducerPoolConfig = KafkaProducerPoolConfig-  { kafkaProducerPoolConfigStripes :: Int-  -- ^ The number of stripes (distinct sub-pools) to maintain.-  -- The smallest acceptable value is 1.-  , kafkaProducerPoolConfigIdleTimeout :: NominalDiffTime-  -- ^ Amount of time for which an unused resource is kept open.-  -- The smallest acceptable value is 0.5 seconds.-  ---  -- The elapsed time before destroying a resource may be a little-  -- longer than requested, as the reaper thread wakes at 1-second-  -- intervals.-  , kafkaProducerPoolConfigSize :: Int-  -- ^ Maximum number of resources to keep open per stripe.  The-  -- smallest acceptable value is 1.-  ---  -- Requests for resources will block if this limit is reached on a-  -- single stripe, even if other stripes have idle resources-  -- available.-  }-  deriving stock (Show)---- | Same defaults as 'Database.Persist.Sql.ConnectionPoolConfig'-defaultKafkaProducerPoolConfig :: KafkaProducerPoolConfig-defaultKafkaProducerPoolConfig = KafkaProducerPoolConfig 1 600 10--envKafkaProducerPoolConfig-  :: Env.Parser Env.Error KafkaProducerPoolConfig-envKafkaProducerPoolConfig = do-  poolSize <- Env.var Env.auto "KAFKA_PRODUCER_POOL_SIZE" $ Env.def 10-  pure $ defaultKafkaProducerPoolConfig {kafkaProducerPoolConfigSize = poolSize}--data KafkaProducerPool-  = NullKafkaProducerPool-  | KafkaProducerPool (Pool KafkaProducer)--class HasKafkaProducerPool env where-  kafkaProducerPoolL :: Lens' env KafkaProducerPool--instance HasKafkaProducerPool site => HasKafkaProducerPool (HandlerData child site) where-  kafkaProducerPoolL = envL . siteL . kafkaProducerPoolL--createKafkaProducerPool-  :: NonEmpty BrokerAddress-  -> KafkaProducerPoolConfig-  -> IO (Pool KafkaProducer)-createKafkaProducerPool addresses KafkaProducerPoolConfig {..} =-  Pool.newPool $-    Pool.setNumStripes (Just kafkaProducerPoolConfigStripes) $-      Pool.defaultPoolConfig-        mkProducer-        closeProducer-        (realToFrac kafkaProducerPoolConfigIdleTimeout)-        kafkaProducerPoolConfigSize- where-  mkProducer =-    either-      (\err -> throwString ("Failed to open kafka producer: " <> show err))-      pure-      =<< newProducer (brokersList $ toList addresses)--produceKeyedOn-  :: ( MonadUnliftIO m-     , MonadLogger m-     , MonadTracer m-     , MonadReader env m-     , HasKafkaProducerPool env-     , ToJSON key-     , ToJSON value-     )-  => TopicName-  -> NonEmpty value-  -> (value -> key)-  -> m ()-produceKeyedOn prTopic values keyF = traced $ do-  logDebugNS "kafka" $ "Producing Kafka events" :# ["events" .= values]-  view kafkaProducerPoolL >>= \case-    NullKafkaProducerPool -> pure ()-    KafkaProducerPool producerPool ->-      withRunInIO $ \run ->-        Pool.withResource producerPool $ \producer ->-          for_ @NonEmpty values $ \value -> do-            mError <- liftIO $ produceMessage producer $ mkProducerRecord value-            for_ @Maybe mError $ \e ->-              run $ logErrorNS "kafka" $ "Failed to send event" :# ["error" .= tshow e]- where-  mkProducerRecord value =-    ProducerRecord-      { prTopic-      , prPartition = UnassignedPartition-      , prKey = Just $ toStrict $ encode $ keyF value-      , prValue = Just $ toStrict $ encode value-      , prHeaders = mempty-      }--  traced =-    inSpan-      "kafka.produce"-      producerSpanArguments-        { Trace.attributes =-            HashMap.fromList-              [ ("service.name", "kafka")-              , ("topic", Trace.toAttribute $ unTopicName prTopic)-              ]-        }--produceKeyedOnAsync-  :: ( MonadMask m-     , MonadUnliftIO m-     , MonadLogger m-     , MonadTracer m-     , MonadReader env m-     , HasKafkaProducerPool env-     , ToJSON key-     , ToJSON value-     )-  => TopicName-  -> NonEmpty value-  -> (value -> key)-  -> m ()-produceKeyedOnAsync prTopic values = void . async . produceKeyedOn prTopic values
package.yaml view
@@ -1,5 +1,5 @@ name: freckle-app-version: 1.18.2.0+version: 1.19.0.0 maintainer: Freckle Education category: Utils github: freckle/freckle-app@@ -54,6 +54,8 @@  library:   source-dirs: library+  reexported-modules:+    - Freckle.App.Env   dependencies:     - Blammo >= 2.0.0.0     - Blammo-wai@@ -78,12 +80,12 @@     - doctest     - dotenv     - ekg-core-    - envparse     - errors     - exceptions     - extra     - faktory     - filepath+    - freckle-env     - hashable     - hs-opentelemetry-api     - hs-opentelemetry-instrumentation-persistent@@ -97,7 +99,6 @@     - http-conduit >= 2.3.5 # addToRequestQueryString     - http-link-header     - http-types-    - hw-kafka-client     - immortal     - lens     - memcache@@ -153,6 +154,7 @@       - conduit       - errors       - freckle-app+      - freckle-env       - hs-opentelemetry-api       - hspec       - hspec-expectations-json