Most recent attempt etc changes

Web/Restful/Application.hs

@@ -23,11 +23,10 @@ module Web.Restful.Application
     ) where
 
 import Web.Encodings
-import Data.Object
 import Data.Object.Text
+import Data.Object.String
 import Data.Enumerable
 import Control.Monad (when)
-import qualified Data.Text.Lazy as LT
 
 import qualified Hack
 import Hack.Middleware.CleanPath
@@ -61,15 +60,16 @@ class ResourceName a => RestfulApp a where
 
     -- | Output error response pages.
     errorHandler :: Monad m => a -> RawRequest -> ErrorResult -> [RepT m] -- FIXME better type sig?
-    errorHandler _ rr NotFound = reps $ toTextObject $ "Not found: " ++ show rr
+    errorHandler _ rr NotFound = reps $ toTextObject $
+                                   "Not found: " ++ show rr
     errorHandler _ _ (Redirect url) =
         reps $ toTextObject $ "Redirect to: " ++ url
     errorHandler _ _ (InternalError e) =
         reps $ toTextObject $ "Internal server error: " ++ e
     errorHandler _ _ (InvalidArgs ia) =
-        reps $ Mapping
+        reps $ toTextObject $ toStringObject
-            [ (LT.pack "errorMsg", toTextObject "Invalid arguments")
+            [ ("errorMsg", toStringObject "Invalid arguments")
-            , (LT.pack "messages", toTextObject ia)
+            , ("messages", toStringObject ia)
             ]
     errorHandler _ _ PermissionDenied =
         reps $ toTextObject "Permission denied"

Web/Restful/Handler.hs

@@ -89,8 +89,8 @@ runHandler h rr cts = do
         takeAllExceptions :: IO (Attempt x) -> IO (Attempt x)
         takeAllExceptions ioa =
             Control.Exception.catch ioa (return . someFailure)
-        someFailure :: Control.Exception.SomeException -> Attempt v
+        someFailure :: Control.Exception.SomeException -> Attempt v -- FIXME
-        someFailure = Failure
+        someFailure = failure
         toErrorResult :: Exception e => e -> ErrorResult
         toErrorResult e =
             case cast e of

Web/Restful/Helpers/Auth.hs

@@ -107,23 +107,23 @@ authOpenidForward = do
                    show (Hack.serverPort env) ++
                    "/auth/openid/complete/"
     res <- runAttemptT $ OpenId.getForwardUrl oid complete
-    case res of
+    attempt
-        Failure err -> redirect $ "/auth/openid/?message="
+      (\err -> redirect $ "/auth/openid/?message=" ++ encodeUrl (show err))
-                            ++ encodeUrl (show err)
+      redirect
-        Success url -> redirect url
+      res
 
 authOpenidComplete :: Handler
 authOpenidComplete = do
     gets' <- rawGetParams <$> askRawRequest
     dest <- cookieParam "DEST"
     res <- runAttemptT $ OpenId.authenticate gets'
-    case res of
+    let onFailure err = redirect $ "/auth/openid/?message="
-      Failure err -> redirect $ "/auth/openid/?message="
                             ++ encodeUrl (show err)
-      Success (OpenId.Identifier ident) -> do
+    let onSuccess (OpenId.Identifier ident) = do
         deleteCookie "DEST"
         header authCookieName ident
         redirect $ fromMaybe "/" dest
+    attempt onFailure onSuccess res
 
 -- | token dest
 data RpxnowRequest = RpxnowRequest String (Maybe String)

Web/Restful/Helpers/Static.hs

@@ -46,7 +46,7 @@ getStatic fl = do
     content <- liftIO $ fl fp
     case content of
         Nothing -> notFound
-        Just bs -> return $ genResponse (mimeType $ ext fp) bs
+        Just bs -> return [(mimeType $ ext fp, return $ toContent bs)]
 
 mimeType :: String -> String
 mimeType "jpg" = "image/jpeg"

Web/Restful/Response.hs

@@ -48,6 +48,7 @@ import Data.Object
 import Data.Object.Text
 import Data.Object.Translate
 import Data.Object.Instances
+import qualified Data.ByteString as SBS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Encoding as LTE
@@ -78,6 +79,8 @@ runContent ls (TransText t) = LTE.encodeUtf8 $ t ls
 
 class ToContent a where
     toContent :: a -> Content
+instance ToContent SBS.ByteString where
+    toContent = ByteString . convertSuccess
 instance ToContent LBS.ByteString where
     toContent = ByteString
 instance ToContent String where