wai-middleware-auth 0.1.2.1 → 0.2.0.0

raw patch · 8 files changed

+170/−55 lines, 8 filesdep +hedgehogdep +timedep ~basedep ~hoauth2PVP ok

version bump matches the API change (PVP)

Dependencies added: hedgehog, time

Dependency ranges changed: base, hoauth2

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• src/Network/Wai/Auth/ClientSession.hs +21/−3
• src/Network/Wai/Auth/Internal.hs +26/−0
• src/Network/Wai/Middleware/Auth.hs +12/−4
• src/Network/Wai/Middleware/Auth/OAuth2.hs +23/−40
• src/Network/Wai/Middleware/Auth/Provider.hs +13/−4
• test/Main.hs +49/−0
• wai-middleware-auth.cabal +19/−4

@@ -1,3 +1,10 @@+# 0.2.0.0+========++* Drop compatiblity with hoauth2 versions <= 1.0.0.+* Add a function for getting the oauth2 token from an authenticated request.+* Modify encoding of oauth2 session cookies. As a consequence existing cookies will be invalid.+ 0.1.2.1 ======= 

@@ -3,6 +3,7 @@ module Network.Wai.Auth.ClientSession   ( loadCookieValue   , saveCookieValue+  , deleteCookieValue   , Key   , getDefaultKey   ) where@@ -15,6 +16,8 @@ import qualified Data.ByteString.Lazy       as L import           Data.Int                   (Int64) import           Data.Maybe                 (listToMaybe)+import           Data.Time.Clock            (UTCTime(UTCTime))+import           Data.Time.Calendar         (fromGregorian) import           Foreign.C.Types            (CTime (..)) import           GHC.Generics               (Generic) import           Network.HTTP.Types         (Header)@@ -23,9 +26,9 @@ import           Web.ClientSession          (Key, decrypt, encryptIO,                                              getDefaultKey) import           Web.Cookie                 (def, parseCookies, renderSetCookie,-                                             setCookieHttpOnly, setCookieMaxAge,-                                             setCookieName, setCookiePath,-                                             setCookieValue)+                                             setCookieExpires, setCookieHttpOnly,+                                             setCookieMaxAge, setCookieName,+                                             setCookiePath, setCookieValue)  data Wrapper value = Wrapper   { contained :: value@@ -78,4 +81,19 @@         , setCookiePath = Just "/"         , setCookieHttpOnly = True         , setCookieMaxAge = Just $ fromIntegral age+        })++deleteCookieValue+  :: S.ByteString -- ^ cookie name+  -> Header+deleteCookieValue name =+  ( "Set-Cookie"+  , toByteString $+    renderSetCookie+      def+        { setCookieName = name+        , setCookieValue = ""+        , setCookiePath = Just "/"+        , setCookieHttpOnly = True+        , setCookieExpires = Just $ UTCTime (fromGregorian 1970 01 01) 0         })

@@ -0,0 +1,26 @@+module Network.Wai.Auth.Internal+  ( OAuth2TokenBinary(..)+  ) where++import           Data.Binary                          (Binary(get, put))+import qualified Network.OAuth.OAuth2                 as OA2++newtype OAuth2TokenBinary =+  OAuth2TokenBinary { unOAuth2TokenBinary :: OA2.OAuth2Token }+  deriving (Show)++instance Binary OAuth2TokenBinary where+  put (OAuth2TokenBinary token) = do+    put $ OA2.atoken $ OA2.accessToken token+    put $ OA2.rtoken <$> OA2.refreshToken token+    put $ OA2.expiresIn token+    put $ OA2.tokenType token+    put $ OA2.idtoken <$> OA2.idToken token+  get = do+    accessToken <- OA2.AccessToken <$> get+    refreshToken <- fmap OA2.RefreshToken <$> get+    expiresIn <- get+    tokenType <- get+    idToken <- fmap OA2.IdToken <$> get+    pure $ OAuth2TokenBinary $+      OA2.OAuth2Token accessToken refreshToken expiresIn tokenType idToken

