From a607da06d31ec7359580636a13ce6b3246e6c359 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 1 Oct 2009 15:59:55 +0200
Subject: [PATCH] Minor fixes, bool parameter instance

---
 TODO                        | 2 ++
 Web/Restful/Helpers/Auth.hs | 2 +-
 Web/Restful/Request.hs      | 8 +++++++-
 Web/Restful/Utils.hs        | 2 +-
 4 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/TODO b/TODO
index b74fc905..c3062510 100644
--- a/TODO
+++ b/TODO
@@ -1 +1,3 @@
 Catch exceptions and return as 500 errors
+approot
+Request parameters without a request object?
diff --git a/Web/Restful/Helpers/Auth.hs b/Web/Restful/Helpers/Auth.hs
index 82b3114a..50cb23e7 100644
--- a/Web/Restful/Helpers/Auth.hs
+++ b/Web/Restful/Helpers/Auth.hs
@@ -86,7 +86,7 @@ authOpenidForm = do
             "<input type='submit' value='Login'>" ++
             "</form>"
     case dest of
-        Just dest' -> addCookie 20 "DEST" dest'
+        Just dest' -> addCookie 120 "DEST" dest'
         Nothing -> return ()
     htmlResponse html
 
diff --git a/Web/Restful/Request.hs b/Web/Restful/Request.hs
index 6a8d9ee4..50886fc4 100644
--- a/Web/Restful/Request.hs
+++ b/Web/Restful/Request.hs
@@ -160,7 +160,7 @@ hackHeaderParam name = do
 -- | Extract the cookie which specifies the identifier for a logged in
 -- user.
 identifier :: Parameter a => RequestParser a
-identifier = hackHeaderParam authCookieName
+identifier = hackHeaderParam authCookieName -- FIXME better error message
 
 -- | Get the raw 'Hack.Env' value.
 parseEnv :: RequestParser Hack.Env
@@ -278,6 +278,12 @@ instance Parameter Day where
                 then Right $ fromGregorian y m d
                 else Left $ "Invalid date: " ++ s
 
+-- for checkboxes; checks for presence
+instance Parameter Bool where
+    readParams [] = Right False
+    readParams [_] = Right True
+    readParams x = Left $ "Invalid Bool parameter: " ++ show x
+
 -- | The input for a resource.
 --
 -- Each resource can define its own instance of 'Request' and then more
diff --git a/Web/Restful/Utils.hs b/Web/Restful/Utils.hs
index 66e36db7..2862fa2c 100644
--- a/Web/Restful/Utils.hs
+++ b/Web/Restful/Utils.hs
@@ -45,7 +45,7 @@ tryLookup def key = fromMaybe def . lookup key
 
 -- | Format a 'UTCTime' in W3 format; useful for setting cookies.
 formatW3 :: UTCTime -> String
-formatW3 = formatTime defaultTimeLocale "%FT%X-08:00" -- FIXME time zone?
+formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"
 
 ----- Testing
 testSuite :: Test