module Network.OpenID.Easy (
Config(..),
Session(..),
auth, verify, config, readSession
) where
import Network.OpenID
import Network.Socket (withSocketsDo)
data Config = Config {
verifyError :: String -> IO (),
normalizeError :: IO Session,
discoverError, associateError :: String -> IO Session
}
config :: Config
config = Config {
normalizeError = fail "Unable to normalize identifier",
discoverError = fail . ("Discovery Error: " ++),
associateError = fail . ("Associate Error: " ++),
verifyError = fail . ("Verify Error: " ++)
}
data Session = Session {
sAuthURI :: String,
sProvider :: String,
sIdentity :: String,
sReturnTo :: String,
sAssocMap :: AssociationMap
} deriving (Read,Show)
readSession :: String -> Session
readSession = read
auth :: Config -> String -> String -> IO Session
auth config ident returnTo = withSocketsDo $ do
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
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
}
resolver :: Resolver IO
resolver = makeRequest True
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 ()