@@ -21,6 +21,7 @@     , smartAppRoot     , waiMiddlewareAuthVersion     , getAuthUser+    , getDeleteSessionHeader     ) where  import           Blaze.ByteString.Builder             (fromByteString)@@ -37,8 +38,9 @@ import           Data.Version                         (Version) import           Foreign.C.Types                      (CTime (..)) import           GHC.Generics                         (Generic)-import           Network.HTTP.Types                   (status200, status303,-                                                       status404, status501)+import           Network.HTTP.Types                   (Header, status200,+                                                       status303, status404,+                                                       status501) import           Network.Wai                          (Middleware, Request,                                                        pathInfo, rawPathInfo,                                                        rawQueryString,@@ -221,13 +223,13 @@                           onFailure                             status501                             "Empty user identity is not allowed"-                        onSuccess userIdentity = do+                        onSuccess authLoginState = do                           CTime now <- epochTime                           cookie <-                             saveAuthState $                             AuthLoggedIn $                             AuthUser-                            { authUserIdentity = userIdentity+                            { authLoginState = authLoginState                             , authProviderName =                                 encodeUtf8 $ getProviderName provider                             , authLoginTime = fromIntegral now@@ -252,6 +254,7 @@                         providerUrlRenderer                         onSuccess                         onFailure+                ["health"] -> respond $ responseLBS status200 [] "OK"                 _ -> respond $ responseLBS status404 [] "Unknown URL"           -- Workaround for Chrome asking for favicon.ico, causing a wrong           -- redirect url to be stored in a cookie.@@ -296,3 +299,8 @@ waiMiddlewareAuthVersion :: Version waiMiddlewareAuthVersion = Paths.version +-- | Get a response header to delete the users current session.+--+-- @since 0.2.0+getDeleteSessionHeader :: AuthSettings -> Header+getDeleteSessionHeader = deleteCookieValue . asStateKey

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TemplateHaskell   #-}@@ -8,8 +7,10 @@   , oAuth2Parser   , URIParseException(..)   , parseAbsoluteURI+  , getAccessToken   ) where +import           Data.Binary                          (encode, decode) import           Control.Monad.Catch import           Data.Aeson.TH                        (defaultOptions,                                                        deriveJSON,@@ -20,23 +21,21 @@ import           Data.Monoid                          ((<>)) import           Data.Proxy                           (Proxy (..)) import qualified Data.Text                            as T-import           Data.Text.Encoding                   (encodeUtf8)+import           Data.Text.Encoding                   (encodeUtf8,+                                                       decodeUtf8With)+import           Data.Text.Encoding.Error             (lenientDecode) import           Network.HTTP.Client.TLS              (getGlobalManager) import           Network.HTTP.Types                   (status303, status403,                                                        status404, status501) import qualified Network.OAuth.OAuth2                 as OA2-import           Network.Wai                          (queryString, responseLBS)+import           Network.Wai                          (Request, queryString,+                                                       responseLBS)+import           Network.Wai.Auth.Internal            (OAuth2TokenBinary(..)) import           Network.Wai.Auth.Tools               (toLowerUnderscore)+import qualified Network.Wai.Middleware.Auth          as MA import           Network.Wai.Middleware.Auth.Provider import qualified URI.ByteString                       as U--#if MIN_VERSION_hoauth2(1,0,0)-import           Data.Text.Encoding                   (decodeUtf8With)-import           Data.Text.Encoding.Error             (lenientDecode) import           URI.ByteString                       (URI)-#else-type URI = OA2.URI-#endif  -- | General OAuth2 authentication `Provider`. data OAuth2 = OAuth2@@ -66,9 +65,6 @@     Left err  -> throwM $ URIParseException err     Right url -> return url --#if MIN_VERSION_hoauth2(1,0,0)- parseAbsoluteURI' :: MonadThrow m => T.Text -> m U.URI parseAbsoluteURI' = parseAbsoluteURI @@ -88,34 +84,10 @@ getRedirectURI :: U.URIRef a -> S.ByteString getRedirectURI = U.serializeURIRef' -getAccessToken :: OA2.OAuth2Token -> S.ByteString-getAccessToken = encodeUtf8 . OA2.atoken . OA2.accessToken+encodeAccessToken :: OA2.OAuth2Token -> S.ByteString+encodeAccessToken = SL.toStrict . encode . OAuth2TokenBinary -#else -parseAbsoluteURI' :: MonadThrow m => T.Text -> m URI-parseAbsoluteURI' urlTxt = U.serializeURIRef' <$> parseAbsoluteURI urlTxt--getExchangeToken :: S.ByteString -> S.ByteString-getExchangeToken = id--appendQueryParams :: URI -> [(S.ByteString, S.ByteString)] -> URI-appendQueryParams uri params = OA2.appendQueryParam uri params--getClientId :: T.Text -> S.ByteString-getClientId = encodeUtf8--getClientSecret :: T.Text -> S.ByteString-getClientSecret = encodeUtf8--getRedirectURI :: URI -> S.ByteString-getRedirectURI = id--getAccessToken :: OA2.AccessToken -> S.ByteString-getAccessToken = OA2.accessToken--#endif- -- | Aeson parser for `OAuth2` provider. -- -- @since 0.1.0@@ -159,7 +131,7 @@                eRes <- OA2.fetchAccessToken man oauth2 $ getExchangeToken code                case eRes of                  Left err    -> onFailure status501 $ S8.pack $ show err-                 Right token -> onSuccess $ getAccessToken token+                 Right token -> onSuccess $ encodeAccessToken token              _ ->                case lookup "error" params of                  (Just (Just "access_denied")) ->@@ -180,3 +152,14 @@   $(deriveJSON defaultOptions { fieldLabelModifier = toLowerUnderscore . drop 3} ''OAuth2)++-- | Get the @AccessToken@ for the current user.+--+-- If called on a @Request@ behind the middleware, should always return a+-- @Just@ value.+--+-- @since 0.2.0.0+getAccessToken :: Request -> Maybe OA2.OAuth2Token+getAccessToken req = do+  user <- MA.getAuthUser req+  unOAuth2TokenBinary <$> decode (SL.fromStrict (authLoginState user))

@@ -17,7 +17,9 @@   , parseProviders   -- * User   , AuthUser(..)+  , AuthLoginState   , UserIdentity+  , authUserIdentity   -- * Template   , mkRouteRender   , providersTemplate@@ -71,7 +73,7 @@ --         \@?{(ProviderUrl ["login", "complete"], [("user", "Hamlet")])} --         @ -----     * @(`UserIdentity` -> `IO` `Response`)@ - Action to call on a successfull login.+--     * @(`AuthLoginState` -> `IO` `Response`)@ - Action to call on a successfull login. --     * @(`Status` -> `S.ByteString` -> `IO` `Response`)@ - Should be called in case of --     a failure with login process by supplying a --     status and a short error message.@@ -100,7 +102,7 @@     -> Request     -> [T.Text]     -> Render ProviderUrl-    -> (UserIdentity -> IO Response)+    -> (AuthLoginState -> IO Response)     -> (Status -> S.ByteString -> IO Response)     -> IO Response @@ -137,12 +139,19 @@   } deriving (Show)  --- | An arbitrary user identifer, eg. a username or an email address.+-- | An arbitrary state that comes with logged in user, eg. a username, token or an email address.+type AuthLoginState = S.ByteString+ type UserIdentity = S.ByteString+{-# DEPRECATED UserIdentity "In favor of `AuthLoginState`" #-} +authUserIdentity :: AuthUser -> UserIdentity+authUserIdentity = authLoginState+{-# DEPRECATED authUserIdentity "In favor of `authLoginState`" #-}+ -- | Representation of a user for a particular `Provider`. data AuthUser = AuthUser-  { authUserIdentity :: !UserIdentity+  { authLoginState :: !UserIdentity   , authProviderName :: !S.ByteString   , authLoginTime    :: !Int64   } deriving (Generic, Show)

@@ -0,0 +1,49 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import           Data.Binary                   (encode, decode)+import qualified Data.Text                     as T+import           Hedgehog+import           Hedgehog.Gen                  as Gen+import           Hedgehog.Range                as Range+import           Network.Wai.Auth.Internal     (OAuth2TokenBinary(..))+import qualified Network.OAuth.OAuth2.Internal as OA2++main :: IO Bool+main =+  checkParallel $ Group "Main" [+    ("oAuth2TokenBinaryDuality", oAuth2TokenBinaryDuality)+  ]++oAuth2TokenBinaryDuality :: Property+oAuth2TokenBinaryDuality = property $ do+  token <- forAll oauth2TokenBinary+  tripping token encode (Just . decode)++oauth2TokenBinary :: Gen OAuth2TokenBinary+oauth2TokenBinary = do+  accessToken <- OA2.AccessToken <$> anyText+  refreshToken <- Gen.maybe $ OA2.RefreshToken <$> anyText+  expiresIn <- Gen.maybe $ Gen.int (Range.linear 0 1000)+  tokenType <- Gen.maybe $ anyText+  idToken <- Gen.maybe $ OA2.IdToken <$> anyText+  pure $ OAuth2TokenBinary $+    OA2.OAuth2Token accessToken refreshToken expiresIn tokenType idToken++anyText :: Gen T.Text+anyText = Gen.text (Range.linear 0 100) Gen.unicodeAll++-- The `OAuth2Token` type from the `hoauth2` library does not have a `Eq`+-- instance, and it's constituent parts don't have a `Generic` instance. Hence+-- this orphan instance here.+instance Eq OAuth2TokenBinary where+  (OAuth2TokenBinary t1) == (OAuth2TokenBinary t2) =+    all id+      [ OA2.atoken (OA2.accessToken t1) == OA2.atoken (OA2.accessToken t2)+      , (OA2.rtoken <$> OA2.refreshToken t1) == (OA2.rtoken <$> OA2.refreshToken t2)+      , OA2.expiresIn t1 == OA2.expiresIn t2+      , OA2.tokenType t1 == OA2.tokenType t2+      , (OA2.idtoken <$> OA2.idToken t1) == (OA2.idtoken <$> OA2.idToken t2)+      ]

@@ -1,7 +1,8 @@+cabal-version:       1.18 name:                wai-middleware-auth-version:             0.1.2.1+version:             0.2.0.0 synopsis:            Authentication middleware that secures WAI application-description:         See README+description:         Please see the README and Haddocks at <https://www.stackage.org/package/wai-middleware-auth> license:             MIT license-file:        LICENSE author:              Alexey Kuleshevich@@ -9,7 +10,6 @@ category:            Web build-type:          Simple extra-doc-files:     README.md CHANGELOG.md-cabal-version:       >=1.10  library   exposed-modules:     Network.Wai.Middleware.Auth@@ -18,6 +18,7 @@                        Network.Wai.Middleware.Auth.OAuth2.Google                        Network.Wai.Middleware.Auth.Provider                        Network.Wai.Auth.Executable+                       Network.Wai.Auth.Internal   other-modules:       Paths_wai_middleware_auth                        Network.Wai.Auth.AppRoot                        Network.Wai.Auth.Config@@ -35,7 +36,7 @@                      , clientsession                      , cookie                      , exceptions-                     , hoauth2              >= 0.5.0+                     , hoauth2              >= 1.0                      , http-client                      , http-client-tls                      , http-conduit@@ -45,6 +46,7 @@                      , safe-exceptions                      , shakespeare                      , text+                     , time                      , unix-compat                      , unordered-containers                      , uri-bytestring@@ -68,6 +70,19 @@                      , optparse-simple                      , wai-middleware-auth                      , warp+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++test-suite spec+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  hs-source-dirs:      test+  build-depends:       base+                     , binary+                     , hedgehog+                     , hoauth2+                     , text+                     , wai-middleware-auth   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N  source-repository head