oidc-client 0.2.0.0 → 0.3.0.0

raw patch · 9 files changed

+157/−101 lines, 9 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• examples/scotty/Main.hs +1/−2
• oidc-client.cabal +7/−2
• src/Web/OIDC/Client/CodeFlow.hs +11/−10
• src/Web/OIDC/Client/Discovery.hs +0/−2
• src/Web/OIDC/Client/Discovery/Provider.hs +10/−23
• src/Web/OIDC/Client/Internal.hs +0/−1
• src/Web/OIDC/Client/Settings.hs +15/−15
• src/Web/OIDC/Client/Types.hs +11/−46
• test/Spec/Client.hs +102/−0

@@ -3,7 +3,6 @@  module Main where -import Control.Applicative ((<$>)) import Control.Monad.IO.Class (liftIO) import Crypto.Random.AESCtr (makeSystem) import Crypto.Random.API (CPRG, cprgGenBytes)@@ -60,7 +59,7 @@      post "/login" $ do         state <- genState-        loc <- liftIO $ O.getAuthenticationRequestUrl oidc [O.Email] (Just state) []+        loc <- liftIO $ O.getAuthenticationRequestUrl oidc [O.email] (Just state) []         sid <- genSessionId         saveState sid state         setSimpleCookie "test-session" sid

@@ -1,5 +1,5 @@ name:               oidc-client-version:            0.2.0.0+version:            0.3.0.0 synopsis:           OpenID Connect 1.0 library for RP homepage:           https://github.com/krdlab/haskell-oidc-client stability:          experimental@@ -29,6 +29,7 @@ library   hs-source-dirs:      src   default-language:    Haskell2010+  ghc-options:         -Wall   exposed-modules:       Web.OIDC.Client     , Web.OIDC.Client.CodeFlow@@ -44,7 +45,7 @@       base              >=4.7 && <5     , bytestring        >=0.10 && <0.11     , text              >=1.2 && <1.3-    , aeson             >=0.9+    , aeson             >=0.10     , attoparsec        >=0.12     , exceptions     , http-client@@ -63,6 +64,8 @@   default-language:     Haskell2010   ghc-options:          -Wall   main-is:              Spec.hs+  other-modules:+      Spec.Client   build-depends:       base     , hspec@@ -75,7 +78,9 @@  executable scotty-example   main-is:          Main.hs+  default-language: Haskell2010   hs-source-dirs:   examples/scotty/+  ghc-options:      -Wall   if flag(build-examples)     build-depends:         base                >=4.7 && <5

@@ -14,18 +14,17 @@     , getCurrentIntDate     ) where -import Control.Applicative ((<$>)) import Control.Monad (unless) import Control.Monad.Catch (MonadThrow, throwM, MonadCatch, catch) import Data.Aeson (decode) import qualified Data.ByteString.Char8 as B import Data.List (nub)-import Data.Text (Text)+import Data.Text (Text, unpack) import Data.Text.Encoding (decodeUtf8) import Data.Time.Clock.POSIX (getPOSIXTime) import Jose.Jwt (Jwt) import qualified Jose.Jwt as Jwt-import Network.HTTP.Client (getUri, setQueryString, applyBasicAuth, urlEncodedBody, Request(..), Manager, httpLbs, responseBody)+import Network.HTTP.Client (getUri, setQueryString, urlEncodedBody, Request(..), Manager, httpLbs, responseBody) import Network.URI (URI)  import Web.OIDC.Client.Settings (OIDC(..))@@ -33,7 +32,7 @@ import qualified Web.OIDC.Client.Internal as I import Web.OIDC.Client.Internal (parseUrl) import Web.OIDC.Client.Tokens (Tokens(..), IdToken(..))-import Web.OIDC.Client.Types (Scope, ScopeValue(..), Code, State, Parameters, OpenIdException(..))+import Web.OIDC.Client.Types (Scope, openId, Code, State, Parameters, OpenIdException(..))  -- | Make URL for Authorization Request. getAuthenticationRequestUrl@@ -47,13 +46,13 @@     req <- parseUrl endpoint `catch` I.rethrow     return $ getUri $ setQueryString query req   where-    endpoint  = oidcAuthorizationSeverUrl oidc+    endpoint  = oidcAuthorizationServerUrl oidc     query     = requireds ++ state' ++ params     requireds =         [ ("response_type", Just "code")         , ("client_id",     Just $ oidcClientId oidc)         , ("redirect_uri",  Just $ oidcRedirectUri oidc)-        , ("scope",         Just $ B.pack . unwords . nub . map show $ OpenId:scope)+        , ("scope",         Just $ B.pack . unwords . nub . map unpack $ openId:scope)         ]     state' =         case state of@@ -77,7 +76,7 @@   where     getTokensJson = do         req <- parseUrl endpoint-        let req' = applyBasicAuth cid sec $ urlEncodedBody body $ req { method = "POST" }+        let req' = urlEncodedBody body $ req { method = "POST" }         res <- httpLbs req' manager         return $ responseBody res     endpoint = oidcTokenEndpoint oidc@@ -85,9 +84,11 @@     sec      = oidcClientSecret oidc     redirect = oidcRedirectUri oidc     body     =-        [ ("grant_type",   "authorization_code")-        , ("code",         code)-        , ("redirect_uri", redirect)+        [ ("grant_type",    "authorization_code")+        , ("code",          code)+        , ("client_id",     cid)+        , ("client_secret", sec)+        , ("redirect_uri",  redirect)         ]  validate :: OIDC -> I.TokensResponse -> IO Tokens

