openid 0.1.3.0 → 0.1.4.6

raw patch · 9 files changed

+169/−20 lines, 9 filesdep ~HsOpenSSLdep ~containersdep ~monadLibPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HsOpenSSL, containers, monadLib

API changes (from Hackage documentation)

Files

• examples/easy.hs +41/−0
• examples/test.hs +1/−2
• openid.cabal +7/−6
• src/Data/Digest/OpenSSL/SHA.hs +0/−1
• src/Network/OpenID/Association.hs +1/−2
• src/Network/OpenID/Association/Map.hs +2/−2
• src/Network/OpenID/Easy.hs +106/−0
• src/Network/OpenID/Types.hs +11/−5
• src/Network/OpenID/Utils.hs +0/−2

@@ -0,0 +1,41 @@+import qualified Network.OpenID.Easy as ID+import System.Environment (getArgs)++main = do+    -- default set of error handlers just fail on errors+    let config = ID.config+    +    -- ident is the string the user would usually type in a textbox themselves+    -- returnTo is the uri the user will be forwarded to after authentication+    [ident,returnTo] <- getArgs+    +    -- authenticate with the remote provider and collect the information+    -- necessary to verify the identity+    session <- ID.auth config ident returnTo+    +    -- At this point, session data can be written to a file or a database as a+    -- string with show and read back later once the user arrives back at the+    -- forwarded page. The Session type derives Read and Show.+    +    -- The session has records for the normalized identity and provider strings.+    putStrLn $ "Normalized Ident: " ++ ID.sIdentity session+    putStrLn $ "Provider: " ++ ID.sProvider session+    +    -- Forward the user along to the authentication uri, or else just copy/paste+    -- this link in this command-line demonstration.+    putStrLn $ "Forward: " ++ ID.sAuthURI session+    +    -- Use the uri the user landed back at for the verify step.+    -- In a real web application, you'd read this from something like the+    -- environment's REQUEST_URI.+    putStrLn "Paste the uri you were returned to:"+    uri <- getLine+    +    -- Verify the credentials. The query parameters from the uri are parsed to+    -- make sure everything checks out.+    -- This step will fail by calling the config's verifyError if the user can't+    -- be verified.+    ID.verify config session uri+    +    -- Success!+    putStrLn $ "Verified as '" ++ ID.sIdentity session ++ "'!"

@@ -1,7 +1,6 @@  import MonadLib-import Network.OpenID-import Network.SSL+import Network.OpenID.HTTP  import Network.Socket import System.Environment

@@ -1,5 +1,5 @@ name:               openid-version:            0.1.3.0+version:            0.1.4.6 cabal-version:      >= 1.6 synopsis:           An implementation of the OpenID-2.0 spec. description:        An implementation of the OpenID-2.0 spec.@@ -11,8 +11,8 @@ license:            BSD3 license-file:       LICENSE build-type:         Simple-tested-with:        GHC == 6.8.2-extra-source-files: examples/Makefile, examples/test.hs+tested-with:        GHC == 6.12.1+extra-source-files: examples/Makefile, examples/test.hs examples/easy.hs   flag split-base@@ -23,16 +23,16 @@   if flag(split-base)     build-depends: base       >= 3 && < 10,                    bytestring == 0.9.1.*,-                   containers == 0.2.*+                   containers >= 0.2 && < 0.4   else     build-depends: base < 3   build-depends:   HTTP      >= 4000.0.5 && < 4000.1,-                   monadLib  == 3.5.*,+                   monadLib  == 3.6.*,                    nano-hmac == 0.2.*,                    network   == 2.2.*,                    time      == 1.1.*,                    xml       == 1.3.*,-                   HsOpenSSL == 0.6.*+                   HsOpenSSL == 0.8.*   hs-source-dirs:  src   exposed-modules: Codec.Binary.Base64,                    Codec.Encryption.DH,@@ -47,6 +47,7 @@                    Network.OpenID.Normalization,                    Network.OpenID.Types,                    Network.OpenID.Utils,+                   Network.OpenID.Easy,                    Text.XRDS   other-modules:   Network.OpenID.SSL   ghc-options:     -W

