diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,25 +1,25 @@
-The following license covers this documentation, and the source code, except
-where otherwise indicated.
-
-Copyright 2008, Michael Snoyman. All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
-  list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice,
-  this list of conditions and the following disclaimer in the documentation
-  and/or other materials provided with the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+Copyright 2008, Michael Snoyman. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/OpenId2/Discovery.hs b/OpenId2/Discovery.hs
--- a/OpenId2/Discovery.hs
+++ b/OpenId2/Discovery.hs
@@ -1,189 +1,189 @@
-{-# LANGUAGE FlexibleContexts #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      : Network.OpenID.Discovery
--- Copyright   : (c) Trevor Elliott, 2008
--- License     : BSD3
---
--- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
--- Stability   :
--- Portability :
---
-
-module OpenId2.Discovery (
-    -- * Discovery
-    discover
-  , Discovery (..)
-  ) where
-
--- Friends
-import OpenId2.Types
-import OpenId2.XRDS
-
--- Libraries
-import Data.Char
-import Data.List
-import Data.Maybe
-import Network.HTTP.Enumerator
-import qualified Data.ByteString.Lazy.UTF8 as BSLU
-import qualified Data.ByteString.Char8 as S8
-import Control.Arrow (first, (***))
-import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Failure (Failure (failure))
-import Control.Monad (mplus, liftM)
-import qualified Data.CaseInsensitive as CI
-import Data.Text (Text, pack, unpack)
-
-data Discovery = Discovery1 String (Maybe String)
-               | Discovery2 Provider Identifier IdentType
-    deriving Show
-
--- | Attempt to resolve an OpenID endpoint, and user identifier.
-discover :: ( MonadIO m
-            , Failure AuthenticateException m
-            , Failure HttpException m
-            )
-         => Identifier
-         -> m Discovery
-discover ident@(Identifier i) = do
-    res1 <- discoverYADIS ident Nothing 10
-    case res1 of
-        Just (x, y, z) -> return $ Discovery2 x y z
-        Nothing -> do
-            res2 <- discoverHTML ident
-            case res2 of
-                Just x -> return x
-                Nothing -> failure $ DiscoveryException $ unpack i
-
--- YADIS-Based Discovery -------------------------------------------------------
-
--- | Attempt a YADIS based discovery, given a valid identifier.  The result is
---   an OpenID endpoint, and the actual identifier for the user.
-discoverYADIS :: ( MonadIO m
-                 , Failure HttpException m
-                 )
-              => Identifier
-              -> Maybe String
-              -> Int -- ^ remaining redirects
-              -> m (Maybe (Provider, Identifier, IdentType))
-discoverYADIS _ _ 0 = failure TooManyRedirects
-discoverYADIS ident mb_loc redirects = do
-    let uri = fromMaybe (unpack $ identifier ident) mb_loc
-    req <- parseUrl uri
-    res <- liftIO $ withManager $ httpLbs req
-    let mloc = fmap S8.unpack
-             $ lookup "x-xrds-location"
-             $ map (first $ map toLower . S8.unpack . CI.original)
-             $ responseHeaders res
-    let mloc' = if mloc == mb_loc then Nothing else mloc
-    case statusCode res of
-        200 ->
-          case mloc' of
-            Just loc -> discoverYADIS ident (Just loc) (redirects - 1)
-            Nothing  -> do
-              let mdoc = parseXRDS $ BSLU.toString $ responseBody res
-              case mdoc of
-                  Just doc -> return $ parseYADIS ident doc
-                  Nothing -> return Nothing
-        _ -> return Nothing
-
-
--- | Parse out an OpenID endpoint, and actual identifier from a YADIS xml
--- document.
-parseYADIS :: Identifier -> XRDS -> Maybe (Provider, Identifier, IdentType)
-parseYADIS ident = listToMaybe . mapMaybe isOpenId . concat
-  where
-  isOpenId svc = do
-    let tys = serviceTypes svc
-        localId = maybe ident (Identifier . pack) $ listToMaybe $ serviceLocalIDs svc
-        f (x,y) | x `elem` tys = Just y
-                | otherwise    = Nothing
-    (lid, itype) <- listToMaybe $ mapMaybe f
-      [ ("http://specs.openid.net/auth/2.0/server", (ident, OPIdent))
-      -- claimed identifiers
-      , ("http://specs.openid.net/auth/2.0/signon", (localId, ClaimedIdent))
-      , ("http://openid.net/signon/1.0"           , (localId, ClaimedIdent))
-      , ("http://openid.net/signon/1.1"           , (localId, ClaimedIdent))
-      ]
-    uri <- listToMaybe $ serviceURIs svc
-    return (Provider uri, lid, itype)
-
-
--- HTML-Based Discovery --------------------------------------------------------
-
--- | Attempt to discover an OpenID endpoint, from an HTML document.  The result
--- will be an endpoint on success, and the actual identifier of the user.
-discoverHTML :: ( MonadIO m, Failure HttpException m)
-             => Identifier
-             -> m (Maybe Discovery)
-discoverHTML ident'@(Identifier ident) =
-    (parseHTML ident' . BSLU.toString) `liftM` simpleHttp (unpack ident)
-
--- | Parse out an OpenID endpoint and an actual identifier from an HTML
--- document.
-parseHTML :: Identifier -> String -> Maybe Discovery
-parseHTML ident = resolve
-                . filter isOpenId
-                . map (dropQuotes *** dropQuotes)
-                . linkTags
-                . htmlTags
-  where
-    isOpenId (rel,_) = "openid" `isPrefixOf` rel
-    resolve1 ls = do
-      server <- lookup "openid.server" ls
-      let delegate = lookup "openid.delegate" ls
-      return $ Discovery1 server delegate
-    resolve2 ls = do
-      prov <- lookup "openid2.provider" ls
-      let lid = maybe ident (Identifier . pack) $ lookup "openid2.local_id" ls
-      -- Based on OpenID 2.0 spec, section 7.3.3, HTML discovery can only
-      -- result in a claimed identifier.
-      return $ Discovery2 (Provider prov) lid ClaimedIdent
-    resolve ls = resolve2 ls `mplus` resolve1 ls
-
-
--- FIXME this would all be a lot better if it used tagsoup
--- | Filter out link tags from a list of html tags.
-linkTags :: [String] -> [(String,String)]
-linkTags  = mapMaybe f . filter p
-  where
-    p = ("link " `isPrefixOf`)
-    f xs = do
-      let ys = unfoldr splitAttr (drop 5 xs)
-      x <- lookup "rel"  ys
-      y <- lookup "href" ys
-      return (x,y)
-
-
--- | Split a string into strings of html tags.
-htmlTags :: String -> [String]
-htmlTags [] = []
-htmlTags xs = case break (== '<') xs of
-  (as,_:bs) -> fmt as : htmlTags bs
-  (as,[])   -> [as]
-  where
-    fmt as = case break (== '>') as of
-      (bs,_) -> bs
-
-
--- | Split out values from a key="value" like string, in a way that
--- is suitable for use with unfoldr.
-splitAttr :: String -> Maybe ((String,String),String)
-splitAttr xs = case break (== '=') xs of
-  (_,[])         -> Nothing
-  (key,_:'"':ys) -> f key (== '"') ys
-  (key,_:ys)     -> f key isSpace  ys
-  where
-  f key p cs = case break p cs of
-      (_,[])         -> Nothing
-      (value,_:rest) -> Just ((key,value), dropWhile isSpace rest)
-
-dropQuotes :: String -> String
-dropQuotes s@('\'':x:y)
-    | last y == '\'' = x : init y
-    | otherwise = s
-dropQuotes s@('"':x:y)
-    | last y == '"' = x : init y
-    | otherwise = s
-dropQuotes s = s
+{-# LANGUAGE FlexibleContexts #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      : Network.OpenID.Discovery
+-- Copyright   : (c) Trevor Elliott, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
+-- Stability   :
+-- Portability :
+--
+
+module OpenId2.Discovery (
+    -- * Discovery
+    discover
+  , Discovery (..)
+  ) where
+
+-- Friends
+import OpenId2.Types
+import OpenId2.XRDS
+
+-- Libraries
+import Data.Char
+import Data.List
+import Data.Maybe
+import Network.HTTP.Enumerator
+import qualified Data.ByteString.Lazy.UTF8 as BSLU
+import qualified Data.ByteString.Char8 as S8
+import Control.Arrow (first, (***))
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Failure (Failure (failure))
+import Control.Monad (mplus, liftM)
+import qualified Data.CaseInsensitive as CI
+import Data.Text (Text, pack, unpack)
+
+data Discovery = Discovery1 String (Maybe String)
+               | Discovery2 Provider Identifier IdentType
+    deriving Show
+
+-- | Attempt to resolve an OpenID endpoint, and user identifier.
+discover :: ( MonadIO m
+            , Failure AuthenticateException m
+            , Failure HttpException m
+            )
+         => Identifier
+         -> m Discovery
+discover ident@(Identifier i) = do
+    res1 <- discoverYADIS ident Nothing 10
+    case res1 of
+        Just (x, y, z) -> return $ Discovery2 x y z
+        Nothing -> do
+            res2 <- discoverHTML ident
+            case res2 of
+                Just x -> return x
+                Nothing -> failure $ DiscoveryException $ unpack i
+
+-- YADIS-Based Discovery -------------------------------------------------------
+
+-- | Attempt a YADIS based discovery, given a valid identifier.  The result is
+--   an OpenID endpoint, and the actual identifier for the user.
+discoverYADIS :: ( MonadIO m
+                 , Failure HttpException m
+                 )
+              => Identifier
+              -> Maybe String
+              -> Int -- ^ remaining redirects
+              -> m (Maybe (Provider, Identifier, IdentType))
+discoverYADIS _ _ 0 = failure TooManyRedirects
+discoverYADIS ident mb_loc redirects = do
+    let uri = fromMaybe (unpack $ identifier ident) mb_loc
+    req <- parseUrl uri
+    res <- liftIO $ withManager $ httpLbs req
+    let mloc = fmap S8.unpack
+             $ lookup "x-xrds-location"
+             $ map (first $ map toLower . S8.unpack . CI.original)
+             $ responseHeaders res
+    let mloc' = if mloc == mb_loc then Nothing else mloc
+    case statusCode res of
+        200 ->
+          case mloc' of
+            Just loc -> discoverYADIS ident (Just loc) (redirects - 1)
+            Nothing  -> do
+              let mdoc = parseXRDS $ BSLU.toString $ responseBody res
+              case mdoc of
+                  Just doc -> return $ parseYADIS ident doc
+                  Nothing -> return Nothing
+        _ -> return Nothing
+
+
+-- | Parse out an OpenID endpoint, and actual identifier from a YADIS xml
+-- document.
+parseYADIS :: Identifier -> XRDS -> Maybe (Provider, Identifier, IdentType)
+parseYADIS ident = listToMaybe . mapMaybe isOpenId . concat
+  where
+  isOpenId svc = do
+    let tys = serviceTypes svc
+        localId = maybe ident (Identifier . pack) $ listToMaybe $ serviceLocalIDs svc
+        f (x,y) | x `elem` tys = Just y
+                | otherwise    = Nothing
+    (lid, itype) <- listToMaybe $ mapMaybe f
+      [ ("http://specs.openid.net/auth/2.0/server", (ident, OPIdent))
+      -- claimed identifiers
+      , ("http://specs.openid.net/auth/2.0/signon", (localId, ClaimedIdent))
+      , ("http://openid.net/signon/1.0"           , (localId, ClaimedIdent))
+      , ("http://openid.net/signon/1.1"           , (localId, ClaimedIdent))
+      ]
+    uri <- listToMaybe $ serviceURIs svc
+    return (Provider uri, lid, itype)
+
+
+-- HTML-Based Discovery --------------------------------------------------------
+
+-- | Attempt to discover an OpenID endpoint, from an HTML document.  The result
+-- will be an endpoint on success, and the actual identifier of the user.
+discoverHTML :: ( MonadIO m, Failure HttpException m)
+             => Identifier
+             -> m (Maybe Discovery)
+discoverHTML ident'@(Identifier ident) =
+    (parseHTML ident' . BSLU.toString) `liftM` simpleHttp (unpack ident)
+
+-- | Parse out an OpenID endpoint and an actual identifier from an HTML
+-- document.
+parseHTML :: Identifier -> String -> Maybe Discovery
+parseHTML ident = resolve
+                . filter isOpenId
+                . map (dropQuotes *** dropQuotes)
+                . linkTags
+                . htmlTags
+  where
+    isOpenId (rel,_) = "openid" `isPrefixOf` rel
+    resolve1 ls = do
+      server <- lookup "openid.server" ls
+      let delegate = lookup "openid.delegate" ls
+      return $ Discovery1 server delegate
+    resolve2 ls = do
+      prov <- lookup "openid2.provider" ls
+      let lid = maybe ident (Identifier . pack) $ lookup "openid2.local_id" ls
+      -- Based on OpenID 2.0 spec, section 7.3.3, HTML discovery can only
+      -- result in a claimed identifier.
+      return $ Discovery2 (Provider prov) lid ClaimedIdent
+    resolve ls = resolve2 ls `mplus` resolve1 ls
+
+
+-- FIXME this would all be a lot better if it used tagsoup
+-- | Filter out link tags from a list of html tags.
+linkTags :: [String] -> [(String,String)]
+linkTags  = mapMaybe f . filter p
+  where
+    p = ("link " `isPrefixOf`)
+    f xs = do
+      let ys = unfoldr splitAttr (drop 5 xs)
+      x <- lookup "rel"  ys
+      y <- lookup "href" ys
+      return (x,y)
+
+
+-- | Split a string into strings of html tags.
+htmlTags :: String -> [String]
+htmlTags [] = []
+htmlTags xs = case break (== '<') xs of
+  (as,_:bs) -> fmt as : htmlTags bs
+  (as,[])   -> [as]
+  where
+    fmt as = case break (== '>') as of
+      (bs,_) -> bs
+
+
+-- | Split out values from a key="value" like string, in a way that
+-- is suitable for use with unfoldr.
+splitAttr :: String -> Maybe ((String,String),String)
+splitAttr xs = case break (== '=') xs of
+  (_,[])         -> Nothing
+  (key,_:'"':ys) -> f key (== '"') ys
+  (key,_:ys)     -> f key isSpace  ys
+  where
+  f key p cs = case break p cs of
+      (_,[])         -> Nothing
+      (value,_:rest) -> Just ((key,value), dropWhile isSpace rest)
+
+dropQuotes :: String -> String
+dropQuotes s@('\'':x:y)
+    | last y == '\'' = x : init y
+    | otherwise = s
+dropQuotes s@('"':x:y)
+    | last y == '"' = x : init y
+    | otherwise = s
+dropQuotes s = s
diff --git a/OpenId2/Normalization.hs b/OpenId2/Normalization.hs
--- a/OpenId2/Normalization.hs
+++ b/OpenId2/Normalization.hs
@@ -1,68 +1,68 @@
-{-# LANGUAGE FlexibleContexts #-}
---------------------------------------------------------------------------------
--- |
--- Module      : Network.OpenID.Normalization
--- Copyright   : (c) Trevor Elliott, 2008
--- License     : BSD3
---
--- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
--- Stability   : 
--- Portability : 
---
-
-module OpenId2.Normalization
-    ( normalize
-    ) where
-
--- Friends
-import OpenId2.Types
-
--- Libraries
-import Control.Applicative
-import Control.Monad
-import Data.List
-import Control.Failure (Failure (..))
-import Network.URI
-    ( uriToString, normalizeCase, normalizeEscape
-    , normalizePathSegments, parseURI, uriPath, uriScheme, uriFragment
-    )
-import Data.Text (Text, pack, unpack)
-
-normalize :: Failure AuthenticateException m => Text -> m Identifier
-normalize ident =
-    case normalizeIdentifier $ Identifier ident of
-        Just i -> return i
-        Nothing -> failure $ NormalizationException $ unpack ident
-
--- | Normalize an identifier, discarding XRIs.
-normalizeIdentifier :: Identifier -> Maybe Identifier
-normalizeIdentifier  = normalizeIdentifier' (const Nothing)
-
-
--- | Normalize the user supplied identifier, using a supplied function to
--- normalize an XRI.
-normalizeIdentifier' :: (String -> Maybe String) -> Identifier
-                     -> Maybe Identifier
-normalizeIdentifier' xri (Identifier str')
-  | null str                  = Nothing
-  | "xri://" `isPrefixOf` str = (Identifier . pack) `fmap` xri str
-  | head str `elem` "=@+$!"   = (Identifier . pack) `fmap` xri str
-  | otherwise = fmt `fmap` (url >>= norm)
-  where
-    str = unpack str'
-    url = parseURI str <|> parseURI ("http://" ++ str)
-
-    norm uri = validScheme >> return u
-      where
-        scheme'     = uriScheme uri
-        validScheme = guard (scheme' == "http:" || scheme' == "https:")
-        u = uri { uriFragment = "", uriPath = path' }
-        path' | null (uriPath uri) = "/"
-              | otherwise          = uriPath uri
-
-    fmt u = Identifier
-          $ pack
-          $ normalizePathSegments
-          $ normalizeEscape
-          $ normalizeCase
-          $ uriToString (const "") u []
+{-# LANGUAGE FlexibleContexts #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      : Network.OpenID.Normalization
+-- Copyright   : (c) Trevor Elliott, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
+-- Stability   : 
+-- Portability : 
+--
+
+module OpenId2.Normalization
+    ( normalize
+    ) where
+
+-- Friends
+import OpenId2.Types
+
+-- Libraries
+import Control.Applicative
+import Control.Monad
+import Data.List
+import Control.Failure (Failure (..))
+import Network.URI
+    ( uriToString, normalizeCase, normalizeEscape
+    , normalizePathSegments, parseURI, uriPath, uriScheme, uriFragment
+    )
+import Data.Text (Text, pack, unpack)
+
+normalize :: Failure AuthenticateException m => Text -> m Identifier
+normalize ident =
+    case normalizeIdentifier $ Identifier ident of
+        Just i -> return i
+        Nothing -> failure $ NormalizationException $ unpack ident
+
+-- | Normalize an identifier, discarding XRIs.
+normalizeIdentifier :: Identifier -> Maybe Identifier
+normalizeIdentifier  = normalizeIdentifier' (const Nothing)
+
+
+-- | Normalize the user supplied identifier, using a supplied function to
+-- normalize an XRI.
+normalizeIdentifier' :: (String -> Maybe String) -> Identifier
+                     -> Maybe Identifier
+normalizeIdentifier' xri (Identifier str')
+  | null str                  = Nothing
+  | "xri://" `isPrefixOf` str = (Identifier . pack) `fmap` xri str
+  | head str `elem` "=@+$!"   = (Identifier . pack) `fmap` xri str
+  | otherwise = fmt `fmap` (url >>= norm)
+  where
+    str = unpack str'
+    url = parseURI str <|> parseURI ("http://" ++ str)
+
+    norm uri = validScheme >> return u
+      where
+        scheme'     = uriScheme uri
+        validScheme = guard (scheme' == "http:" || scheme' == "https:")
+        u = uri { uriFragment = "", uriPath = path' }
+        path' | null (uriPath uri) = "/"
+              | otherwise          = uriPath uri
+
+    fmt u = Identifier
+          $ pack
+          $ normalizePathSegments
+          $ normalizeEscape
+          $ normalizeCase
+          $ uriToString (const "") u []
diff --git a/OpenId2/Types.hs b/OpenId2/Types.hs
--- a/OpenId2/Types.hs
+++ b/OpenId2/Types.hs
@@ -1,34 +1,34 @@
-{-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------------------------------
--- |
--- Module      : Network.OpenID.Types
--- Copyright   : (c) Trevor Elliott, 2008
--- License     : BSD3
---
--- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
--- Stability   : 
--- Portability : 
---
-
-module OpenId2.Types (
-    Provider (..)
-  , Identifier (..)
-  , IdentType (..)
-  , AuthenticateException (..)
-  ) where
-
--- Libraries
-import Data.Data (Data)
-import Data.Typeable (Typeable)
-import Web.Authenticate.Internal
-import Data.Text (Text)
-
--- | An OpenID provider.
-newtype Provider = Provider { providerURI :: String } deriving (Eq,Show)
-
--- | A valid OpenID identifier.
-newtype Identifier = Identifier { identifier :: Text }
-    deriving (Eq, Ord, Show, Read, Data, Typeable)
-
-data IdentType = OPIdent | ClaimedIdent
-    deriving (Eq, Ord, Show, Read, Data, Typeable)
+{-# LANGUAGE DeriveDataTypeable #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      : Network.OpenID.Types
+-- Copyright   : (c) Trevor Elliott, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
+-- Stability   : 
+-- Portability : 
+--
+
+module OpenId2.Types (
+    Provider (..)
+  , Identifier (..)
+  , IdentType (..)
+  , AuthenticateException (..)
+  ) where
+
+-- Libraries
+import Data.Data (Data)
+import Data.Typeable (Typeable)
+import Web.Authenticate.Internal
+import Data.Text (Text)
+
+-- | An OpenID provider.
+newtype Provider = Provider { providerURI :: String } deriving (Eq,Show)
+
+-- | A valid OpenID identifier.
+newtype Identifier = Identifier { identifier :: Text }
+    deriving (Eq, Ord, Show, Read, Data, Typeable)
+
+data IdentType = OPIdent | ClaimedIdent
+    deriving (Eq, Ord, Show, Read, Data, Typeable)
diff --git a/OpenId2/XRDS.hs b/OpenId2/XRDS.hs
--- a/OpenId2/XRDS.hs
+++ b/OpenId2/XRDS.hs
@@ -1,101 +1,101 @@
-
---------------------------------------------------------------------------------
--- |
--- Module      : Text.XRDS
--- Copyright   : (c) Trevor Elliott, 2008
--- License     : BSD3
---
--- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
--- Stability   :
--- Portability :
---
-
-module OpenId2.XRDS (
-    -- * Types
-    XRDS
-  , Service(..)
-
-    -- * Parsing
-  , parseXRDS
-  ) where
-
--- Libraries
-import Control.Arrow
-import Control.Monad
-import Data.List
-import Data.Maybe
-import Text.XML.Light
-
-
--- Types -----------------------------------------------------------------------
-
-type XRDS = [XRD]
-
-type XRD = [Service]
-
-data Service = Service
-  { serviceTypes      :: [String]
-  , serviceMediaTypes :: [String]
-  , serviceURIs       :: [String]
-  , serviceLocalIDs   :: [String]
-  , servicePriority   :: Maybe Int
-  , serviceExtra      :: [Element]
-  } deriving Show
-
--- Utilities -------------------------------------------------------------------
-
--- | Generate a tag name predicate, that ignores prefix and namespace.
-tag :: String -> Element -> Bool
-tag n el = qName (elName el) == n
-
-
--- | Filter the attributes of an element by some predicate
-findAttr' :: (QName -> Bool) -> Element -> Maybe String
-findAttr' p el = attrVal `fmap` find (p . attrKey) (elAttribs el)
-
-
--- | Read, maybe
-readMaybe :: Read a => String -> Maybe a
-readMaybe str = case reads str of
-  [(x,"")] -> Just x
-  _        -> Nothing
-
-
--- | Get the text of an element
-getText :: Element -> String
-getText el = case elContent el of
-  [Text cd] -> cdData cd
-  _         -> []
-
--- Parsing ---------------------------------------------------------------------
-
-
-parseXRDS :: String -> Maybe XRDS
-parseXRDS str = do
-  doc <- parseXMLDoc str
-  let xrds = filterChildren (tag "XRD") doc
-  return $ map parseXRD xrds
-
-
-parseXRD :: Element -> XRD
-parseXRD el =
-  let svcs = filterChildren (tag "Service") el
-   in mapMaybe parseService svcs
-
-
-parseService :: Element -> Maybe Service
-parseService el = do
-  let vals t x = first (map getText) $ partition (tag t) x
-      (tys,tr)    = vals "Type"      (elChildren el)
-      (mts,mr)    = vals "MediaType" tr
-      (uris,ur)   = vals "URI"       mr
-      (lids,rest) = vals "LocalID"   ur
-      priority = readMaybe =<< findAttr' (("priority" ==) . qName) el
-  guard $ not $ null tys
-  return $ Service { serviceTypes      = tys
-                   , serviceMediaTypes = mts
-                   , serviceURIs       = uris
-                   , serviceLocalIDs   = lids
-                   , servicePriority   = priority
-                   , serviceExtra      = rest
-                   }
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      : Text.XRDS
+-- Copyright   : (c) Trevor Elliott, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
+-- Stability   :
+-- Portability :
+--
+
+module OpenId2.XRDS (
+    -- * Types
+    XRDS
+  , Service(..)
+
+    -- * Parsing
+  , parseXRDS
+  ) where
+
+-- Libraries
+import Control.Arrow
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Text.XML.Light
+
+
+-- Types -----------------------------------------------------------------------
+
+type XRDS = [XRD]
+
+type XRD = [Service]
+
+data Service = Service
+  { serviceTypes      :: [String]
+  , serviceMediaTypes :: [String]
+  , serviceURIs       :: [String]
+  , serviceLocalIDs   :: [String]
+  , servicePriority   :: Maybe Int
+  , serviceExtra      :: [Element]
+  } deriving Show
+
+-- Utilities -------------------------------------------------------------------
+
+-- | Generate a tag name predicate, that ignores prefix and namespace.
+tag :: String -> Element -> Bool
+tag n el = qName (elName el) == n
+
+
+-- | Filter the attributes of an element by some predicate
+findAttr' :: (QName -> Bool) -> Element -> Maybe String
+findAttr' p el = attrVal `fmap` find (p . attrKey) (elAttribs el)
+
+
+-- | Read, maybe
+readMaybe :: Read a => String -> Maybe a
+readMaybe str = case reads str of
+  [(x,"")] -> Just x
+  _        -> Nothing
+
+
+-- | Get the text of an element
+getText :: Element -> String
+getText el = case elContent el of
+  [Text cd] -> cdData cd
+  _         -> []
+
+-- Parsing ---------------------------------------------------------------------
+
+
+parseXRDS :: String -> Maybe XRDS
+parseXRDS str = do
+  doc <- parseXMLDoc str
+  let xrds = filterChildren (tag "XRD") doc
+  return $ map parseXRD xrds
+
+
+parseXRD :: Element -> XRD
+parseXRD el =
+  let svcs = filterChildren (tag "Service") el
+   in mapMaybe parseService svcs
+
+
+parseService :: Element -> Maybe Service
+parseService el = do
+  let vals t x = first (map getText) $ partition (tag t) x
+      (tys,tr)    = vals "Type"      (elChildren el)
+      (mts,mr)    = vals "MediaType" tr
+      (uris,ur)   = vals "URI"       mr
+      (lids,rest) = vals "LocalID"   ur
+      priority = readMaybe =<< findAttr' (("priority" ==) . qName) el
+  guard $ not $ null tys
+  return $ Service { serviceTypes      = tys
+                   , serviceMediaTypes = mts
+                   , serviceURIs       = uris
+                   , serviceLocalIDs   = lids
+                   , servicePriority   = priority
+                   , serviceExtra      = rest
+                   }
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -1,7 +1,7 @@
-#!/usr/bin/env runhaskell
-
-> module Main where
-> import Distribution.Simple
-
-> main :: IO ()
-> main = defaultMain
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/Web/Authenticate/Facebook.hs b/Web/Authenticate/Facebook.hs
--- a/Web/Authenticate/Facebook.hs
+++ b/Web/Authenticate/Facebook.hs
@@ -1,92 +1,93 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Web.Authenticate.Facebook
-    ( Facebook (..)
-    , AccessToken (..)
-    , getForwardUrl
-    , getAccessToken
-    , getGraphData
-    ) where
-
-import Network.HTTP.Enumerator
-import Data.List (intercalate)
-import Data.Aeson
-import qualified Data.ByteString.Lazy.Char8 as L8
-import Web.Authenticate.Internal (qsEncode)
-import Data.Data (Data)
-import Data.Typeable (Typeable)
-import Control.Exception (Exception, throwIO)
-import Data.Attoparsec.Lazy (parse, eitherResult)
-import qualified Data.ByteString.Char8 as S8
-import Data.Text (Text, pack)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import Blaze.ByteString.Builder (toByteString, copyByteString)
-import Blaze.ByteString.Builder.Char.Utf8 (fromText)
-import Network.HTTP.Types (renderQueryText)
-import Data.Monoid (mappend)
-import Data.ByteString (ByteString)
-
-data Facebook = Facebook
-    { facebookClientId :: Text
-    , facebookClientSecret :: Text
-    , facebookRedirectUri :: Text
-    }
-    deriving (Show, Eq, Read, Ord, Data, Typeable)
-
-newtype AccessToken = AccessToken { unAccessToken :: Text }
-    deriving (Show, Eq, Read, Ord, Data, Typeable)
-
-getForwardUrl :: Facebook -> [Text] -> Text
-getForwardUrl fb perms =
-    TE.decodeUtf8 $ toByteString $
-    copyByteString "https://graph.facebook.com/oauth/authorize"
-    `mappend`
-    renderQueryText True
-        ( ("client_id", Just $ facebookClientId fb)
-        : ("redirect_uri", Just $ facebookRedirectUri fb)
-        : if null perms
-            then []
-            else [("scope", Just $ T.intercalate "," perms)])
-
-
-accessTokenUrl :: Facebook -> Text -> ByteString
-accessTokenUrl fb code =
-    toByteString $
-    copyByteString "https://graph.facebook.com/oauth/access_token"
-    `mappend`
-    renderQueryText True
-        [ ("client_id", Just $ facebookClientId fb)
-        , ("redirect_uri", Just $ facebookRedirectUri fb)
-        , ("code", Just code)
-        ]
-
-getAccessToken :: Facebook -> Text -> IO AccessToken
-getAccessToken fb code = do
-    let url = accessTokenUrl fb code
-    b <- simpleHttp $ S8.unpack url
-    let (front, back) = splitAt 13 $ L8.unpack b
-    case front of
-        "access_token=" -> return $ AccessToken $ T.pack back
-        _ -> error $ "Invalid facebook response: " ++ back
-
-graphUrl :: AccessToken -> Text -> ByteString
-graphUrl (AccessToken s) func =
-    toByteString $
-    copyByteString "https://graph.facebook.com/"
-    `mappend` fromText func
-    `mappend` renderQueryText True [("access_token", Just s)]
-
-getGraphData :: AccessToken -> Text -> IO (Either String Value)
-getGraphData at func = do
-    let url = graphUrl at func
-    b <- simpleHttp $ S8.unpack url
-    return $ eitherResult $ parse json b
-
-getGraphData' :: AccessToken -> Text -> IO Value
-getGraphData' a b = getGraphData a b >>= either (throwIO . InvalidJsonException) return
-
-data InvalidJsonException = InvalidJsonException String
-    deriving (Show, Typeable)
-instance Exception InvalidJsonException
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Web.Authenticate.Facebook
+    ( Facebook (..)
+    , AccessToken (..)
+    , getForwardUrl
+    , getAccessToken
+    , getGraphData
+    ) where
+
+import Network.HTTP.Enumerator
+import Data.List (intercalate)
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as L8
+import Web.Authenticate.Internal (qsEncode)
+import Data.Data (Data)
+import Data.Typeable (Typeable)
+import Control.Exception (Exception, throwIO)
+import Data.Attoparsec.Lazy (parse, eitherResult)
+import qualified Data.ByteString.Char8 as S8
+import Data.Text (Text, pack)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Blaze.ByteString.Builder (toByteString, copyByteString)
+import Blaze.ByteString.Builder.Char.Utf8 (fromText)
+import Network.HTTP.Types (renderQueryText)
+import Data.Monoid (mappend)
+import Data.ByteString (ByteString)
+
+data Facebook = Facebook
+    { facebookClientId :: Text
+    , facebookClientSecret :: Text
+    , facebookRedirectUri :: Text
+    }
+    deriving (Show, Eq, Read, Ord, Data, Typeable)
+
+newtype AccessToken = AccessToken { unAccessToken :: Text }
+    deriving (Show, Eq, Read, Ord, Data, Typeable)
+
+getForwardUrl :: Facebook -> [Text] -> Text
+getForwardUrl fb perms =
+    TE.decodeUtf8 $ toByteString $
+    copyByteString "https://graph.facebook.com/oauth/authorize"
+    `mappend`
+    renderQueryText True
+        ( ("client_id", Just $ facebookClientId fb)
+        : ("redirect_uri", Just $ facebookRedirectUri fb)
+        : if null perms
+            then []
+            else [("scope", Just $ T.intercalate "," perms)])
+
+
+accessTokenUrl :: Facebook -> Text -> ByteString
+accessTokenUrl fb code =
+    toByteString $
+    copyByteString "https://graph.facebook.com/oauth/access_token"
+    `mappend`
+    renderQueryText True
+        [ ("client_id", Just $ facebookClientId fb)
+        , ("redirect_uri", Just $ facebookRedirectUri fb)
+        , ("code", Just code)
+        , ("client_secret", Just $ facebookClientSecret fb)
+        ]
+
+getAccessToken :: Facebook -> Text -> IO AccessToken
+getAccessToken fb code = do
+    let url = accessTokenUrl fb code
+    b <- simpleHttp $ S8.unpack url
+    let (front, back) = splitAt 13 $ L8.unpack b
+    case front of
+        "access_token=" -> return $ AccessToken $ T.pack back
+        _ -> error $ "Invalid facebook response: " ++ back
+
+graphUrl :: AccessToken -> Text -> ByteString
+graphUrl (AccessToken s) func =
+    toByteString $
+    copyByteString "https://graph.facebook.com/"
+    `mappend` fromText func
+    `mappend` renderQueryText True [("access_token", Just s)]
+
+getGraphData :: AccessToken -> Text -> IO (Either String Value)
+getGraphData at func = do
+    let url = graphUrl at func
+    b <- simpleHttp $ S8.unpack url
+    return $ eitherResult $ parse json b
+
+getGraphData' :: AccessToken -> Text -> IO Value
+getGraphData' a b = getGraphData a b >>= either (throwIO . InvalidJsonException) return
+
+data InvalidJsonException = InvalidJsonException String
+    deriving (Show, Typeable)
+instance Exception InvalidJsonException
diff --git a/Web/Authenticate/Internal.hs b/Web/Authenticate/Internal.hs
--- a/Web/Authenticate/Internal.hs
+++ b/Web/Authenticate/Internal.hs
@@ -1,44 +1,44 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-module Web.Authenticate.Internal
-    ( qsEncode
-    , qsUrl
-    , AuthenticateException (..)
-    ) where
-
-import Codec.Binary.UTF8.String (encode)
-import Numeric (showHex)
-import Data.List (intercalate)
-import Data.Typeable (Typeable)
-import Control.Exception (Exception)
-
-data AuthenticateException =
-      RpxnowException String
-    | NormalizationException String
-    | DiscoveryException String
-    | AuthenticationException String
-  deriving (Show, Typeable)
-instance Exception AuthenticateException
-
-qsUrl :: String -> [(String, String)] -> String
-qsUrl s [] = s
-qsUrl url pairs =
-    url ++ delim : intercalate "&" (map qsPair pairs)
-  where
-    qsPair (x, y) = qsEncode x ++ '=' : qsEncode y
-    delim = if '?' `elem` url then '&' else '?'
-
-qsEncode :: String -> String
-qsEncode =
-    concatMap go . encode
-  where
-    go 32 = "+" -- space
-    go 46 = "."
-    go 45 = "-"
-    go 126 = "~"
-    go 95 = "_"
-    go c
-        | 48 <= c && c <= 57 = [w2c c]
-        | 65 <= c && c <= 90 = [w2c c]
-        | 97 <= c && c <= 122 = [w2c c]
-    go c = '%' : showHex c ""
-    w2c = toEnum . fromEnum
+{-# LANGUAGE DeriveDataTypeable #-}
+module Web.Authenticate.Internal
+    ( qsEncode
+    , qsUrl
+    , AuthenticateException (..)
+    ) where
+
+import Codec.Binary.UTF8.String (encode)
+import Numeric (showHex)
+import Data.List (intercalate)
+import Data.Typeable (Typeable)
+import Control.Exception (Exception)
+
+data AuthenticateException =
+      RpxnowException String
+    | NormalizationException String
+    | DiscoveryException String
+    | AuthenticationException String
+  deriving (Show, Typeable)
+instance Exception AuthenticateException
+
+qsUrl :: String -> [(String, String)] -> String
+qsUrl s [] = s
+qsUrl url pairs =
+    url ++ delim : intercalate "&" (map qsPair pairs)
+  where
+    qsPair (x, y) = qsEncode x ++ '=' : qsEncode y
+    delim = if '?' `elem` url then '&' else '?'
+
+qsEncode :: String -> String
+qsEncode =
+    concatMap go . encode
+  where
+    go 32 = "+" -- space
+    go 46 = "."
+    go 45 = "-"
+    go 126 = "~"
+    go 95 = "_"
+    go c
+        | 48 <= c && c <= 57 = [w2c c]
+        | 65 <= c && c <= 90 = [w2c c]
+        | 97 <= c && c <= 122 = [w2c c]
+    go c = '%' : showHex c ""
+    w2c = toEnum . fromEnum
diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs
--- a/Web/Authenticate/OAuth.hs
+++ b/Web/Authenticate/OAuth.hs
@@ -1,252 +1,252 @@
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-}
-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
-module Web.Authenticate.OAuth
-    ( -- * Data types
-      OAuth(..), SignMethod(..), Credential(..),
-      -- * Operations for credentials
-      emptyCredential, insert, delete, inserts,
-      -- * Signature
-      signOAuth, genSign,
-      -- * Url & operation for authentication
-      authorizeUrl, getAccessToken, getTemporaryCredential,
-      getTokenCredential,
-      -- * Utility Methods
-      paramEncode
-    ) where
-import Network.HTTP.Enumerator
-import Web.Authenticate.Internal (qsUrl)
-import Data.Data
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy.Char8 as BSL
-import Data.Maybe
-import Control.Applicative
-import Network.HTTP.Types (parseSimpleQuery)
-import Control.Exception
-import Control.Monad
-import Data.List (sortBy)
-import System.Random
-import Data.Char
-import Data.Digest.Pure.SHA
-import Data.ByteString.Base64
-import Data.Time
-import Numeric
-import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1, PrivateKey(..))
-import Network.HTTP.Types (Header)
-import Control.Arrow (second)
-import Blaze.ByteString.Builder (toByteString)
-import Data.Enumerator (($$), run_, Stream (..), continue)
-import Data.Monoid (mconcat)
-import Control.Monad.IO.Class (MonadIO (liftIO))
-import Data.IORef (newIORef, readIORef, atomicModifyIORef)
-
--- | Data type for OAuth client (consumer).
-data OAuth = OAuth { oauthServerName      :: String        -- ^ Service name
-                   , oauthRequestUri      :: String        -- ^ URI to request temporary credential
-                   , oauthAccessTokenUri  :: String        -- ^ Uri to obtain access token
-                   , oauthAuthorizeUri    :: String        -- ^ Uri to authorize
-                   , oauthSignatureMethod :: SignMethod    -- ^ Signature Method
-                   , oauthConsumerKey     :: BS.ByteString -- ^ Consumer key
-                   , oauthConsumerSecret  :: BS.ByteString -- ^ Consumer Secret
-                   , oauthCallback        :: Maybe BS.ByteString -- ^ Callback uri to redirect after authentication
-                   } deriving (Show, Eq, Ord, Read, Data, Typeable)
-
-
--- | Data type for signature method.
-data SignMethod = PLAINTEXT
-                | HMACSHA1
-                | RSASHA1 PrivateKey
-                  deriving (Show, Eq, Ord, Read, Data, Typeable)
-
-deriving instance Typeable PrivateKey
-deriving instance Data PrivateKey
-deriving instance Read PrivateKey
-deriving instance Ord PrivateKey
-deriving instance Eq PrivateKey
-
--- | Data type for redential.
-data Credential = Credential { unCredential :: [(BS.ByteString, BS.ByteString)] }
-                  deriving (Show, Eq, Ord, Read, Data, Typeable)
-
--- | Empty credential.
-emptyCredential :: Credential
-emptyCredential = Credential []
-
-token, tokenSecret :: Credential -> BS.ByteString
-token = fromMaybe "" . lookup "oauth_token" . unCredential
-tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential
-
-data OAuthException = ProtocolException String
-                      deriving (Show, Eq, Data, Typeable)
-
-instance Exception OAuthException
-
-toStrict :: BSL.ByteString -> BS.ByteString
-toStrict = BS.concat . BSL.toChunks
-
-fromStrict :: BS.ByteString -> BSL.ByteString
-fromStrict = BSL.fromChunks . return
-
--- | Get temporary credential for requesting acces token.
-getTemporaryCredential :: OAuth         -- ^ OAuth Application
-                       -> IO Credential -- ^ Temporary Credential (Request Token & Secret).
-getTemporaryCredential oa = do
-  let req = fromJust $ parseUrl $ oauthRequestUri oa
-  req' <- signOAuth oa emptyCredential (req { method = "POST" }) 
-  rsp <- withManager $ httpLbs req'
-  let dic = parseSimpleQuery . toStrict . responseBody $ rsp
-  return $ Credential dic
-
--- | URL to obtain OAuth verifier.
-authorizeUrl :: OAuth           -- ^ OAuth Application
-             -> Credential      -- ^ Temporary Credential (Request Token & Secret)
-             -> String          -- ^ URL to authorize
-authorizeUrl oa cr = qsUrl (oauthAuthorizeUri oa) [("oauth_token", BS.unpack $ token cr)]
-
--- | Get Access token.
-getAccessToken, getTokenCredential
-               :: OAuth         -- ^ OAuth Application
-               -> Credential    -- ^ Temporary Credential with oauth_verifier
-               -> IO Credential -- ^ Token Credential (Access Token & Secret)
-getAccessToken oa cr = do
-  let req = (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" }
-  rsp <- signOAuth oa cr req >>= withManager . httpLbs
-  let dic = parseSimpleQuery . toStrict . responseBody $ rsp
-  return $ Credential dic
-
-getTokenCredential = getAccessToken
-
-insertMap :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
-insertMap key val = ((key,val):) . filter ((/=key).fst)
-
-deleteMap :: Eq a => a -> [(a,b)] -> [(a,b)]
-deleteMap k = filter ((/=k).fst)
-
--- | Insert an oauth parameter into given 'Credential'.
-insert :: BS.ByteString -- ^ Parameter Name
-       -> BS.ByteString -- ^ Value
-       -> Credential    -- ^ Credential
-       -> Credential    -- ^ Result
-insert k v = Credential . insertMap k v . unCredential
-
--- | Convenient method for inserting multiple parameters into credential.
-inserts :: [(BS.ByteString, BS.ByteString)] -> Credential -> Credential
-inserts = flip $ foldr (uncurry insert)
-
--- | Remove an oauth parameter for key from given 'Credential'.
-delete :: BS.ByteString -- ^ Parameter name
-       -> Credential    -- ^ Credential
-       -> Credential    -- ^ Result
-delete key = Credential . deleteMap key . unCredential
-
--- | Add OAuth headers & sign to 'Request'.
-signOAuth :: OAuth              -- ^ OAuth Application
-          -> Credential         -- ^ Credential
-          -> Request IO         -- ^ Original Request
-          -> IO (Request IO)    -- ^ Signed OAuth Request
-signOAuth oa crd req = do
-  crd' <- addTimeStamp =<< addNonce crd
-  let tok = injectOAuthToCred oa crd'
-  sign <- genSign oa tok req
-  return $ addAuthHeader (insert "oauth_signature" sign tok) req
-
-baseTime :: UTCTime
-baseTime = UTCTime day 0
-  where
-    day = ModifiedJulianDay 40587
-
-showSigMtd :: SignMethod -> BS.ByteString
-showSigMtd PLAINTEXT = "PLAINTEXT"
-showSigMtd HMACSHA1  = "HMAC-SHA1"
-showSigMtd (RSASHA1 _) = "RSA-SHA1"
-
-addNonce :: Credential -> IO Credential
-addNonce cred = do
-  nonce <- replicateM 10 (randomRIO ('a','z'))
-  return $ insert "oauth_nonce" (BS.pack nonce) cred
-
-addTimeStamp :: Credential -> IO Credential
-addTimeStamp cred = do
-  stamp <- floor . (`diffUTCTime` baseTime) <$> getCurrentTime :: IO Integer
-  return $ insert "oauth_timestamp" (BS.pack $ show stamp) cred
-
-injectOAuthToCred :: OAuth -> Credential -> Credential
-injectOAuthToCred oa cred = maybe id (insert "oauth_callback") (oauthCallback oa) $ 
-  inserts [ ("oauth_signature_method", showSigMtd $ oauthSignatureMethod oa)
-          , ("oauth_consumer_key", oauthConsumerKey oa)
-          , ("oauth_version", "1.0")
-          ] cred
-
-genSign :: MonadIO m => OAuth -> Credential -> Request m -> m BS.ByteString
-genSign oa tok req =
-  case oauthSignatureMethod oa of
-    HMACSHA1 -> do
-      text <- getBaseString tok req
-      let key  = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok]
-      return $ encode $ toStrict $ bytestringDigest $ hmacSha1 (fromStrict key) text
-    PLAINTEXT ->
-      return $ BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok]
-    RSASHA1 pr ->
-      liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign ha_SHA1 pr) (getBaseString tok req)
-
-addAuthHeader :: Credential -> Request a -> Request a
-addAuthHeader (Credential cred) req =
-  req { requestHeaders = insertMap "Authorization" (renderAuthHeader cred) $ requestHeaders req }
-
-renderAuthHeader :: [(BS.ByteString, BS.ByteString)] -> BS.ByteString
-renderAuthHeader = ("OAuth " `BS.append`). BS.intercalate "," . map (\(a,b) -> BS.concat [paramEncode a, "=\"",  paramEncode b, "\""]) . filter ((`notElem` ["oauth_token_secret", "oauth_consumer_secret"]) . fst)
-
--- | Encode a string using the percent encoding method for OAuth.
-paramEncode :: BS.ByteString -> BS.ByteString
-paramEncode = BS.concatMap escape
-  where
-    escape c | isAlpha c || isDigit c || c `elem` "-._~" = BS.singleton c
-             | otherwise = let num = map toUpper $ showHex (ord c) ""
-                               oct = '%' : replicate (2 - length num) '0' ++ num
-                           in BS.pack oct
-
-getBaseString :: MonadIO m => Credential -> Request m -> m BSL.ByteString
-getBaseString tok req = do
-  let bsMtd  = BS.map toUpper $ method req
-      isHttps = secure req
-      scheme = if isHttps then "https" else "http"
-      bsPort = if (isHttps && port req /= 443) || (not isHttps && port req /= 80)
-                 then ':' `BS.cons` BS.pack (show $ port req) else ""
-      bsURI = BS.concat [scheme, "://", host req, bsPort, path req]
-      bsQuery = map (second $ fromMaybe "") $ queryString req
-  bsBodyQ <- if isBodyFormEncoded $ requestHeaders req
-                  then liftM parseSimpleQuery $ toLBS (requestBody req)
-                  else return []
-  let bsAuthParams = filter ((`notElem`["oauth_signature","realm", "oauth_token_secret"]).fst) $ unCredential tok
-      allParams = bsQuery++bsBodyQ++bsAuthParams
-      bsParams = BS.intercalate "&" $ map (\(a,b)->BS.concat[a,"=",b]) $ sortBy compareTuple
-                   $ map (\(a,b) -> (paramEncode a,paramEncode b)) allParams
-  -- FIXME it would be much better to use http-types functions here
-  return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI, bsParams]
-
-toLBS :: MonadIO m => RequestBody m -> m BS.ByteString
-toLBS (RequestBodyLBS l) = return $ toStrict l
-toLBS (RequestBodyBS s) = return s
-toLBS (RequestBodyBuilder _ b) = return $ toByteString b
-toLBS (RequestBodyEnum _ enum) = do
-    i <- liftIO $ newIORef id
-    run_ $ enum $$ go i
-    liftIO $ liftM (toByteString . mconcat . ($ [])) $ readIORef i
-  where
-    go i =
-        continue go'
-      where
-        go' (Chunks []) = continue go'
-        go' (Chunks x) = do
-            liftIO (atomicModifyIORef i $ \y -> (y . (x ++), ()))
-            continue go'
-        go' EOF = return ()
-
-isBodyFormEncoded :: [Header] -> Bool
-isBodyFormEncoded = maybe False (=="application/x-www-form-urlencoded") . lookup "Content-Type"
-
-compareTuple :: (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering
-compareTuple (a,b) (c,d) =
-  case compare a c of
-    LT -> LT
-    EQ -> compare b d
-    GT -> GT
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-}
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
+module Web.Authenticate.OAuth
+    ( -- * Data types
+      OAuth(..), SignMethod(..), Credential(..),
+      -- * Operations for credentials
+      emptyCredential, insert, delete, inserts,
+      -- * Signature
+      signOAuth, genSign,
+      -- * Url & operation for authentication
+      authorizeUrl, getAccessToken, getTemporaryCredential,
+      getTokenCredential,
+      -- * Utility Methods
+      paramEncode
+    ) where
+import Network.HTTP.Enumerator
+import Web.Authenticate.Internal (qsUrl)
+import Data.Data
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import Data.Maybe
+import Control.Applicative
+import Network.HTTP.Types (parseSimpleQuery)
+import Control.Exception
+import Control.Monad
+import Data.List (sortBy)
+import System.Random
+import Data.Char
+import Data.Digest.Pure.SHA
+import Data.ByteString.Base64
+import Data.Time
+import Numeric
+import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1, PrivateKey(..))
+import Network.HTTP.Types (Header)
+import Control.Arrow (second)
+import Blaze.ByteString.Builder (toByteString)
+import Data.Enumerator (($$), run_, Stream (..), continue)
+import Data.Monoid (mconcat)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.IORef (newIORef, readIORef, atomicModifyIORef)
+
+-- | Data type for OAuth client (consumer).
+data OAuth = OAuth { oauthServerName      :: String        -- ^ Service name
+                   , oauthRequestUri      :: String        -- ^ URI to request temporary credential
+                   , oauthAccessTokenUri  :: String        -- ^ Uri to obtain access token
+                   , oauthAuthorizeUri    :: String        -- ^ Uri to authorize
+                   , oauthSignatureMethod :: SignMethod    -- ^ Signature Method
+                   , oauthConsumerKey     :: BS.ByteString -- ^ Consumer key
+                   , oauthConsumerSecret  :: BS.ByteString -- ^ Consumer Secret
+                   , oauthCallback        :: Maybe BS.ByteString -- ^ Callback uri to redirect after authentication
+                   } deriving (Show, Eq, Ord, Read, Data, Typeable)
+
+
+-- | Data type for signature method.
+data SignMethod = PLAINTEXT
+                | HMACSHA1
+                | RSASHA1 PrivateKey
+                  deriving (Show, Eq, Ord, Read, Data, Typeable)
+
+deriving instance Typeable PrivateKey
+deriving instance Data PrivateKey
+deriving instance Read PrivateKey
+deriving instance Ord PrivateKey
+deriving instance Eq PrivateKey
+
+-- | Data type for redential.
+data Credential = Credential { unCredential :: [(BS.ByteString, BS.ByteString)] }
+                  deriving (Show, Eq, Ord, Read, Data, Typeable)
+
+-- | Empty credential.
+emptyCredential :: Credential
+emptyCredential = Credential []
+
+token, tokenSecret :: Credential -> BS.ByteString
+token = fromMaybe "" . lookup "oauth_token" . unCredential
+tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential
+
+data OAuthException = ProtocolException String
+                      deriving (Show, Eq, Data, Typeable)
+
+instance Exception OAuthException
+
+toStrict :: BSL.ByteString -> BS.ByteString
+toStrict = BS.concat . BSL.toChunks
+
+fromStrict :: BS.ByteString -> BSL.ByteString
+fromStrict = BSL.fromChunks . return
+
+-- | Get temporary credential for requesting acces token.
+getTemporaryCredential :: OAuth         -- ^ OAuth Application
+                       -> IO Credential -- ^ Temporary Credential (Request Token & Secret).
+getTemporaryCredential oa = do
+  let req = fromJust $ parseUrl $ oauthRequestUri oa
+  req' <- signOAuth oa emptyCredential (req { method = "POST" }) 
+  rsp <- withManager $ httpLbs req'
+  let dic = parseSimpleQuery . toStrict . responseBody $ rsp
+  return $ Credential dic
+
+-- | URL to obtain OAuth verifier.
+authorizeUrl :: OAuth           -- ^ OAuth Application
+             -> Credential      -- ^ Temporary Credential (Request Token & Secret)
+             -> String          -- ^ URL to authorize
+authorizeUrl oa cr = qsUrl (oauthAuthorizeUri oa) [("oauth_token", BS.unpack $ token cr)]
+
+-- | Get Access token.
+getAccessToken, getTokenCredential
+               :: OAuth         -- ^ OAuth Application
+               -> Credential    -- ^ Temporary Credential with oauth_verifier
+               -> IO Credential -- ^ Token Credential (Access Token & Secret)
+getAccessToken oa cr = do
+  let req = (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" }
+  rsp <- signOAuth oa cr req >>= withManager . httpLbs
+  let dic = parseSimpleQuery . toStrict . responseBody $ rsp
+  return $ Credential dic
+
+getTokenCredential = getAccessToken
+
+insertMap :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
+insertMap key val = ((key,val):) . filter ((/=key).fst)
+
+deleteMap :: Eq a => a -> [(a,b)] -> [(a,b)]
+deleteMap k = filter ((/=k).fst)
+
+-- | Insert an oauth parameter into given 'Credential'.
+insert :: BS.ByteString -- ^ Parameter Name
+       -> BS.ByteString -- ^ Value
+       -> Credential    -- ^ Credential
+       -> Credential    -- ^ Result
+insert k v = Credential . insertMap k v . unCredential
+
+-- | Convenient method for inserting multiple parameters into credential.
+inserts :: [(BS.ByteString, BS.ByteString)] -> Credential -> Credential
+inserts = flip $ foldr (uncurry insert)
+
+-- | Remove an oauth parameter for key from given 'Credential'.
+delete :: BS.ByteString -- ^ Parameter name
+       -> Credential    -- ^ Credential
+       -> Credential    -- ^ Result
+delete key = Credential . deleteMap key . unCredential
+
+-- | Add OAuth headers & sign to 'Request'.
+signOAuth :: OAuth              -- ^ OAuth Application
+          -> Credential         -- ^ Credential
+          -> Request IO         -- ^ Original Request
+          -> IO (Request IO)    -- ^ Signed OAuth Request
+signOAuth oa crd req = do
+  crd' <- addTimeStamp =<< addNonce crd
+  let tok = injectOAuthToCred oa crd'
+  sign <- genSign oa tok req
+  return $ addAuthHeader (insert "oauth_signature" sign tok) req
+
+baseTime :: UTCTime
+baseTime = UTCTime day 0
+  where
+    day = ModifiedJulianDay 40587
+
+showSigMtd :: SignMethod -> BS.ByteString
+showSigMtd PLAINTEXT = "PLAINTEXT"
+showSigMtd HMACSHA1  = "HMAC-SHA1"
+showSigMtd (RSASHA1 _) = "RSA-SHA1"
+
+addNonce :: Credential -> IO Credential
+addNonce cred = do
+  nonce <- replicateM 10 (randomRIO ('a','z'))
+  return $ insert "oauth_nonce" (BS.pack nonce) cred
+
+addTimeStamp :: Credential -> IO Credential
+addTimeStamp cred = do
+  stamp <- floor . (`diffUTCTime` baseTime) <$> getCurrentTime :: IO Integer
+  return $ insert "oauth_timestamp" (BS.pack $ show stamp) cred
+
+injectOAuthToCred :: OAuth -> Credential -> Credential
+injectOAuthToCred oa cred = maybe id (insert "oauth_callback") (oauthCallback oa) $ 
+  inserts [ ("oauth_signature_method", showSigMtd $ oauthSignatureMethod oa)
+          , ("oauth_consumer_key", oauthConsumerKey oa)
+          , ("oauth_version", "1.0")
+          ] cred
+
+genSign :: MonadIO m => OAuth -> Credential -> Request m -> m BS.ByteString
+genSign oa tok req =
+  case oauthSignatureMethod oa of
+    HMACSHA1 -> do
+      text <- getBaseString tok req
+      let key  = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok]
+      return $ encode $ toStrict $ bytestringDigest $ hmacSha1 (fromStrict key) text
+    PLAINTEXT ->
+      return $ BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok]
+    RSASHA1 pr ->
+      liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign ha_SHA1 pr) (getBaseString tok req)
+
+addAuthHeader :: Credential -> Request a -> Request a
+addAuthHeader (Credential cred) req =
+  req { requestHeaders = insertMap "Authorization" (renderAuthHeader cred) $ requestHeaders req }
+
+renderAuthHeader :: [(BS.ByteString, BS.ByteString)] -> BS.ByteString
+renderAuthHeader = ("OAuth " `BS.append`). BS.intercalate "," . map (\(a,b) -> BS.concat [paramEncode a, "=\"",  paramEncode b, "\""]) . filter ((`notElem` ["oauth_token_secret", "oauth_consumer_secret"]) . fst)
+
+-- | Encode a string using the percent encoding method for OAuth.
+paramEncode :: BS.ByteString -> BS.ByteString
+paramEncode = BS.concatMap escape
+  where
+    escape c | isAlpha c || isDigit c || c `elem` "-._~" = BS.singleton c
+             | otherwise = let num = map toUpper $ showHex (ord c) ""
+                               oct = '%' : replicate (2 - length num) '0' ++ num
+                           in BS.pack oct
+
+getBaseString :: MonadIO m => Credential -> Request m -> m BSL.ByteString
+getBaseString tok req = do
+  let bsMtd  = BS.map toUpper $ method req
+      isHttps = secure req
+      scheme = if isHttps then "https" else "http"
+      bsPort = if (isHttps && port req /= 443) || (not isHttps && port req /= 80)
+                 then ':' `BS.cons` BS.pack (show $ port req) else ""
+      bsURI = BS.concat [scheme, "://", host req, bsPort, path req]
+      bsQuery = map (second $ fromMaybe "") $ queryString req
+  bsBodyQ <- if isBodyFormEncoded $ requestHeaders req
+                  then liftM parseSimpleQuery $ toLBS (requestBody req)
+                  else return []
+  let bsAuthParams = filter ((`notElem`["oauth_signature","realm", "oauth_token_secret"]).fst) $ unCredential tok
+      allParams = bsQuery++bsBodyQ++bsAuthParams
+      bsParams = BS.intercalate "&" $ map (\(a,b)->BS.concat[a,"=",b]) $ sortBy compareTuple
+                   $ map (\(a,b) -> (paramEncode a,paramEncode b)) allParams
+  -- FIXME it would be much better to use http-types functions here
+  return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI, bsParams]
+
+toLBS :: MonadIO m => RequestBody m -> m BS.ByteString
+toLBS (RequestBodyLBS l) = return $ toStrict l
+toLBS (RequestBodyBS s) = return s
+toLBS (RequestBodyBuilder _ b) = return $ toByteString b
+toLBS (RequestBodyEnum _ enum) = do
+    i <- liftIO $ newIORef id
+    run_ $ enum $$ go i
+    liftIO $ liftM (toByteString . mconcat . ($ [])) $ readIORef i
+  where
+    go i =
+        continue go'
+      where
+        go' (Chunks []) = continue go'
+        go' (Chunks x) = do
+            liftIO (atomicModifyIORef i $ \y -> (y . (x ++), ()))
+            continue go'
+        go' EOF = return ()
+
+isBodyFormEncoded :: [Header] -> Bool
+isBodyFormEncoded = maybe False (=="application/x-www-form-urlencoded") . lookup "Content-Type"
+
+compareTuple :: (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering
+compareTuple (a,b) (c,d) =
+  case compare a c of
+    LT -> LT
+    EQ -> compare b d
+    GT -> GT
diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs
--- a/Web/Authenticate/OpenId.hs
+++ b/Web/Authenticate/OpenId.hs
@@ -1,114 +1,114 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Web.Authenticate.OpenId
-    ( getForwardUrl
-    , authenticate
-    , AuthenticateException (..)
-    , Identifier (..)
-    ) where
-
-import Control.Monad.IO.Class
-import OpenId2.Normalization (normalize)
-import OpenId2.Discovery (discover, Discovery (..))
-import Control.Failure (Failure (failure))
-import OpenId2.Types
-import Web.Authenticate.Internal (qsUrl)
-import Control.Monad (unless)
-import qualified Data.ByteString.UTF8 as BSU
-import qualified Data.ByteString.Lazy.UTF8 as BSLU
-import Network.HTTP.Enumerator
-    ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect
-    , HttpException, withManager
-    )
-import Control.Arrow ((***))
-import Data.List (unfoldr)
-import Data.Maybe (fromMaybe)
-import Data.Text (Text, pack, unpack)
-import Data.Text.Encoding (encodeUtf8)
-
-getForwardUrl
-    :: ( MonadIO m
-       , Failure AuthenticateException m
-       , Failure HttpException m
-       )
-    => Text -- ^ The openid the user provided.
-    -> Text -- ^ The URL for this application\'s complete page.
-    -> Maybe Text -- ^ Optional realm
-    -> [(Text, Text)] -- ^ Additional parameters to send to the OpenID provider. These can be useful for using extensions.
-    -> m Text -- ^ URL to send the user to.
-getForwardUrl openid' complete mrealm params = do
-    let realm = fromMaybe complete mrealm
-    disc <- normalize openid' >>= discover
-    case disc of
-        Discovery1 server mdelegate ->
-            return $ pack $ qsUrl server
-                $ map (unpack *** unpack) -- FIXME
-                $ ("openid.mode", "checkid_setup")
-                : ("openid.identity", maybe openid' pack mdelegate)
-                : ("openid.return_to", complete)
-                : ("openid.realm", realm)
-                : ("openid.trust_root", complete)
-                : params
-        Discovery2 (Provider p) (Identifier i) itype -> do
-            let i' =
-                    case itype of
-                        ClaimedIdent -> i
-                        OPIdent -> "http://specs.openid.net/auth/2.0/identifier_select"
-            return $ pack $ qsUrl p
-                $ ("openid.ns", "http://specs.openid.net/auth/2.0")
-                : ("openid.mode", "checkid_setup")
-                : ("openid.claimed_id", unpack i')
-                : ("openid.identity", unpack i')
-                : ("openid.return_to", unpack complete)
-                : ("openid.realm", unpack realm)
-                : map (unpack *** unpack) params
-
-authenticate
-    :: ( MonadIO m
-       , Failure AuthenticateException m
-       , Failure HttpException m
-       )
-    => [(Text, Text)]
-    -> m (Identifier, [(Text, Text)])
-authenticate params = do
-    unless (lookup "openid.mode" params == Just "id_res")
-        $ failure $ case lookup "openid.mode" params of
-                      Nothing -> AuthenticationException "openid.mode was not found in the params."
-                      (Just m)
-                            | m == "error" ->
-                                case lookup "openid.error" params of
-                                  Nothing -> AuthenticationException "An error occurred, but no error message was provided."
-                                  (Just e) -> AuthenticationException $ unpack e
-                            | otherwise -> AuthenticationException $ "mode is " ++ unpack m ++ " but we were expecting id_res."
-    ident <- case lookup "openid.identity" params of
-                Just i -> return i
-                Nothing ->
-                    failure $ AuthenticationException "Missing identity"
-    disc <- normalize ident >>= discover
-    let endpoint = case disc of
-                    Discovery1 p _ -> p
-                    Discovery2 (Provider p) _ _ -> p
-    let params' = map (encodeUtf8 *** encodeUtf8)
-                $ ("openid.mode", "check_authentication")
-                : filter (\(k, _) -> k /= "openid.mode") params
-    req' <- parseUrl endpoint
-    let req = urlEncodedBody params' req'
-    rsp <- liftIO $ withManager $ httpLbsRedirect req
-    let rps = parseDirectResponse $ pack $ BSLU.toString $ responseBody rsp -- FIXME
-    case lookup "is_valid" rps of
-        Just "true" -> return (Identifier ident, rps)
-        _ -> failure $ AuthenticationException "OpenID provider did not validate"
-
--- | Turn a response body into a list of parameters.
-parseDirectResponse :: Text -> [(Text, Text)]
-parseDirectResponse  =
-    map (pack *** pack) . unfoldr step . unpack
-  where
-    step []  = Nothing
-    step str = case split (== '\n') str of
-      (ps,rest) -> Just (split (== ':') ps,rest)
-
-split :: (a -> Bool) -> [a] -> ([a],[a])
-split p as = case break p as of
-  (xs,_:ys) -> (xs,ys)
-  pair      -> pair
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Web.Authenticate.OpenId
+    ( getForwardUrl
+    , authenticate
+    , AuthenticateException (..)
+    , Identifier (..)
+    ) where
+
+import Control.Monad.IO.Class
+import OpenId2.Normalization (normalize)
+import OpenId2.Discovery (discover, Discovery (..))
+import Control.Failure (Failure (failure))
+import OpenId2.Types
+import Web.Authenticate.Internal (qsUrl)
+import Control.Monad (unless)
+import qualified Data.ByteString.UTF8 as BSU
+import qualified Data.ByteString.Lazy.UTF8 as BSLU
+import Network.HTTP.Enumerator
+    ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect
+    , HttpException, withManager
+    )
+import Control.Arrow ((***))
+import Data.List (unfoldr)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text, pack, unpack)
+import Data.Text.Encoding (encodeUtf8)
+
+getForwardUrl
+    :: ( MonadIO m
+       , Failure AuthenticateException m
+       , Failure HttpException m
+       )
+    => Text -- ^ The openid the user provided.
+    -> Text -- ^ The URL for this application\'s complete page.
+    -> Maybe Text -- ^ Optional realm
+    -> [(Text, Text)] -- ^ Additional parameters to send to the OpenID provider. These can be useful for using extensions.
+    -> m Text -- ^ URL to send the user to.
+getForwardUrl openid' complete mrealm params = do
+    let realm = fromMaybe complete mrealm
+    disc <- normalize openid' >>= discover
+    case disc of
+        Discovery1 server mdelegate ->
+            return $ pack $ qsUrl server
+                $ map (unpack *** unpack) -- FIXME
+                $ ("openid.mode", "checkid_setup")
+                : ("openid.identity", maybe openid' pack mdelegate)
+                : ("openid.return_to", complete)
+                : ("openid.realm", realm)
+                : ("openid.trust_root", complete)
+                : params
+        Discovery2 (Provider p) (Identifier i) itype -> do
+            let i' =
+                    case itype of
+                        ClaimedIdent -> i
+                        OPIdent -> "http://specs.openid.net/auth/2.0/identifier_select"
+            return $ pack $ qsUrl p
+                $ ("openid.ns", "http://specs.openid.net/auth/2.0")
+                : ("openid.mode", "checkid_setup")
+                : ("openid.claimed_id", unpack i')
+                : ("openid.identity", unpack i')
+                : ("openid.return_to", unpack complete)
+                : ("openid.realm", unpack realm)
+                : map (unpack *** unpack) params
+
+authenticate
+    :: ( MonadIO m
+       , Failure AuthenticateException m
+       , Failure HttpException m
+       )
+    => [(Text, Text)]
+    -> m (Identifier, [(Text, Text)])
+authenticate params = do
+    unless (lookup "openid.mode" params == Just "id_res")
+        $ failure $ case lookup "openid.mode" params of
+                      Nothing -> AuthenticationException "openid.mode was not found in the params."
+                      (Just m)
+                            | m == "error" ->
+                                case lookup "openid.error" params of
+                                  Nothing -> AuthenticationException "An error occurred, but no error message was provided."
+                                  (Just e) -> AuthenticationException $ unpack e
+                            | otherwise -> AuthenticationException $ "mode is " ++ unpack m ++ " but we were expecting id_res."
+    ident <- case lookup "openid.identity" params of
+                Just i -> return i
+                Nothing ->
+                    failure $ AuthenticationException "Missing identity"
+    disc <- normalize ident >>= discover
+    let endpoint = case disc of
+                    Discovery1 p _ -> p
+                    Discovery2 (Provider p) _ _ -> p
+    let params' = map (encodeUtf8 *** encodeUtf8)
+                $ ("openid.mode", "check_authentication")
+                : filter (\(k, _) -> k /= "openid.mode") params
+    req' <- parseUrl endpoint
+    let req = urlEncodedBody params' req'
+    rsp <- liftIO $ withManager $ httpLbsRedirect req
+    let rps = parseDirectResponse $ pack $ BSLU.toString $ responseBody rsp -- FIXME
+    case lookup "is_valid" rps of
+        Just "true" -> return (Identifier ident, rps)
+        _ -> failure $ AuthenticationException "OpenID provider did not validate"
+
+-- | Turn a response body into a list of parameters.
+parseDirectResponse :: Text -> [(Text, Text)]
+parseDirectResponse  =
+    map (pack *** pack) . unfoldr step . unpack
+  where
+    step []  = Nothing
+    step str = case split (== '\n') str of
+      (ps,rest) -> Just (split (== ':') ps,rest)
+
+split :: (a -> Bool) -> [a] -> ([a],[a])
+split p as = case break p as of
+  (xs,_:ys) -> (xs,ys)
+  pair      -> pair
diff --git a/Web/Authenticate/OpenId/Providers.hs b/Web/Authenticate/OpenId/Providers.hs
--- a/Web/Authenticate/OpenId/Providers.hs
+++ b/Web/Authenticate/OpenId/Providers.hs
@@ -1,44 +1,44 @@
--- | OpenIDs for a number of common OPs. When a function takes a 'String'
--- parameter, that 'String' is the username.
-module Web.Authenticate.OpenId.Providers
-    ( google
-    , yahoo
-    , livejournal
-    , myspace
-    , wordpress
-    , blogger
-    , verisign
-    , typepad
-    , myopenid
-    , claimid
-    ) where
-
-google :: String
-google = "https://www.google.com/accounts/o8/id"
-
-yahoo :: String
-yahoo = "http://me.yahoo.com/"
-
-livejournal :: String -> String
-livejournal u = concat ["http://", u, ".livejournal.com/"]
-
-myspace :: String -> String
-myspace = (++) "http://www.myspace.com/"
-
-wordpress :: String -> String
-wordpress u = concat ["http://", u, ".wordpress.com/"]
-
-blogger :: String -> String
-blogger u = concat ["http://", u, ".blogger.com/"]
-
-verisign :: String -> String
-verisign u = concat ["http://", u, ".pip.verisignlabs.com/"]
-
-typepad :: String -> String
-typepad u = concat ["http://", u, ".typepad.com/"]
-
-myopenid :: String -> String
-myopenid u = concat ["http://", u, ".myopenid.com/"]
-
-claimid :: String -> String
-claimid = (++) "http://claimid.com/"
+-- | OpenIDs for a number of common OPs. When a function takes a 'String'
+-- parameter, that 'String' is the username.
+module Web.Authenticate.OpenId.Providers
+    ( google
+    , yahoo
+    , livejournal
+    , myspace
+    , wordpress
+    , blogger
+    , verisign
+    , typepad
+    , myopenid
+    , claimid
+    ) where
+
+google :: String
+google = "https://www.google.com/accounts/o8/id"
+
+yahoo :: String
+yahoo = "http://me.yahoo.com/"
+
+livejournal :: String -> String
+livejournal u = concat ["http://", u, ".livejournal.com/"]
+
+myspace :: String -> String
+myspace = (++) "http://www.myspace.com/"
+
+wordpress :: String -> String
+wordpress u = concat ["http://", u, ".wordpress.com/"]
+
+blogger :: String -> String
+blogger u = concat ["http://", u, ".blogger.com/"]
+
+verisign :: String -> String
+verisign u = concat ["http://", u, ".pip.verisignlabs.com/"]
+
+typepad :: String -> String
+typepad u = concat ["http://", u, ".typepad.com/"]
+
+myopenid :: String -> String
+myopenid u = concat ["http://", u, ".myopenid.com/"]
+
+claimid :: String -> String
+claimid = (++) "http://claimid.com/"
diff --git a/Web/Authenticate/Rpxnow.hs b/Web/Authenticate/Rpxnow.hs
--- a/Web/Authenticate/Rpxnow.hs
+++ b/Web/Authenticate/Rpxnow.hs
@@ -1,109 +1,109 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveDataTypeable #-}
----------------------------------------------------------
---
--- Module        : Web.Authenticate.Rpxnow
--- Copyright     : Michael Snoyman
--- License       : BSD3
---
--- Maintainer    : Michael Snoyman <michael@snoyman.com>
--- Stability     : Unstable
--- Portability   : portable
---
--- Facilitates authentication with "http://rpxnow.com/".
---
----------------------------------------------------------
-module Web.Authenticate.Rpxnow
-    ( Identifier (..)
-    , authenticate
-    , AuthenticateException (..)
-    ) where
-
-import Data.Aeson
-import Network.HTTP.Enumerator
-import "transformers" Control.Monad.IO.Class
-import Control.Failure
-import Data.Maybe
-import Control.Monad
-import qualified Data.ByteString.Char8 as S
-import qualified Data.ByteString.Lazy.Char8 as L
-import Control.Exception (throwIO)
-import Web.Authenticate.Internal
-import Data.Data (Data)
-import Data.Typeable (Typeable)
-import Data.Attoparsec.Lazy (parse)
-import qualified Data.Attoparsec.Lazy as AT
-import Data.Text (Text)
-import qualified Data.Aeson.Types
-
--- | Information received from Rpxnow after a valid login.
-data Identifier = Identifier
-    { identifier :: Text
-    , extraData :: [(Text, Text)]
-    }
-    deriving (Eq, Ord, Read, Show, Data, Typeable)
-
--- | Attempt to log a user in.
-authenticate :: (MonadIO m,
-                 Failure HttpException m,
-                 Failure AuthenticateException m)
-             => String -- ^ API key given by RPXNOW.
-             -> String -- ^ Token passed by client.
-             -> m Identifier
-authenticate apiKey token = do
-    let body = L.fromChunks
-            [ "apiKey="
-            , S.pack apiKey
-            , "&token="
-            , S.pack token
-            ]
-    let req =
-            Request
-                { method = "POST"
-                , secure = True
-                , host = "rpxnow.com"
-                , port = 443
-                , path = "api/v2/auth_info"
-                , queryString = []
-                , requestHeaders =
-                    [ ("Content-Type", "application/x-www-form-urlencoded")
-                    ]
-                , requestBody = RequestBodyLBS body
-                , checkCerts = const $ return True
-                }
-    res <- liftIO $ withManager $ httpLbsRedirect req
-    let b = responseBody res
-    unless (200 <= statusCode res && statusCode res < 300) $
-        liftIO $ throwIO $ StatusCodeException (statusCode res) b
-    o <- unResult $ parse json b
-    --m <- fromMapping o
-    let mstat = flip Data.Aeson.Types.parse o $ \v ->
-                case v of
-                    Object m -> m .: "stat"
-                    _ -> mzero
-    case mstat of
-        Success "ok" -> return ()
-        Success stat -> failure $ RpxnowException $
-            "Rpxnow login not accepted: " ++ stat ++ "\n" ++ L.unpack b
-        _ -> failure $ RpxnowException "Now stat value found on Rpxnow response"
-    case Data.Aeson.Types.parse parseProfile o of
-        Success x -> return x
-        Error e -> failure $ RpxnowException $ "Unable to parse Rpxnow response: " ++ e
-
-unResult :: Failure AuthenticateException m => AT.Result a -> m a
-unResult = either (failure . RpxnowException) return . AT.eitherResult
-
-parseProfile :: Value -> Data.Aeson.Types.Parser Identifier
-parseProfile (Object m) = do
-    profile <- m .: "profile"
-    ident <- m .: "identifier"
-    let profile' = mapMaybe go profile
-    return $ Identifier ident profile'
-  where
-    go ("identifier", _) = Nothing
-    go (k, String v) = Just (k, v)
-    go _ = Nothing
-parseProfile _ = mzero
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+---------------------------------------------------------
+--
+-- Module        : Web.Authenticate.Rpxnow
+-- Copyright     : Michael Snoyman
+-- License       : BSD3
+--
+-- Maintainer    : Michael Snoyman <michael@snoyman.com>
+-- Stability     : Unstable
+-- Portability   : portable
+--
+-- Facilitates authentication with "http://rpxnow.com/".
+--
+---------------------------------------------------------
+module Web.Authenticate.Rpxnow
+    ( Identifier (..)
+    , authenticate
+    , AuthenticateException (..)
+    ) where
+
+import Data.Aeson
+import Network.HTTP.Enumerator
+import "transformers" Control.Monad.IO.Class
+import Control.Failure
+import Data.Maybe
+import Control.Monad
+import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as L
+import Control.Exception (throwIO)
+import Web.Authenticate.Internal
+import Data.Data (Data)
+import Data.Typeable (Typeable)
+import Data.Attoparsec.Lazy (parse)
+import qualified Data.Attoparsec.Lazy as AT
+import Data.Text (Text)
+import qualified Data.Aeson.Types
+
+-- | Information received from Rpxnow after a valid login.
+data Identifier = Identifier
+    { identifier :: Text
+    , extraData :: [(Text, Text)]
+    }
+    deriving (Eq, Ord, Read, Show, Data, Typeable)
+
+-- | Attempt to log a user in.
+authenticate :: (MonadIO m,
+                 Failure HttpException m,
+                 Failure AuthenticateException m)
+             => String -- ^ API key given by RPXNOW.
+             -> String -- ^ Token passed by client.
+             -> m Identifier
+authenticate apiKey token = do
+    let body = L.fromChunks
+            [ "apiKey="
+            , S.pack apiKey
+            , "&token="
+            , S.pack token
+            ]
+    let req =
+            Request
+                { method = "POST"
+                , secure = True
+                , host = "rpxnow.com"
+                , port = 443
+                , path = "api/v2/auth_info"
+                , queryString = []
+                , requestHeaders =
+                    [ ("Content-Type", "application/x-www-form-urlencoded")
+                    ]
+                , requestBody = RequestBodyLBS body
+                , checkCerts = const $ return True
+                }
+    res <- liftIO $ withManager $ httpLbsRedirect req
+    let b = responseBody res
+    unless (200 <= statusCode res && statusCode res < 300) $
+        liftIO $ throwIO $ StatusCodeException (statusCode res) b
+    o <- unResult $ parse json b
+    --m <- fromMapping o
+    let mstat = flip Data.Aeson.Types.parse o $ \v ->
+                case v of
+                    Object m -> m .: "stat"
+                    _ -> mzero
+    case mstat of
+        Success "ok" -> return ()
+        Success stat -> failure $ RpxnowException $
+            "Rpxnow login not accepted: " ++ stat ++ "\n" ++ L.unpack b
+        _ -> failure $ RpxnowException "Now stat value found on Rpxnow response"
+    case Data.Aeson.Types.parse parseProfile o of
+        Success x -> return x
+        Error e -> failure $ RpxnowException $ "Unable to parse Rpxnow response: " ++ e
+
+unResult :: Failure AuthenticateException m => AT.Result a -> m a
+unResult = either (failure . RpxnowException) return . AT.eitherResult
+
+parseProfile :: Value -> Data.Aeson.Types.Parser Identifier
+parseProfile (Object m) = do
+    profile <- m .: "profile"
+    ident <- m .: "identifier"
+    let profile' = mapMaybe go profile
+    return $ Identifier ident profile'
+  where
+    go ("identifier", _) = Nothing
+    go (k, String v) = Just (k, v)
+    go _ = Nothing
+parseProfile _ = mzero
diff --git a/authenticate.cabal b/authenticate.cabal
--- a/authenticate.cabal
+++ b/authenticate.cabal
@@ -1,48 +1,48 @@
-name:            authenticate
-version:         0.9.0.1
-license:         BSD3
-license-file:    LICENSE
-author:          Michael Snoyman <michael@snoyman.com>
-maintainer:      Michael Snoyman <michael@snoyman.com>
-synopsis:        Authentication methods for Haskell web applications.
-description:     Focus is on third-party authentication methods, such as OpenID,
-                 rpxnow and Facebook.
-category:        Web
-stability:       Stable
-cabal-version:   >= 1.2
-build-type:      Simple
-homepage:        http://github.com/snoyberg/authenticate/tree/master
-
-library
-    build-depends:   base >= 4 && < 5,
-                     aeson >= 0.3.1.1 && < 0.4,
-                     http-enumerator >= 0.6 && < 0.7,
-                     tagsoup >= 0.6 && < 0.13,
-                     failure >= 0.0.0 && < 0.2,
-                     transformers >= 0.1 && < 0.3,
-                     bytestring >= 0.9 && < 0.10,
-                     utf8-string >= 0.3 && < 0.4,
-                     network >= 2.2.1 && < 2.4,
-                     xml >= 1.3.7 && < 1.4,
-                     case-insensitive >= 0.2 && < 0.3,
-                     RSA >= 1.0 && < 1.1,
-                     time >= 1.1 && < 1.3,
-                     base64-bytestring >= 0.1 && < 0.2,
-                     SHA >= 1.4 && < 1.6,
-                     random >= 1.0 && < 1.1,
-                     text >= 0.5 && < 1.0,
-                     http-types >= 0.6 && < 0.7,
-                     enumerator >= 0.4.7 && < 0.5,
-                     blaze-builder >= 0.2 && < 0.4,
-                     attoparsec >= 0.8.5 && < 0.9
-    exposed-modules: Web.Authenticate.Rpxnow,
-                     Web.Authenticate.OpenId,
-                     Web.Authenticate.OpenId.Providers,
-                     Web.Authenticate.OAuth,
-                     Web.Authenticate.Facebook
-    other-modules:   Web.Authenticate.Internal,
-                     OpenId2.Discovery,
-                     OpenId2.Normalization,
-                     OpenId2.Types,
-                     OpenId2.XRDS
-    ghc-options:     -Wall
+name:            authenticate
+version:         0.9.0.2
+license:         BSD3
+license-file:    LICENSE
+author:          Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+synopsis:        Authentication methods for Haskell web applications.
+description:     Focus is on third-party authentication methods, such as OpenID,
+                 rpxnow and Facebook.
+category:        Web
+stability:       Stable
+cabal-version:   >= 1.2
+build-type:      Simple
+homepage:        http://github.com/snoyberg/authenticate/tree/master
+
+library
+    build-depends:   base >= 4 && < 5,
+                     aeson >= 0.3.1.1 && < 0.4,
+                     http-enumerator >= 0.6.5.2 && < 0.7,
+                     tagsoup >= 0.6 && < 0.13,
+                     failure >= 0.0.0 && < 0.2,
+                     transformers >= 0.1 && < 0.3,
+                     bytestring >= 0.9 && < 0.10,
+                     utf8-string >= 0.3 && < 0.4,
+                     network >= 2.2.1 && < 2.4,
+                     xml >= 1.3.7 && < 1.4,
+                     case-insensitive >= 0.2 && < 0.3,
+                     RSA >= 1.0 && < 1.1,
+                     time >= 1.1 && < 1.3,
+                     base64-bytestring >= 0.1 && < 0.2,
+                     SHA >= 1.4 && < 1.6,
+                     random >= 1.0 && < 1.1,
+                     text >= 0.5 && < 1.0,
+                     http-types >= 0.6 && < 0.7,
+                     enumerator >= 0.4.7 && < 0.5,
+                     blaze-builder >= 0.2 && < 0.4,
+                     attoparsec >= 0.8.5 && < 0.9
+    exposed-modules: Web.Authenticate.Rpxnow,
+                     Web.Authenticate.OpenId,
+                     Web.Authenticate.OpenId.Providers,
+                     Web.Authenticate.OAuth,
+                     Web.Authenticate.Facebook
+    other-modules:   Web.Authenticate.Internal,
+                     OpenId2.Discovery,
+                     OpenId2.Normalization,
+                     OpenId2.Types,
+                     OpenId2.XRDS
+    ghc-options:     -Wall