@@ -16,12 +16,10 @@     , Configuration(..)     ) where -import Control.Applicative ((<$>)) import Control.Monad.Catch (throwM, catch) import Data.Aeson (decode) import Data.Text (append) import Data.Maybe (fromMaybe)-import Data.Monoid (mempty) import qualified Jose.Jwk as Jwk import Network.HTTP.Client (Manager, httpLbs, responseBody) 

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-|     Module: Web.OIDC.Client.Discovery.Provider     Maintainer: krdlab@gmail.com@@ -10,9 +11,8 @@     , Configuration(..)     ) where -import Control.Applicative ((<$>), (<*>))-import Control.Monad (mzero)-import Data.Aeson (FromJSON, parseJSON, Value(..), (.:))+import Data.Aeson.TH (deriveFromJSON, Options(..), defaultOptions)+import Data.Aeson.Types (camelTo2) import Data.Text (Text) import Jose.Jwk (Jwk) @@ -26,30 +26,17 @@     { issuer                            :: IssuerLocation     , authorizationEndpoint             :: Text     , tokenEndpoint                     :: Text-    , userinfoEndpoint                  :: Text-    , revocationEndpoint                :: Text+    , userinfoEndpoint                  :: Maybe Text+    , revocationEndpoint                :: Maybe Text     , jwksUri                           :: Text     , responseTypesSupported            :: [Text]     , subjectTypesSupported             :: [Text]     , idTokenSigningAlgValuesSupported  :: [Text]-    , scopesSupported                   :: [ScopeValue]-    , tokenEndpointAuthMethodsSupported :: [Text]-    , claimsSupported                   :: [Text]+    , scopesSupported                   :: Maybe [ScopeValue]+    , tokenEndpointAuthMethodsSupported :: Maybe [Text]+    , claimsSupported                   :: Maybe [Text]     }+    -- http://openid.net/specs/openid-connect-discovery-1_0.html#ProviderMetadata   deriving (Show, Eq) -instance FromJSON Configuration where-    parseJSON (Object o) = Configuration-        <$> o .: "issuer"-        <*> o .: "authorization_endpoint"-        <*> o .: "token_endpoint"-        <*> o .: "userinfo_endpoint"-        <*> o .: "revocation_endpoint"-        <*> o .: "jwks_uri"-        <*> o .: "response_types_supported"-        <*> o .: "subject_types_supported"-        <*> o .: "id_token_signing_alg_values_supported"-        <*> o .: "scopes_supported"-        <*> o .: "token_endpoint_auth_methods_supported"-        <*> o .: "claims_supported"-    parseJSON _ = mzero+$(deriveFromJSON defaultOptions{fieldLabelModifier = camelTo2 '_'} ''Configuration)

@@ -6,7 +6,6 @@ -} module Web.OIDC.Client.Internal where -import Control.Applicative ((<$>), (<*>)) import Control.Monad (mzero) import Control.Monad.Catch (MonadThrow, throwM, MonadCatch) import Data.Aeson (FromJSON, parseJSON, Value(..), (.:), (.:?))