@@ -1,4 +1,3 @@-{-# INCLUDE <openssl/evp.h> #-} {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}  --------------------------------------------------------------------------------

@@ -37,7 +37,6 @@  -- Libraries import Data.Bits-import Data.List import Data.Maybe import Data.Time import Data.Word@@ -168,7 +167,7 @@         let body = formatParams                  $ ("openid.ns", openidNS)                  : ("openid.mode", "associate")-                 : ("openid.assoc_type", show at)+                 : ("openid.assoc_type", assocString at)                  : ("openid.session_type", show st)                  : maybe [] dhPairs mb_dh         ersp <- lift $ resolve $ Network.OpenID.HTTP.postRequest (providerURI prov) body

@@ -12,7 +12,7 @@  module Network.OpenID.Association.Map (     -- Association Map-    AssociationMap+    AssociationMap(..)   , emptyAssociationMap   ) where @@ -27,7 +27,7 @@  -- | A simple association manager based on Data.Map newtype AssociationMap = AM (Map.Map String (UTCTime,Association))-  deriving Show+    deriving (Show,Read)  instance AssociationManager AssociationMap where   findAssociation (AM m) p = snd `fmap` Map.lookup (showProvider p) m

@@ -0,0 +1,106 @@++--------------------------------------------------------------------------------+-- |+-- Module      : Network.OpenID.Easy+-- Copyright   : (c) James Halliday, 2009+-- License     : BSD3+--+-- Maintainer  : James Halliday <substack@gmail.com>+-- Stability   : +-- Portability : +--++module Network.OpenID.Easy (+    Config(..),+    Session(..),+    auth, verify, config, readSession+) where++import Network.OpenID+import Network.Socket (withSocketsDo)+ +-- | Provides configuration settings for verify and auth. For now, this is just+--   the errors which may be thrown by either.+data Config = Config {+    verifyError :: String -> IO (),+    normalizeError :: IO Session,+    discoverError, associateError :: String -> IO Session+}++-- | Provide default configuration with error handlers that just fail with a+--   useful message when errors happen. This behavior is what most people would+--   probably end up writing themselves anyways.+config :: Config+config = Config {+    normalizeError = fail "Unable to normalize identifier",+    discoverError = fail . ("Discovery Error: " ++),+    associateError = fail . ("Associate Error: " ++),+    verifyError = fail . ("Verify Error: " ++)+}++-- | Wrap up all the data necessary to do a verify into one place, plus some+--   extra useful stuff.+data Session = Session {+    -- | the authentication uri to send the client off to+    sAuthURI :: String,+    -- | the OpenID provider as a string+    sProvider :: String,+    -- | the normalized OpenID identity as a string+    sIdentity :: String,+    -- | the uri the client will come back to after authenticating+    sReturnTo :: String,+    -- | the association map manager thing used internally+    sAssocMap :: AssociationMap+} deriving (Read,Show)++readSession :: String -> Session+readSession = read++-- | Given a configuration, identity, and return uri,+--   contact the remote provider to create a Session object encapsulating the+--   useful bits of data to pass along to verify and also to pick out the+--   normalized identity from.+auth :: Config -> String -> String -> IO Session+auth config ident returnTo = withSocketsDo $ do+    -- this bit is heavily based on the old examples/test.hs+    case normalizeIdentifier (Identifier ident) of+        Nothing -> normalizeError config+        Just normalizedIdent -> do+            let resolve = makeRequest True+            rpi <- discover resolve normalizedIdent+            case rpi of+                Left err -> discoverError config $ show err+                Right (provider,identifier) -> do+                    -- either an error or an association manager+                    eam <- associate emptyAssociationMap True resolve provider+                    case eam of+                        Left err -> associateError config $ show err+                        Right am ->+                            return $ Session {+                                sAuthURI = show $ authenticationURI+                                    am Setup provider identifier returnTo Nothing,+                                sProvider = show $ providerURI provider,+                                sIdentity = getIdentifier identifier,+                                sReturnTo = returnTo,+                                sAssocMap = am+                            }++-- use this to resolve stuff in auth and verify+resolver :: Resolver IO+resolver = makeRequest True++-- | Given a configuration, a Session generated by auth, and the uri that the+--   client came back on from the provider, make sure the client properly+--   authenticated by running verifyError on failure to verify the credentials.+verify :: Config -> Session -> String -> IO ()+verify config session uri = do+    let+        params = parseParams uri+    verified <- verifyAuthentication+        (sAssocMap session)+        params+        (sReturnTo session)+        resolver+    case verified of+        Left err -> verifyError config $ show err+        Right _ -> return ()

@@ -25,10 +25,10 @@   , modifyProvider   , Identifier(..)   , Error(..)+  , assocString   ) where  -- Libraries-import Control.Monad import Data.List import Data.Word import Network.URI@@ -41,16 +41,22 @@  -- | Supported association types data AssocType = HmacSha1 | HmacSha256+    deriving (Read,Show) +assocString :: AssocType -> String+assocString HmacSha1 = "HMAC-SHA1"+assocString HmacSha256 = "HMAC-SHA256"++{- instance Show AssocType where-  show HmacSha1   = "HMAC-SHA1"-  show HmacSha256 = "HMAC-SHA256"+    show HmacSha1 = "HMAC-SHA1"+    show HmacSha256 = "HMAC-SHA256"  instance Read AssocType where   readsPrec _ str | "HMAC-SHA1"   `isPrefixOf` str = [(HmacSha1  ,drop  9  str)]                   | "HMAC-SHA256" `isPrefixOf` str = [(HmacSha256, drop 11 str)]                   | otherwise                      = []-+-}  -- | Session types for association establishment data SessionType = NoEncryption | DhSha1 | DhSha256@@ -74,7 +80,7 @@   , assocHandle    :: String   , assocMacKey    :: [Word8]   , assocType      :: AssocType-  } deriving Show+  } deriving (Show,Read)   -- | Parameter lists for communication with the server

@@ -36,9 +36,7 @@  -- libraries import Data.Bits-import Data.Char import Data.List-import Data.Maybe import Data.Word import MonadLib import Network.HTTP