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 +11/−2
- LICENSE +1/−1
- freckle-app.cabal +5/−8
- library/Freckle/App/Env.hs +0/−172
- library/Freckle/App/Kafka.hs +0/−7
- library/Freckle/App/Kafka/Consumer.hs +0/−215
- library/Freckle/App/Kafka/Producer.hs +0/−168
- package.yaml +5/−3
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