@@ -20,31 +20,31 @@  -- | This data type represents information needed in the OpenID flow. data OIDC = OIDC-    { oidcAuthorizationSeverUrl :: Text-    , oidcTokenEndpoint         :: Text-    , oidcClientId              :: ByteString-    , oidcClientSecret          :: ByteString-    , oidcRedirectUri           :: ByteString-    , oidcProvider              :: Provider+    { oidcAuthorizationServerUrl :: Text+    , oidcTokenEndpoint          :: Text+    , oidcClientId               :: ByteString+    , oidcClientSecret           :: ByteString+    , oidcRedirectUri            :: ByteString+    , oidcProvider               :: Provider     }  def :: OIDC def = OIDC-    { oidcAuthorizationSeverUrl = error "You must specify authorizationSeverUrl"-    , oidcTokenEndpoint         = error "You must specify tokenEndpoint"-    , oidcClientId              = error "You must specify clientId"-    , oidcClientSecret          = error "You must specify clientSecret"-    , oidcRedirectUri           = error "You must specify redirectUri"-    , oidcProvider              = error "You must specify provider"+    { oidcAuthorizationServerUrl = error "You must specify authorizationServerUrl"+    , oidcTokenEndpoint          = error "You must specify tokenEndpoint"+    , oidcClientId               = error "You must specify clientId"+    , oidcClientSecret           = error "You must specify clientSecret"+    , oidcRedirectUri            = error "You must specify redirectUri"+    , oidcProvider               = error "You must specify provider"     }  newOIDC     :: Provider     -- ^ OP's information (obtained by 'Web.OIDC.Client.Discovery.discover')     -> OIDC newOIDC p =-    def { oidcAuthorizationSeverUrl = P.authorizationEndpoint . P.configuration $ p-        , oidcTokenEndpoint         = P.tokenEndpoint . P.configuration $ p-        , oidcProvider              = p+    def { oidcAuthorizationServerUrl = P.authorizationEndpoint . P.configuration $ p+        , oidcTokenEndpoint          = P.tokenEndpoint . P.configuration $ p+        , oidcProvider               = p         }  setCredentials

@@ -7,7 +7,8 @@ -} module Web.OIDC.Client.Types     (-      ScopeValue(..)+      ScopeValue+    , openId, profile, email, address, phone, offlineAccess     , Scope     , State     , Parameters@@ -16,60 +17,24 @@     , OpenIdException(..)     ) where -import Control.Applicative ((<*), (*>), (<|>)) import Control.Exception (Exception)-import Data.Aeson (FromJSON, parseJSON, withText)-import Data.Attoparsec.Text (parseOnly, endOfInput, string) import Data.ByteString (ByteString)-import Data.List (isPrefixOf)-import Data.Text (Text, pack)+import Data.Text (Text) import Data.Typeable (Typeable) import Jose.Jwt (JwtError) import Network.HTTP.Client (HttpException)  type IssuerLocation = Text -data ScopeValue =-      OpenId-    | Profile-    | Email-    | Address-    | Phone-    | OfflineAccess-    deriving (Eq)--instance Show ScopeValue where-    show OpenId         = "openid"-    show Profile        = "profile"-    show Email          = "email"-    show Address        = "address"-    show Phone          = "phone"-    show OfflineAccess  = "offline_access"--instance Read ScopeValue where-    readsPrec _ s-        | "openid"          `isPrefixOf` s = [(OpenId, drop 6 s)]-        | "profile"         `isPrefixOf` s = [(Profile, drop 7 s)]-        | "email"           `isPrefixOf` s = [(Email, drop 5 s)]-        | "address"         `isPrefixOf` s = [(Address, drop 7 s)]-        | "phone"           `isPrefixOf` s = [(Phone, drop 5 s)]-        | "offline_access"  `isPrefixOf` s = [(OfflineAccess, drop 14 s)]-        | otherwise = []+type ScopeValue = Text -instance FromJSON ScopeValue where-    parseJSON = withText "ScopeValue" (run parser)-      where-        run p t =-            case parseOnly (p <* endOfInput) t of-                Right r   -> return r-                Left  err -> fail $ "could not parse scope value: " ++ err-        parser =    parser' OpenId-                <|> parser' Profile-                <|> parser' Email-                <|> parser' Address-                <|> parser' Phone-                <|> parser' OfflineAccess-        parser' v = string (pack . show $ v) *> return v+openId, profile, email, address, phone, offlineAccess :: ScopeValue+openId        = "openid"+profile       = "profile"+email         = "email"+address       = "address"+phone         = "phone"+offlineAccess = "offline_access"  type Scope = [ScopeValue] 

@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+module Spec.Client where++import Data.ByteString (ByteString)+import Data.Text (unpack)+import Data.Text.Encoding (decodeUtf8)+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types (urlEncode)+import Test.Hspec (Spec, describe, it, shouldContain, shouldNotContain, shouldThrow)+import Web.OIDC.Client++clientId, clientSecret, redirectUri, nonce :: ByteString+clientId = "dummy client id"+clientSecret = "dummy client secret"+redirectUri = "http://localhost"+nonce = "dummy nonce"++tests :: Spec+tests = do+    describe "CodeFlow.getAuthenticationRequestUrl" $ do++        it "should return a url that has required parameters" $ do+            manager  <- newManager tlsManagerSettings+            provider <- discover google manager+            let oidc = setCredentials clientId clientSecret redirectUri $ newOIDC provider+            url <- getAuthenticationRequestUrl oidc [] Nothing []+            show url `shouldContain` "response_type=code"+            show url `shouldContain` "scope=openid"+            show url `shouldContain` (toES "client_id" ++ "=" ++ toES clientId)+            show url `shouldContain` (toES "redirect_uri" ++ "=" ++ toES redirectUri)+            show url `shouldNotContain` toES clientSecret++        it "should return a url that has other parameters" $ do+            manager  <- newManager tlsManagerSettings+            provider <- discover google manager+            let oidc = setCredentials clientId clientSecret redirectUri $ newOIDC provider+                state = "dummy state"+            url <- getAuthenticationRequestUrl oidc [email] (Just state) [("nonce", Just nonce)]+            show url `shouldContain` (toES "scope" ++ "=" ++ toES "openid email")+            show url `shouldContain` (toES "state" ++ "=" ++ toES state)+            show url `shouldContain` (toES "nonce" ++ "=" ++ toES nonce)++    describe "CodeFlow.validateClaims" $ do+        it "should succeed at a validation of correct claims" $ do+            let issuer' = "http://localhost"+                clientId' = decodeUtf8 clientId+            now <- getCurrentIntDate+            let claims' = defClaims { jwtIss = Just issuer'+                                    , jwtAud = Just [clientId']+                                    , jwtExp = Just (add 10 now)+                                    }+            validateClaims issuer' clientId' now claims'+            validateClaims issuer' clientId' now (claims' { jwtAud = Just ["other id", clientId'] })++        it "should throw ValidationException if 'iss' field is invalid" $ do+            let issuer' = "http://localhost"+                clientId' = decodeUtf8 clientId+            now <- getCurrentIntDate+            let claims' = defClaims { jwtIss = Just "http://localhost/hoge"+                                    , jwtAud = Just [clientId']+                                    , jwtExp = Just (add 10 now)+                                    }+            validateClaims issuer' clientId' now claims'+                `shouldThrow` isValidationException++        it "should throw ValidationException if 'aud' field does not contain Client ID" $ do+            let issuer' = "http://localhost"+                clientId' = decodeUtf8 clientId+            now <- getCurrentIntDate+            let claims' = defClaims { jwtIss = Just issuer'+                                    , jwtAud = Just ["other id"]+                                    , jwtExp = Just (add 10 now)+                                    }+            validateClaims issuer' clientId' now claims'+                `shouldThrow` isValidationException++        it "should throw ValidationException if 'exp' field expired" $ do+            let issuer' = "http://localhost"+                clientId' = decodeUtf8 clientId+            now <- getCurrentIntDate+            let claims' = defClaims { jwtIss = Just issuer'+                                    , jwtAud = Just [clientId']+                                    , jwtExp = Just (add (-1) now)+                                    }+            validateClaims issuer' clientId' now claims'+                `shouldThrow` isValidationException++  where+    toES = unpack . decodeUtf8 . urlEncode True+    defClaims = JwtClaims { jwtIss = Nothing+                          , jwtSub = Nothing+                          , jwtAud = Nothing+                          , jwtExp = Nothing+                          , jwtNbf = Nothing+                          , jwtIat = Nothing+                          , jwtJti = Nothing+                          }+    add sec (IntDate t) = IntDate $ t + sec+    isValidationException e = case e of+        (ValidationException _) -> True+        _                       -> False