diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ Snap Framework Core =================== -[![Build Status](https://travis-ci.org/snapframework/snap-core.svg?branch=master)](https://travis-ci.org/snapframework/snap-core) +[![GitHub CI](https://github.com/snapframework/snap-core/workflows/CI/badge.svg)](https://github.com/snapframework/snap-core/actions) Snap is a web framework for Haskell. For more information about Snap, read the `README.SNAP.md` or visit the Snap project website at diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,59 @@ +## 1.0.5.0 + +- Add `head` helper for `Snap.Test` +- Add support for GHC 9 +- Expose Snap.Internal.Util.FileServe +- Ensure parseHttpTime returns 0 on invalid input +- Add test helper for HEAD requests +- Misc version bumps + +## 1.0.4.0 +- Allow `network` 3.0. + +## 1.0.3.2 +- Allow `unix-compat` 0.5 + +- Stop using deprecated Data.Map.insertWith' + +- Test with GHC 8.4.1 + +## 1.0.3.1 +- Allow `io-streams` 1.5. + +## 1.0.3.0 +### Added +- Alternative file upload handling into Snap.Util.FileUploads + +### Fixes +- Fixed parsing of field values in multipart/form-data headers with encodings + other than US-ASCII + +## 1.0.2.1 +### Dependencies +- Allow `io-streams` 1.4. + +## 1.0.2.0 +### Added +- Merged CORS functionality from snap-cors project into Snap.Util.CORS + +### Dependencies +- Bumped `time` dependency. + +## 1.0.1.1 +### Fixes +- Fixed a bug in token parsing in Snap.Util.Parsing + +## 1.0.1.0 +### Fixes +- fixed a FileUpload exception test + +- Exported `compressibleMimeTypes` + +- Added a missing file to the tarball. + +## 1.0.0.0 +### Added +### Removed + + - Removed support for `iteratees` in favor of + [io-streams](https://hackage.haskell.org/package/io-streams) diff --git a/snap-core.cabal b/snap-core.cabal --- a/snap-core.cabal +++ b/snap-core.cabal @@ -1,5 +1,6 @@ +cabal-version: 2.2 name: snap-core -version: 1.0.5.0 +version: 1.0.5.1 synopsis: Snap: A Haskell Web Framework (core interfaces and types) description: @@ -25,23 +26,28 @@ . /Quick start/: The 'Snap' monad and HTTP definitions are in "Snap.Core". -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Snap Framework Authors (see CONTRIBUTORS) maintainer: snap@snapframework.com build-type: Simple -cabal-version: >= 1.10 homepage: http://snapframework.com/ bug-reports: https://github.com/snapframework/snap-core/issues category: Web, Snap, IO-Streams -Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, - GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, - GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.1 +tested-with: + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.7 + GHC == 9.0.2 + GHC == 9.2.5 + GHC == 9.4.4 + extra-source-files: test/TestSuite.hs, cbits/timefuncs.c, CONTRIBUTORS, + changelog.md, extra/haddock.css, extra/hscolour.css, extra/logo.gif, @@ -90,9 +96,14 @@ Description: Get Network.URI from the network-uri package Default: True +common universal + default-language: Haskell2010 + build-depends: + , base >= 4 && < 5 + Library - Default-language: Haskell2010 + import: universal hs-source-dirs: src if !flag(debug) @@ -132,7 +143,6 @@ build-depends: HUnit >= 1.2 && < 2, attoparsec >= 0.12 && < 0.15, - base >= 4 && < 5, bytestring >= 0.9 && < 0.12, bytestring-builder >= 0.10.4 && < 0.11, case-insensitive >= 1.1 && < 1.3, @@ -141,19 +151,19 @@ filepath >= 1.1 && < 2.0, lifted-base >= 0.1 && < 0.3, io-streams >= 1.3 && < 1.6, - hashable >= 1.2.0.6 && < 1.4, + hashable >= 1.2.0.6 && < 1.5, monad-control >= 1.0 && < 1.1, - mtl >= 2.0 && < 2.3, + mtl >= 2.0 && < 2.4, random >= 1 && < 2, readable >= 0.1 && < 0.4, regex-posix >= 0.95 && < 1, - text >= 0.11 && < 1.3, + text >= 0.11 && < 2.1, time >= 1.0 && < 1.14, - transformers >= 0.3 && < 0.6, + transformers >= 0.3 && < 0.7, transformers-base >= 0.4 && < 0.5, - unix-compat >= 0.3 && < 0.6, + unix-compat >= 0.3 && < 0.7, unordered-containers >= 0.1.4.3 && < 0.3, - vector >= 0.6 && < 0.13 + vector >= 0.6 && < 0.14 other-extensions: BangPatterns, @@ -194,17 +204,15 @@ build-depends: network-uri >= 2.5 && < 2.6, network >= 2.3 && < 2.6 - if impl(ghc >= 7.6) - build-depends: unix-compat >= 0.3 && < 0.6 - else + if !impl(ghc >= 7.6) build-depends: unix-compat >= 0.3 && < 0.5.3 Test-suite testsuite + import: universal hs-source-dirs: src test Type: exitcode-stdio-1.0 Main-is: TestSuite.hs - Default-language: Haskell2010 if flag(portable) || os(windows) cpp-options: -DPORTABLE @@ -250,7 +258,6 @@ build-depends: HUnit, attoparsec, - base, bytestring, bytestring-builder, case-insensitive, diff --git a/src/Snap/Internal/Core.hs b/src/Snap/Internal/Core.hs --- a/src/Snap/Internal/Core.hs +++ b/src/Snap/Internal/Core.hs @@ -1774,10 +1774,18 @@ ------------------------------------------------------------------------------ -evalSnap :: Snap a - -> (ByteString -> IO ()) - -> ((Int -> Int) -> IO ()) - -> Request +-- | Evaluates a 'Snap' monad action. +-- +-- Unlike 'runSnap', 'evalSnap' evaluates to the value, not the 'Response'. +-- Like 'runSnap', 'evalSnap' is intended for library writers. +-- Note that there is no meaningful way of evaluating a 'Snap' monad action +-- that contains 'pass' without alternative (i.e. failure), 'finishWith' +-- (i.e. early termination), or 'escapeHttp' (i.e. escaping Snap). +-- In all of those three cases 'evalSnap' throws an IO exception. +evalSnap :: Snap a -- ^ Action to run. + -> (ByteString -> IO ()) -- ^ Error logging action. + -> ((Int -> Int) -> IO ()) -- ^ Timeout action. + -> Request -- ^ HTTP request. -> IO a evalSnap (Snap m) logerr timeoutAction req = m (\v _ -> return v) diediedie ss diff --git a/src/Snap/Internal/Http/Types.hs b/src/Snap/Internal/Http/Types.hs --- a/src/Snap/Internal/Http/Types.hs +++ b/src/Snap/Internal/Http/Types.hs @@ -48,7 +48,7 @@ #ifdef PORTABLE import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX -import Data.Time.Format +import Data.Time.Format as Time import Data.Time.Locale.Compat (defaultTimeLocale) import Data.Time.LocalTime #else @@ -1281,6 +1281,13 @@ ------------------------------------------------------------------------------ parseHttpTime = return . toCTime . prs . S.unpack where + parseTime = +#if MIN_VERSION_time(1,10,0) + parseTimeM True +#else + Time.parseTime +#endif + prs :: String -> Maybe UTCTime prs = parseTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" diff --git a/src/Snap/Internal/Instances.hs b/src/Snap/Internal/Instances.hs --- a/src/Snap/Internal/Instances.hs +++ b/src/Snap/Internal/Instances.hs @@ -1,6 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE PackageImports #-} -- Note re: "-fno-warn-warnings-deprecations" above: transformers has -- deprecated Control.Monad.Trans.Error (which we like) but we are going to @@ -10,11 +9,15 @@ module Snap.Internal.Instances () where ------------------------------------------------------------------------------ import Control.Monad.Trans.Class (MonadTrans (lift)) +#if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.Error (Error, ErrorT) +#endif #if MIN_VERSION_transformers(0,4,0) import Control.Monad.Trans.Except (ExceptT) #endif +#if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.List (ListT) +#endif import Control.Monad.Trans.Reader (ReaderT) import qualified Control.Monad.Trans.RWS.Lazy as LRWS (RWST) import Control.Monad.Trans.RWS.Strict (RWST) @@ -30,17 +33,19 @@ ------------------------------------------------------------------------------ +#if !MIN_VERSION_transformers(0,6,0) instance (MonadSnap m, Error e) => MonadSnap (ErrorT e m) where liftSnap = lift . liftSnap -#if MIN_VERSION_transformers(0,4,0) -instance (MonadSnap m, Monoid e) => MonadSnap (ExceptT e m) where +------------------------------------------------------------------------------ +instance MonadSnap m => MonadSnap (ListT m) where liftSnap = lift . liftSnap #endif ------------------------------------------------------------------------------- -instance MonadSnap m => MonadSnap (ListT m) where +#if MIN_VERSION_transformers(0,4,0) +instance (MonadSnap m, Monoid e) => MonadSnap (ExceptT e m) where liftSnap = lift . liftSnap +#endif ------------------------------------------------------------------------------ diff --git a/test/Snap/Core/Tests.hs b/test/Snap/Core/Tests.hs --- a/test/Snap/Core/Tests.hs +++ b/test/Snap/Core/Tests.hs @@ -22,12 +22,16 @@ import Control.Monad (Functor (fmap), Monad ((>>), (>>=), return), MonadPlus (mplus, mzero), forM_, liftM, void) import Control.Monad.Base (MonadBase (liftBase)) import Control.Monad.IO.Class (liftIO) +#if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.Error (ErrorT (runErrorT)) +#endif import Data.ByteString.Builder (byteString) #if MIN_VERSION_transformers(0,4,0) import Control.Monad.Trans.Except (runExceptT) #endif +#if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.List (ListT (runListT)) +#endif import Control.Monad.Trans.Reader (ReaderT (runReaderT)) import qualified Control.Monad.Trans.RWS.Lazy as LRWS (RWST (runRWST)) import Control.Monad.Trans.RWS.Strict (RWST (runRWST)) @@ -833,11 +837,13 @@ ------------------------------------------------------------------------------ testCoverInstances :: Test testCoverInstances = testCase "core/instances" $ do +#if !MIN_VERSION_transformers(0,6,0) coverErrorT + coverListT +#endif #if MIN_VERSION_transformers(0,4,0) coverExceptT #endif - coverListT coverRWST coverLRWS coverReaderT @@ -867,15 +873,17 @@ lwt :: LWriter.WriterT () Snap () -> Snap () lwt m = void $ LWriter.runWriterT m +#if !MIN_VERSION_transformers(0,6,0) coverErrorT = cover (\m -> do (_ :: Either String ()) <- runErrorT m return ()) + coverListT = cover (void . runListT) +#endif #if MIN_VERSION_transformers(0,4,0) coverExceptT = cover (\m -> do (_ :: Either String ()) <- runExceptT m return ()) #endif - coverListT = cover (void . runListT) coverRWST = cover rwst coverLRWS = cover lrwst coverReaderT = cover (flip runReaderT ())