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