diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 0.2.1.0 +======== + +* Fix a bug in deserialization of `UserIdentity` + # 0.2.0.0 ======== diff --git a/src/Network/Wai/Auth/Internal.hs b/src/Network/Wai/Auth/Internal.hs --- a/src/Network/Wai/Auth/Internal.hs +++ b/src/Network/Wai/Auth/Internal.hs @@ -1,9 +1,24 @@ +{-# OPTIONS_HADDOCK hide, not-home #-} module Network.Wai.Auth.Internal ( OAuth2TokenBinary(..) + , encodeToken + , decodeToken ) where -import Data.Binary (Binary(get, put)) +import Data.Binary (Binary(get, put), encode, + decodeOrFail) +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as SL import qualified Network.OAuth.OAuth2 as OA2 + +decodeToken :: S.ByteString -> Either String OA2.OAuth2Token +decodeToken bs = + case decodeOrFail $ SL.fromStrict bs of + Right (_, _, token) -> Right $ unOAuth2TokenBinary token + Left (_, _, err) -> Left err + +encodeToken :: OA2.OAuth2Token -> S.ByteString +encodeToken = SL.toStrict . encode . OAuth2TokenBinary newtype OAuth2TokenBinary = OAuth2TokenBinary { unOAuth2TokenBinary :: OA2.OAuth2Token } diff --git a/src/Network/Wai/Auth/Tools.hs b/src/Network/Wai/Auth/Tools.hs --- a/src/Network/Wai/Auth/Tools.hs +++ b/src/Network/Wai/Auth/Tools.hs @@ -30,7 +30,7 @@ -- of them to lower case. toLowerUnderscore :: String -> String toLowerUnderscore [] = [] -toLowerUnderscore (x:xs) = toLower x : (foldr' toLowerWithUnder [] xs) +toLowerUnderscore (x:xs) = toLower x : foldr' toLowerWithUnder [] xs where toLowerWithUnder !y !acc | isLower y = y : acc diff --git a/src/Network/Wai/Middleware/Auth/OAuth2.hs b/src/Network/Wai/Middleware/Auth/OAuth2.hs --- a/src/Network/Wai/Middleware/Auth/OAuth2.hs +++ b/src/Network/Wai/Middleware/Auth/OAuth2.hs @@ -10,14 +10,12 @@ , getAccessToken ) where -import Data.Binary (encode, decode) import Control.Monad.Catch import Data.Aeson.TH (defaultOptions, deriveJSON, fieldLabelModifier) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 (pack) -import qualified Data.ByteString.Lazy as SL import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) import qualified Data.Text as T @@ -30,7 +28,7 @@ import qualified Network.OAuth.OAuth2 as OA2 import Network.Wai (Request, queryString, responseLBS) -import Network.Wai.Auth.Internal (OAuth2TokenBinary(..)) +import Network.Wai.Auth.Internal (encodeToken, decodeToken) import Network.Wai.Auth.Tools (toLowerUnderscore) import qualified Network.Wai.Middleware.Auth as MA import Network.Wai.Middleware.Auth.Provider @@ -84,10 +82,6 @@ getRedirectURI :: U.URIRef a -> S.ByteString getRedirectURI = U.serializeURIRef' -encodeAccessToken :: OA2.OAuth2Token -> S.ByteString -encodeAccessToken = SL.toStrict . encode . OAuth2TokenBinary - - -- | Aeson parser for `OAuth2` provider. -- -- @since 0.1.0 @@ -131,7 +125,7 @@ eRes <- OA2.fetchAccessToken man oauth2 $ getExchangeToken code case eRes of Left err -> onFailure status501 $ S8.pack $ show err - Right token -> onSuccess $ encodeAccessToken token + Right token -> onSuccess $ encodeToken token _ -> case lookup "error" params of (Just (Just "access_denied")) -> @@ -162,4 +156,4 @@ getAccessToken :: Request -> Maybe OA2.OAuth2Token getAccessToken req = do user <- MA.getAuthUser req - unOAuth2TokenBinary <$> decode (SL.fromStrict (authLoginState user)) + either (const Nothing) Just $ decodeToken (authLoginState user) diff --git a/src/Network/Wai/Middleware/Auth/Provider.hs b/src/Network/Wai/Middleware/Auth/Provider.hs --- a/src/Network/Wai/Middleware/Auth/Provider.hs +++ b/src/Network/Wai/Middleware/Auth/Provider.hs @@ -129,7 +129,7 @@ type ProviderParser = (T.Text, Value -> Parser Provider) -- | Data type for rendering Provider specific urls. -data ProviderUrl = ProviderUrl [T.Text] +newtype ProviderUrl = ProviderUrl [T.Text] -- | Provider information used for rendering a page with list of supported providers. data ProviderInfo = ProviderInfo @@ -151,7 +151,7 @@ -- | Representation of a user for a particular `Provider`. data AuthUser = AuthUser - { authLoginState :: !UserIdentity + { authLoginState :: !UserIdentity , authProviderName :: !S.ByteString , authLoginTime :: !Int64 } deriving (Generic, Show) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,14 +1,14 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} - +{-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where -import Data.Binary (encode, decode) +import Data.Binary (encode, decodeOrFail) +import qualified Data.ByteString.Lazy.Char8 as BSL8 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 Network.Wai.Auth.Internal import qualified Network.OAuth.OAuth2.Internal as OA2 main :: IO Bool @@ -20,16 +20,21 @@ oAuth2TokenBinaryDuality :: Property oAuth2TokenBinaryDuality = property $ do token <- forAll oauth2TokenBinary - tripping token encode (Just . decode) + let checkUnconsumed ("", _, roundTripToken) = roundTripToken + checkUnconsumed (unconsumed, _, _) = + error $ "Unexpected unconsumed in bytes: " <> BSL8.unpack unconsumed + tripping token encode (fmap checkUnconsumed . decodeOrFail) + tripping token (encodeToken . unOAuth2TokenBinary) (fmap OAuth2TokenBinary . decodeToken) 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 + tokenType <- Gen.maybe anyText idToken <- Gen.maybe $ OA2.IdToken <$> anyText - pure $ OAuth2TokenBinary $ + pure $ + OAuth2TokenBinary $ OA2.OAuth2Token accessToken refreshToken expiresIn tokenType idToken anyText :: Gen T.Text @@ -40,7 +45,7 @@ -- this orphan instance here. instance Eq OAuth2TokenBinary where (OAuth2TokenBinary t1) == (OAuth2TokenBinary t2) = - all id + and [ 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 diff --git a/wai-middleware-auth.cabal b/wai-middleware-auth.cabal --- a/wai-middleware-auth.cabal +++ b/wai-middleware-auth.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: wai-middleware-auth -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Authentication middleware that secures WAI application description: Please see the README and Haddocks at license: MIT @@ -79,6 +79,7 @@ hs-source-dirs: test build-depends: base , binary + , bytestring , hedgehog , hoauth2 , text