Hello community,
here is the log from the commit of package ghc-servant-auth-cookie for
openSUSE:Factory checked in at 2017-05-18 20:51:02
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-servant-auth-cookie (Old)
and /work/SRC/openSUSE:Factory/.ghc-servant-auth-cookie.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-servant-auth-cookie"
Thu May 18 20:51:02 2017 rev:2 rq:495711 version:0.4.4
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-servant-auth-cookie/ghc-servant-auth-cookie.changes
2017-05-10 20:45:53.546005117 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-servant-auth-cookie.new/ghc-servant-auth-cookie.changes
2017-05-18 20:51:03.384090972 +0200
@@ -1,0 +2,5 @@
+Wed Apr 19 13:32:18 UTC 2017 - psim...@suse.com
+
+- Update to version 0.4.4 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
servant-auth-cookie-0.4.3.3.tar.gz
New:
----
servant-auth-cookie-0.4.4.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-servant-auth-cookie.spec ++++++
--- /var/tmp/diff_new_pack.kLHfZn/_old 2017-05-18 20:51:04.783893422 +0200
+++ /var/tmp/diff_new_pack.kLHfZn/_new 2017-05-18 20:51:04.787892858 +0200
@@ -19,7 +19,7 @@
%global pkg_name servant-auth-cookie
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.4.3.3
+Version: 0.4.4
Release: 0
Summary: Authentication via encrypted cookies
License: BSD-3-Clause
++++++ servant-auth-cookie-0.4.3.3.tar.gz -> servant-auth-cookie-0.4.4.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-auth-cookie-0.4.3.3/CHANGELOG.md
new/servant-auth-cookie-0.4.4/CHANGELOG.md
--- old/servant-auth-cookie-0.4.3.3/CHANGELOG.md 2017-02-26
22:18:49.000000000 +0100
+++ new/servant-auth-cookie-0.4.4/CHANGELOG.md 2017-04-15 11:57:55.000000000
+0200
@@ -1,7 +1,13 @@
# Change Log
-## [Unreleased]
+## [0.4.4]
+### Added
+- Tests for the example.
+- `parseSessionRequest` and `parseSessionResponse` functions.
+- `removeSessionFromErr` function.
+### Changed
+- Fixed constraint for `removeSession`.
## [0.4.3.3]
### Added
@@ -81,7 +87,8 @@
- Initial version of the package.
-[HEAD]: ../../compare/v0.4.3.3...HEAD
+[HEAD]: ../../compare/v0.4.4...HEAD
+[0.4.4]: ../../compare/v0.4.3.3...v0.4.4
[0.4.3.3]: ../../compare/v0.4.3.2...v0.4.3.3
[0.4.3.2]: ../../compare/v0.4.3.1...v0.4.3.2
[0.4.3.1]: ../../compare/v0.4.3...v0.4.3.1
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-auth-cookie-0.4.3.3/example/Main.hs
new/servant-auth-cookie-0.4.4/example/Main.hs
--- old/servant-auth-cookie-0.4.3.3/example/Main.hs 2017-02-26
22:18:49.000000000 +0100
+++ new/servant-auth-cookie-0.4.4/example/Main.hs 2017-04-15
11:57:55.000000000 +0200
@@ -18,6 +18,10 @@
main :: IO ()
main = do
rs <- mkRandomSource drgNew 1000
+ -- NOTE:
+ -- Every time the application is executed, a new server key is
+ -- created. This means, once you restart the app, already existing
+ -- cookies will be invalidated.
sk <- mkServerKey 16 Nothing
run 8080 (app authSettings rs sk)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-auth-cookie-0.4.3.3/example/Test.hs
new/servant-auth-cookie-0.4.4/example/Test.hs
--- old/servant-auth-cookie-0.4.3.3/example/Test.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/servant-auth-cookie-0.4.4/example/Test.hs 2017-04-15
11:57:55.000000000 +0200
@@ -0,0 +1,199 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+
+import Prelude ()
+import Prelude.Compat
+import Data.Maybe (fromMaybe)
+import Data.Int (Int64)
+import Data.Time.Clock (UTCTime(..))
+import Control.Monad.IO.Class (liftIO)
+import AuthAPI (app, authSettings, LoginForm(..), homePage, loginPage,
Account(..))
+import Test.Hspec (Spec, hspec, describe, it)
+import Test.Hspec.Wai (WaiSession, WaiExpectation, shouldRespondWith, with,
request, get)
+import Text.Blaze.Renderer.Utf8 (renderMarkup)
+import Servant (Proxy(..))
+import Crypto.Random (drgNew)
+import Servant (FormUrlEncoded, contentType)
+import Servant.Server.Experimental.Auth.Cookie
+import Network.HTTP.Types (methodGet, methodPost, hContentType, hCookie)
+import Network.HTTP.Media.RenderHeader (renderHeader)
+import Network.Wai.Test (SResponse(..))
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy.Char8 as BSC8
+
+#if MIN_VERSION_hspec_wai (0,7,0)
+import Test.Hspec.Wai.Matcher (bodyEquals, ResponseMatcher(..), MatchBody(..))
+#else
+import Test.Hspec.Wai (matchBody)
+#endif
+
+#if MIN_VERSION_servant (0,9,0)
+import Web.FormUrlEncoded (ToForm, toForm, urlEncodeForm)
+#else
+import Servant (ToFormUrlEncoded, mimeRender)
+#endif
+
+
+data SpecState = SpecState {
+ ssRandomSource :: RandomSource
+ , ssServerKey :: ServerKey
+ , ssAuthSettings :: AuthCookieSettings
+ }
+
+main :: IO ()
+main = withState (hspec . spec) where
+ withState f = do
+ let ssAuthSettings = authSettings
+ ssRandomSource <- mkRandomSource drgNew 1000
+ ssServerKey <- mkServerKey 16 Nothing
+ f $ SpecState {..}
+
+
+spec :: SpecState -> Spec
+spec SpecState {..} = with (return $ app ssAuthSettings ssRandomSource
ssServerKey) $ do
+
+ let formContentType = (
+ hContentType
+ , renderHeader $ contentType (Proxy :: Proxy FormUrlEncoded))
+
+ describe "home page" $ do
+ it "responds successfully" $ do
+ get "/" `shouldRespondWith` 200 {
+ matchBody = matchBody' $ renderMarkup homePage
+ }
+
+ describe "login page" $ do
+ it "responds successfully" $ do
+ get "/login" `shouldRespondWith` 200 {
+ matchBody = matchBody' $ renderMarkup (loginPage True)
+ }
+
+ it "shows message on incorrect login" $ do
+ let loginForm = encode $ LoginForm {
+ lfUsername = "noname"
+ , lfPassword = "noname"
+ }
+ let r = request methodPost "/login" [formContentType] loginForm
+ r `shouldRespondWith` 200 {
+ matchBody = matchBody' $ renderMarkup (loginPage False)
+ }
+
+ describe "private page" $ do
+ let loginForm = encode $ LoginForm {
+ lfUsername = "mr_foo"
+ , lfPassword = "password1"
+ }
+ let loginRequest = request methodPost "/login" [formContentType] loginForm
+
+ it "rejects requests without cookies" $ do
+ let r = get "/private"
+ r `shouldRespondWith` 403 { matchBody = matchBody' "No cookies" }
+
+ it "accepts requests with proper cookies" $ do
+ (SResponse {..}) <- loginRequest
+ let cookieValue = fromMaybe
+ (error "cookies aren't available")
+ (lookup "set-cookie" simpleHeaders)
+
+ let r = request methodGet "/private" [(hCookie, cookieValue)] ""
+ r `shouldRespondWith` 200
+
+ it "accepts requests with proper cookies (sanity check)" $ do
+ (SResponse {..}) <- loginRequest
+
+ cookieValue <- liftIO $ do
+ session <- maybe
+ (error "cookies aren't available")
+ (decryptSession ssAuthSettings ssServerKey)
+ (parseSessionResponse ssAuthSettings simpleHeaders) :: IO Account
+
+ renderSession ssAuthSettings ssRandomSource ssServerKey session
+
+ let r = request methodGet "/private" [(hCookie, cookieValue)] ""
+ r `shouldRespondWith` 200
+
+
+ it "rejects requests with incorrect MAC" $ do
+ (SResponse {..}) <- loginRequest
+
+ cookieValue <- liftIO $ do
+ session <- maybe
+ (error "cookies aren't available")
+ (decryptSession ssAuthSettings ssServerKey)
+ (parseSessionResponse ssAuthSettings simpleHeaders) :: IO Account
+
+ sk <- mkServerKey 16 Nothing
+ renderSession ssAuthSettings ssRandomSource sk session
+
+ let r = request methodGet "/private" [(hCookie, cookieValue)] ""
+
+ r `shouldRespondWithException` (IncorrectMAC "")
+
+
+ it "rejects requests with malformed expiration time" $ do
+ (SResponse {..}) <- loginRequest
+
+ cookieValue <- liftIO $ do
+ session <- maybe
+ (error "cookies aren't available")
+ (decryptSession ssAuthSettings ssServerKey)
+ (parseSessionResponse ssAuthSettings simpleHeaders) :: IO Account
+
+ renderSession
+ ssAuthSettings { acsExpirationFormat = "%0Y%m%d" }
+ ssRandomSource
+ ssServerKey
+ session
+
+ let r = request methodGet "/private" [(hCookie, cookieValue)] ""
+ r `shouldRespondWithException` (CannotParseExpirationTime "")
+
+
+ it "rejects requests with expired cookies" $ do
+ (SResponse {..}) <- loginRequest
+
+ cookieValue <- liftIO $ do
+ session <- maybe
+ (error "cookies aren't available")
+ (decryptSession ssAuthSettings ssServerKey)
+ (parseSessionResponse ssAuthSettings simpleHeaders) :: IO Account
+
+ renderSession
+ ssAuthSettings { acsMaxAge = 0 }
+ ssRandomSource
+ ssServerKey
+ session
+
+ let r = request methodGet "/private" [(hCookie, cookieValue)] ""
+ let dummyTime = UTCTime (toEnum 0) 0
+
+ r `shouldRespondWithException` (CookieExpired dummyTime dummyTime)
+
+
+#if MIN_VERSION_hspec_wai (0,7,0)
+matchBody' :: BSL.ByteString -> MatchBody
+matchBody' = bodyEquals
+#else
+matchBody' :: BSL.ByteString -> Maybe BSL.ByteString
+matchBody' = Just
+#endif
+
+#if MIN_VERSION_servant (0,9,0)
+encode :: ToForm a => a -> BSL.ByteString
+encode = urlEncodeForm . toForm
+#else
+encode :: ToFormUrlEncoded a => a -> BSL.ByteString
+encode = mimeRender (Proxy :: Proxy FormUrlEncoded)
+#endif
+
+shrinkBody :: Int64 -> SResponse -> SResponse
+shrinkBody len r = r { simpleBody = BSL.take len $ simpleBody r }
+
+shouldRespondWithException :: WaiSession SResponse -> AuthCookieException ->
WaiExpectation
+shouldRespondWithException req ex = do
+ let exception = BSC8.pack . head . words . show $ ex
+ (shrinkBody (BSC8.length exception) <$> req) `shouldRespondWith` 403 {
+ matchBody = matchBody' exception
+ }
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/servant-auth-cookie-0.4.3.3/servant-auth-cookie.cabal
new/servant-auth-cookie-0.4.4/servant-auth-cookie.cabal
--- old/servant-auth-cookie-0.4.3.3/servant-auth-cookie.cabal 2017-02-26
22:18:49.000000000 +0100
+++ new/servant-auth-cookie-0.4.4/servant-auth-cookie.cabal 2017-04-15
11:57:55.000000000 +0200
@@ -1,5 +1,5 @@
name: servant-auth-cookie
-version: 0.4.3.3
+version: 0.4.4
synopsis: Authentication via encrypted cookies
description: Authentication via encrypted client-side cookies,
inspired by client-session library by Michael Snoyman and
based on
@@ -54,7 +54,7 @@
, servant >= 0.5 && < 0.11
, servant-server >= 0.5 && < 0.11
, tagged == 0.8.*
- , time >= 1.5 && < 1.8
+ , time >= 1.5 && < 1.8.1
, transformers >= 0.4 && < 0.6
, wai >= 3.0 && < 3.3
@@ -93,7 +93,7 @@
, hspec >= 2.0 && < 3.0
, servant-auth-cookie
, servant-server >= 0.5 && < 0.11
- , time >= 1.5 && < 1.8
+ , time >= 1.5 && < 1.8.1
if !impl(ghc >= 7.8)
build-depends: tagged == 0.8.*
default-language: Haskell2010
@@ -141,6 +141,55 @@
default-language: Haskell2010
+test-suite example-tests
+ type: exitcode-stdio-1.0
+ hs-source-dirs: example
+ main-is: Test.hs
+ if flag(dev)
+ ghc-options: -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+
+ if flag(build-examples)
+ build-depends: base >= 4.7 && < 5.0
+ , base-compat >= 0.9.1 && <0.10
+ , blaze-markup
+ , blaze-html >= 0.8 && < 0.10
+ , bytestring
+ , cereal >= 0.5 && < 0.6
+ , exceptions
+ , cryptonite >= 0.14 && < 0.23
+ , data-default
+ , deepseq >= 1.3 && < 1.5
+ , http-media
+ , http-types
+ , hspec >= 2.0 && < 3.0
+ , hspec-wai
+ , QuickCheck >= 2.4 && < 3.0
+ , servant-auth-cookie
+ , servant-blaze >= 0.5 && < 0.10
+ , servant-server >= 0.5 && < 0.11
+ , text
+ , time >= 1.5 && < 1.8.1
+ , transformers >= 0.4 && < 0.6
+ , wai
+ , wai-extra
+ if flag(servant9)
+ build-depends:
+ servant >= 0.9,
+ http-api-data == 0.3.*
+ else
+ build-depends:
+ servant < 0.9,
+ bytestring-conversion >= 0.3.1 && <0.4
+
+ if !impl(ghc >= 7.8)
+ build-depends: tagged == 0.8.*
+ else
+ buildable: False
+
+ default-language: Haskell2010
+
benchmark bench
type: exitcode-stdio-1.0
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/servant-auth-cookie-0.4.3.3/src/Servant/Server/Experimental/Auth/Cookie.hs
new/servant-auth-cookie-0.4.4/src/Servant/Server/Experimental/Auth/Cookie.hs
---
old/servant-auth-cookie-0.4.3.3/src/Servant/Server/Experimental/Auth/Cookie.hs
2017-02-26 22:18:49.000000000 +0100
+++
new/servant-auth-cookie-0.4.4/src/Servant/Server/Experimental/Auth/Cookie.hs
2017-04-15 11:57:55.000000000 +0200
@@ -53,10 +53,13 @@
, addSession
, removeSession
, addSessionToErr
+ , removeSessionFromErr
, getSession
-- exposed for testing purpose
, renderSession
+ , parseSessionRequest
+ , parseSessionResponse
, defaultAuthHandler
) where
@@ -84,7 +87,7 @@
import Data.Tagged (Tagged (..), retag)
import Data.Typeable
import GHC.TypeLits (Symbol)
-import Network.HTTP.Types (hCookie)
+import Network.HTTP.Types (hCookie, HeaderName, RequestHeaders,
ResponseHeaders)
import Network.Wai (Request, requestHeaders)
import Servant (addHeader, ServantErr (..))
import Servant.API.Experimental.Auth (AuthProtect)
@@ -97,6 +100,7 @@
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as BSC8
+import qualified Network.HTTP.Types as N(Header)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
@@ -108,6 +112,14 @@
import Data.ByteString.Conversion (ToByteString (..))
#endif
+#if MIN_VERSION_http_types(0,9,2)
+import Network.HTTP.Types (hSetCookie)
+#else
+hSetCookie :: HeaderName
+hSetCookie = "Set-Cookie"
+#endif
+
+
----------------------------------------------------------------------------
-- General types
@@ -464,25 +476,13 @@
return (addHeader (EncryptedSession header) response)
-- | "Remove" a session by invalidating the cookie.
--- Cookie expiry date is set at 0 and content is wiped
removeSession :: ( Monad m,
- AddHeader (e :: Symbol) ByteString s r )
+ AddHeader (e :: Symbol) EncryptedSession s r )
=> AuthCookieSettings -- ^ Options, see 'AuthCookieSettings'
-> s -- ^ Response to return with session removed
-> m r -- ^ Response with the session "removed"
-removeSession AuthCookieSettings{..} response =
- let invalidDate = BSC8.pack $ formatTime
- defaultTimeLocale
- acsExpirationFormat
- timeOrigin
- timeOrigin = UTCTime (toEnum 0) 0
- cookies =
- (acsSessionField, "") :
- ("Path", acsPath) :
- ("Expires", invalidDate) :
- ((,"") <$> acsCookieFlags)
- header = (toByteString . renderCookies) cookies
- in return (addHeader header response)
+removeSession acs response =
+ return (addHeader (EncryptedSession $ expiredCookie acs) response)
-- | Add cookie session to error allowing to set cookie even if response is
-- not 200.
@@ -499,7 +499,31 @@
-> m ServantErr
addSessionToErr acs rs sk sessionData err = do
header <- renderSession acs rs sk sessionData
- return err { errHeaders = ("set-cookie", header) : errHeaders err }
+ return err { errHeaders = (hSetCookie, header) : errHeaders err }
+
+-- | "Remove" a session by invalidating the cookie.
+-- Cookie expiry date is set at 0 and content is wiped
+removeSessionFromErr :: ( Monad m )
+ => AuthCookieSettings -- ^ Options, see 'AuthCookieSettings'
+ -> ServantErr -- ^ Servant error to add the cookie to
+ -> m ServantErr
+removeSessionFromErr acs err =
+ return $ err { errHeaders = (hSetCookie, expiredCookie acs) : errHeaders err
}
+
+-- | Cookie expiry date is set at 0 and content is wiped.
+expiredCookie :: AuthCookieSettings -> ByteString
+expiredCookie AuthCookieSettings{..} = (toByteString . renderCookies) cookies
+ where
+ cookies =
+ (acsSessionField, "") :
+ ("Path", acsPath) :
+ ("Expires", invalidDate) :
+ ((,"") <$> acsCookieFlags)
+ invalidDate = BSC8.pack $ formatTime
+ defaultTimeLocale
+ acsExpirationFormat
+ timeOrigin
+ timeOrigin = UTCTime (toEnum 0) 0
-- | Request handler that checks cookies. If 'Cookie' is just missing, you
-- get 'Nothing', but if something is wrong with its format, 'getSession'
@@ -509,10 +533,33 @@
-> ServerKey -- ^ 'ServerKey' to use
-> Request -- ^ The request
-> m (Maybe a) -- ^ The result
-getSession acs@AuthCookieSettings {..} sk request = do
- let cookies = parseCookies <$> lookup hCookie (requestHeaders request)
- sessionBinary = cookies >>= lookup acsSessionField
- maybe (return Nothing) (liftM Just . decryptSession acs sk . Tagged)
sessionBinary
+getSession acs@AuthCookieSettings {..} sk request = maybe
+ (return Nothing)
+ (liftM Just . decryptSession acs sk)
+ (parseSessionRequest acs $ requestHeaders request)
+
+parseSession
+ :: AuthCookieSettings
+ -> HeaderName
+ -> [N.Header]
+ -> Maybe (Tagged SerializedEncryptedCookie ByteString)
+parseSession AuthCookieSettings {..} hdr hdrs = sessionBinary where
+ cookies = parseCookies <$> lookup hdr hdrs
+ sessionBinary = Tagged <$> (cookies >>= lookup acsSessionField)
+
+-- | Parse session cookie from 'RequestHeaders'.
+parseSessionRequest
+ :: AuthCookieSettings
+ -> RequestHeaders
+ -> Maybe (Tagged SerializedEncryptedCookie ByteString)
+parseSessionRequest acs hdrs = parseSession acs hCookie hdrs
+
+-- | Parse session cookie from 'ResponseHeaders'.
+parseSessionResponse
+ :: AuthCookieSettings
+ -> ResponseHeaders
+ -> Maybe (Tagged SerializedEncryptedCookie ByteString)
+parseSessionResponse acs hdrs = parseSession acs hSetCookie hdrs
-- | Render session cookie to 'ByteString'.
renderSession
