freckle-app 1.3.0.0 → 1.4.0.0
raw patch · 6 files changed
+109/−167 lines, 6 filesdep −dlistdep −monad-loggerdep ~Blammodep ~Globdep ~MonadRandom
Dependencies removed: dlist, monad-logger
Dependency ranges changed: Blammo, Glob, MonadRandom, base, bugsnag, bytestring, case-insensitive, conduit, containers, datadog, directory, doctest, envparse, exceptions, filepath, hashable, http-client, http-types, lens, load-env, network-uri, persistent, persistent-postgresql, postgresql-simple, process, safe, semigroupoids, template-haskell, text, time, transformers, typed-process, unliftio, vector, wai, wai-extra, yaml, yesod-core
Files
- CHANGELOG.md +10/−1
- freckle-app.cabal +52/−55
- library/Freckle/App/Test.hs +1/−1
- library/Freckle/App/Test/Logging.hs +0/−57
- package.yaml +4/−6
- tests/Freckle/App/MemcachedSpec.hs +42/−47
CHANGELOG.md view
@@ -1,4 +1,13 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.3.0.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.4.0.0...main)++## [v1.4.0.0](https://github.com/freckle/freckle-app/compare/v1.3.0.0...v1.4.0.0)++- Remove `runCapturedLoggingT`++ We can use `Blammo.Logging.Logger.newTestLogger` instead. See `MemcachedSpec`+ as an example.++- Compatibility down to LTS 12.26 / GHC 8.4 ## [v1.3.0.0](https://github.com/freckle/freckle-app/compare/v1.2.0.2...v1.3.0.0)
freckle-app.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: freckle-app-version: 1.3.0.0+version: 1.4.0.0 license: MIT license-file: LICENSE maintainer: Freckle Education@@ -47,7 +47,6 @@ Freckle.App.Test Freckle.App.Test.DocTest Freckle.App.Test.Hspec.Runner- Freckle.App.Test.Logging Freckle.App.Version Freckle.App.Wai Freckle.App.Yesod@@ -68,64 +67,62 @@ TypeApplications TypeFamilies build-depends:- Blammo >=1.0.0.1,- Glob >=0.10.1,- MonadRandom >=0.5.2,+ Blammo >=1.0.2.2,+ Glob >=0.9.3,+ MonadRandom >=0.5.1.1, aeson >=1.5.2.0,- base >=4.13.0.0 && <5,- bugsnag >=1.0.0.0,- bytestring >=0.10.10.1,- case-insensitive >=1.2.1.0,- conduit >=1.3.4,- containers >=0.6.2.1,- datadog >=0.2.5.0,- dlist >=0.8.0.8,- doctest >=0.16.3,+ base >=4.11.1.0 && <5,+ bugsnag >=1.0.0.1,+ bytestring >=0.10.8.2,+ case-insensitive >=1.2.0.11,+ conduit >=1.3.1,+ containers >=0.5.11.0,+ datadog >=0.2.3.0,+ doctest >=0.16.0.1, ekg-core >=0.1.1.7,- envparse >=0.4.1,+ envparse >=0.5.0, errors >=2.3.0,- exceptions >=0.10.4,- filepath >=1.4.2.1,- hashable >=1.3.0.0,+ exceptions >=0.10.0,+ filepath >=1.4.2,+ hashable >=1.2.7.0, hspec >=2.8.1, hspec-core >=2.8.1, hspec-expectations-lifted >=0.10.0, hspec-junit-formatter >=1.1.0.1,- http-client >=0.6.4.1,+ http-client >=0.5.14, http-conduit >=2.3.5, http-link-header >=1.0.3.1,- http-types >=0.12.3,+ http-types >=0.12.2, immortal >=0.3,- lens >=4.18.1,- load-env >=0.2.1.0,+ lens >=4.16.1,+ load-env >=0.2.0.2, memcache >=0.3.0.1, monad-control >=1.0.2.3,- monad-logger >=0.3.31, mtl >=2.2.2,- network-uri >=2.6.3.0,- persistent >=2.10.5.3,- persistent-postgresql >=2.10.1.2,- postgresql-simple >=0.6.4,- primitive >=0.7.0.1,+ network-uri >=2.6.1.0,+ persistent >=2.9.0,+ persistent-postgresql >=2.9.0,+ postgresql-simple >=0.6.2,+ primitive >=0.7.4.0, resource-pool >=0.2.3.2, retry >=0.8.1.0,- safe >=0.3.19,+ safe >=0.3.17, scientist >=0.0.0.0,- semigroupoids >=5.3.4,- template-haskell >=2.15.0.0,- text >=1.2.4.0,- time >=1.9.3,- transformers >=0.5.6.2,+ semigroupoids >=5.2.2,+ template-haskell >=2.13.0.0,+ text >=1.2.3.1,+ time >=1.8.0.2,+ transformers >=0.5.5.0, transformers-base >=0.4.5.2,- typed-process >=0.2.6.0,- unliftio >=0.2.13.1,+ typed-process >=0.2.3.0,+ unliftio >=0.2.9.0, unliftio-core >=0.1.2.0, unordered-containers >=0.2.10.0,- vector >=0.12.1.2,- wai >=3.2.2.1,- wai-extra >=3.0.32,- yaml >=0.11.5.0,- yesod-core >=1.6.18.8+ vector >=0.12.0.2,+ wai >=3.2.1.2,+ wai-extra >=3.0.29,+ yaml >=0.8.32,+ yesod-core >=1.6.9 test-suite doctest type: exitcode-stdio-1.0@@ -143,7 +140,7 @@ TypeApplications TypeFamilies build-depends:- base >=4.13.0.0 && <5,+ base >=4.11.1.0 && <5, freckle-app -any test-suite gittest@@ -166,14 +163,14 @@ TypeApplications TypeFamilies build-depends:- base >=4.13.0.0 && <5,- directory >=1.3.6.0,+ base >=4.11.1.0 && <5,+ directory >=1.3.1.5, freckle-app -any, hspec >=2.8.1,- process >=1.6.9.0,+ process >=1.6.3.0, temporary >=1.3,- text >=1.2.4.0,- time >=1.9.3+ text >=1.2.3.1,+ time >=1.8.0.2 if flag(test-git) @@ -205,17 +202,17 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends:+ Blammo >=1.0.2.2, aeson >=1.5.2.0,- base >=4.13.0.0 && <5,- bytestring >=0.10.10.1,+ base >=4.11.1.0 && <5,+ bytestring >=0.10.8.2, errors >=2.3.0, freckle-app -any, hspec >=2.8.1,- http-types >=0.12.3,- lens >=4.18.1,+ http-types >=0.12.2,+ lens >=4.16.1, lens-aeson >=1.1, memcache >=0.3.0.1,- mtl >=2.2.2,- postgresql-simple >=0.6.4,- wai >=3.2.2.1,- wai-extra >=3.0.32+ postgresql-simple >=0.6.2,+ wai >=3.2.1.2,+ wai-extra >=3.0.29
library/Freckle/App/Test.hs view
@@ -140,7 +140,7 @@ loadEnvTest :: IO () loadEnvTest = loadEnvFrom ".env.test" >> loadEnv -expectationFailure :: MonadIO m => String -> m ()+expectationFailure :: (HasCallStack, MonadIO m) => String -> m a expectationFailure msg = Hspec.expectationFailure msg >> error "unreachable" pending :: MonadIO m => m ()
− library/Freckle/App/Test/Logging.hs
@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}--module Freckle.App.Test.Logging- ( MonadLogger- , LoggingT- , runCapturedLoggingT- , logLineToJSON- , logLineToByteString- , logLineToText- ) where--import Freckle.App.Prelude--import Control.Concurrent.Chan-import Control.Monad.Logger-import Data.Aeson-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as BSL-import Data.DList (DList)-import qualified Data.DList as DList-import UnliftIO.Async-import UnliftIO.Exception (finally)--#if !MIN_VERSION_monad_logger(0,3,32)-type LogLine = (Loc, LogSource, LogLevel, LogStr)-#endif---- | Run a 'LoggingT', capturing and returning any logged messages alongside------ This is 'runWriterLoggingT', but we're not able to supply a 'MonadUnliftIO'--- instance when using that.----runCapturedLoggingT :: MonadUnliftIO m => LoggingT m a -> m (a, [LogLine])-runCapturedLoggingT f = do- chan <- liftIO newChan- x <- async $ captureLog DList.empty chan- a <- runChanLoggingT chan $ f `finally` logInfoN doneMessage- msgs <- wait x- pure (a, DList.toList msgs)--captureLog :: MonadIO m => DList LogLine -> Chan LogLine -> m (DList LogLine)-captureLog acc chan = do- ll <- liftIO $ readChan chan- let txt = logLineToText ll- if txt == doneMessage then pure acc else captureLog (DList.snoc acc ll) chan--doneMessage :: Text-doneMessage = "%DONE%"--logLineToJSON :: FromJSON a => LogLine -> Maybe a-logLineToJSON = decode . BSL.fromStrict . logLineToByteString--logLineToByteString :: LogLine -> ByteString-logLineToByteString (_, _, _, str) = fromLogStr str--logLineToText :: LogLine -> Text-logLineToText = decodeUtf8 . logLineToByteString
package.yaml view
@@ -1,6 +1,6 @@ --- name: freckle-app-version: 1.3.0.0+version: 1.4.0.0 maintainer: Freckle Education category: Utils github: freckle/freckle-app@@ -62,7 +62,6 @@ - conduit - containers - datadog- - dlist - doctest - ekg-core - envparse@@ -75,7 +74,7 @@ - hspec-expectations-lifted - hspec-junit-formatter >= 1.1.0.1 - http-client- - http-conduit >= 2.3.5+ - http-conduit >= 2.3.5 # addToRequestQueryString - http-link-header - http-types - immortal@@ -83,7 +82,6 @@ - load-env - memcache - monad-control- - monad-logger >= 0.3.31 - mtl - network-uri - persistent@@ -91,7 +89,7 @@ - postgresql-simple - primitive - resource-pool- - retry >= 0.8.1.0+ - retry >= 0.8.1.0 # retryingDynamic - safe - scientist - semigroupoids@@ -116,6 +114,7 @@ source-dirs: tests ghc-options: -threaded -rtsopts "-with-rtsopts=-N" dependencies:+ - Blammo - aeson - bytestring - errors@@ -125,7 +124,6 @@ - lens - lens-aeson - memcache- - mtl - postgresql-simple - wai - wai-extra
tests/Freckle/App/MemcachedSpec.hs view
@@ -6,17 +6,17 @@ import Freckle.App.Test -import Control.Lens ((^?!))-import Control.Monad.Reader-import Data.Aeson-import Data.Aeson.Lens+import Blammo.Logging.LogSettings+import Blammo.Logging.Logger+import Control.Lens (lens)+import Data.Aeson (Value(..))+import Data.Aeson.Compat as KeyMap import qualified Data.List.NonEmpty as NE import qualified Freckle.App.Env as Env import Freckle.App.Memcached import Freckle.App.Memcached.Client (MemcachedClient, newMemcachedClient) import qualified Freckle.App.Memcached.Client as Memcached import Freckle.App.Memcached.Servers-import Freckle.App.Test.Logging data ExampleValue = A@@ -36,59 +36,54 @@ "C" -> Right C x -> Left $ "invalid: " <> show x --- |------ NB. we could use 'withApp' and not need to call this runner ourselves within--- an @'it'-'example'@ -- except that we want to use 'runCapturedLoggingT' and--- assert on the logged messages. We should add "Blammo.Logging.Test" to support--- this use-case.----runTestAppT- :: MonadUnliftIO m => AppExample MemcachedClient a -> m (a, [Maybe Value])-runTestAppT f = liftIO $ do- mc <- loadClient- fmap (second $ map logLineToJSON) $ runCapturedLoggingT $ runReaderT- (unAppExample f)- mc+data App = App+ { appMemcachedClient :: MemcachedClient+ , appLogger :: Logger+ } -loadClient :: IO MemcachedClient-loadClient = do+instance HasMemcachedClient App where+ memcachedClientL =+ lens appMemcachedClient $ \x y -> x { appMemcachedClient = y }++instance HasLogger App where+ loggerL = lens appLogger $ \x y -> x { appLogger = y }++loadApp :: IO App+loadApp = do servers <- Env.parse id $ Env.var (Env.eitherReader readMemcachedServers) "MEMCACHED_SERVERS" (Env.def defaultMemcachedServers)- newMemcachedClient servers + App <$> newMemcachedClient servers <*> newTestLogger defaultLogSettings+ spec :: Spec-spec = do+spec = withApp loadApp $ do describe "caching" $ do- it "caches the given action by key using Cachable" $ example $ do- void $ runTestAppT $ do- k <- cacheKeyThrow "A"+ it "caches the given action by key using Cachable" $ appExample $ do+ k <- cacheKeyThrow "A" - val <- caching k (cacheTTL 5) $ pure A- mbs <- Memcached.get k+ val <- caching k (cacheTTL 5) $ pure A+ mbs <- Memcached.get k - liftIO $ val `shouldBe` A- liftIO $ mbs `shouldBe` Just "A"+ val `shouldBe` A+ mbs `shouldBe` Just "A" - it "logs, but doesn't fail, on deserialization errors" $ example $ do- (_, msgs) <- runTestAppT $ do- k <- cacheKeyThrow "B"+ it "logs, but doesn't fail, on deserialization errors" $ appExample $ do+ k <- cacheKeyThrow "B" - val0 <- caching k (cacheTTL 5) $ pure B -- set- val1 <- caching k (cacheTTL 5) $ pure B -- get will fail- mbs <- Memcached.get k+ val0 <- caching k (cacheTTL 5) $ pure B -- set+ val1 <- caching k (cacheTTL 5) $ pure B -- get will fail+ mbs <- Memcached.get k - liftIO $ val0 `shouldBe` B- liftIO $ val1 `shouldBe` B- liftIO $ mbs `shouldBe` Just "Broken"+ val0 `shouldBe` B+ val1 `shouldBe` B+ mbs `shouldBe` Just "Broken" - let Just val = NE.last =<< NE.nonEmpty msgs- val ^?! key "text" . _String `shouldBe` "Error deserializing"- val ^?! key "meta" . key "action" . _String `shouldBe` "deserializing"- val- ^?! key "meta"- . key "message"- . _String- `shouldBe` "invalid: \"Broken\""+ msgs <- getLoggedMessagesLenient+ let Just LoggedMessage {..} = NE.last <$> NE.nonEmpty msgs+ loggedMessageText `shouldBe` "Error deserializing"+ loggedMessageMeta `shouldBe` KeyMap.fromList+ [ ("action", String "deserializing")+ , ("message", String "invalid: \"Broken\"")+ ]