diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/freckle-app.cabal b/freckle-app.cabal --- a/freckle-app.cabal +++ b/freckle-app.cabal @@ -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 diff --git a/library/Freckle/App/Test.hs b/library/Freckle/App/Test.hs --- a/library/Freckle/App/Test.hs +++ b/library/Freckle/App/Test.hs @@ -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 () diff --git a/library/Freckle/App/Test/Logging.hs b/library/Freckle/App/Test/Logging.hs deleted file mode 100644 --- a/library/Freckle/App/Test/Logging.hs +++ /dev/null @@ -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 diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/tests/Freckle/App/MemcachedSpec.hs b/tests/Freckle/App/MemcachedSpec.hs --- a/tests/Freckle/App/MemcachedSpec.hs +++ b/tests/Freckle/App/MemcachedSpec.hs @@ -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\"") + ]