From bdb6f2011fea3f68bec080120228ef803a0c7270 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 3 Oct 2010 09:59:41 +0200
Subject: [PATCH] MissingVar for OpenID

---
 Web/Authenticate/OpenId.hs | 17 ++++++++++++-----
 authenticate.cabal         |  2 +-
 2 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs
index 85110087..0cebb4da 100644
--- a/Web/Authenticate/OpenId.hs
+++ b/Web/Authenticate/OpenId.hs
@@ -47,7 +47,8 @@ instance Monad Error where
 -- | Returns a URL to forward the user to in order to login.
 getForwardUrl :: (MonadIO m,
                   Failure InvalidUrlException m,
-                  Failure HttpException m
+                  Failure HttpException m,
+                  Failure MissingVar m
                   )
               => String -- ^ The openid the user provided.
               -> String -- ^ The URL for this application\'s complete page.
@@ -64,7 +65,11 @@ getForwardUrl openid complete = do
                         , ("openid.return_to", complete)
                         ]
 
-getOpenIdVar :: Monad m => String -> String -> m String
+data MissingVar = MissingVar String
+    deriving (Typeable, Show)
+instance Exception MissingVar
+
+getOpenIdVar :: Failure MissingVar m => String -> String -> m String
 getOpenIdVar var content = do
     let tags = parseTags content
     let secs = sections (~== ("<link rel=openid." ++ var ++ ">")) tags
@@ -72,7 +77,7 @@ getOpenIdVar var content = do
     secs'' <- mhead secs'
     return $ fromAttrib "href" secs''
     where
-        mhead [] = fail $ "Variable not found: openid." ++ var -- FIXME
+        mhead [] = failure $ MissingVar $ "openid." ++ var
         mhead (x:_) = return x
 
 constructUrl :: String -> [(String, String)] -> String -- FIXME no longer needed, use Request value directly
@@ -90,7 +95,8 @@ constructUrl url args = url ++ "?" ++ queryString' args
 authenticate :: (MonadIO m,
                  Failure AuthenticateException m,
                  Failure InvalidUrlException m,
-                 Failure HttpException m)
+                 Failure HttpException m,
+                 Failure MissingVar m)
              => [(String, String)]
              -> m Identifier
 authenticate req = do -- FIXME check openid.mode == id_res (not cancel)
@@ -117,7 +123,8 @@ instance Exception AuthenticateException
 
 getAuthUrl :: (MonadIO m, Failure AuthenticateException m,
                Failure InvalidUrlException m,
-               Failure HttpException m)
+               Failure HttpException m,
+               Failure MissingVar m)
            => [(String, String)] -> m String
 getAuthUrl req = do
     identity <- alookup "openid.identity" req
diff --git a/authenticate.cabal b/authenticate.cabal
index ca8dcf9d..0fa909f0 100644
--- a/authenticate.cabal
+++ b/authenticate.cabal
@@ -1,5 +1,5 @@
 name:            authenticate
-version:         0.6.4
+version:         0.6.5
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>