From c676a7eb0a04759d7be120195681eaeb5d9e157e Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 10 Jun 2011 12:14:22 +0300
Subject: [PATCH] Facebook sample

---
 Yesod/Auth.hs         |  1 +
 Yesod/Auth/Message.hs |  1 -
 facebook.hs           | 53 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 54 insertions(+), 1 deletion(-)
 create mode 100644 facebook.hs

diff --git a/Yesod/Auth.hs b/Yesod/Auth.hs
index 4beb40f1..850ac194 100644
--- a/Yesod/Auth.hs
+++ b/Yesod/Auth.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Yesod.Auth
     ( -- * Subsite
       Auth
diff --git a/Yesod/Auth/Message.hs b/Yesod/Auth/Message.hs
index 793a5999..c2d63645 100644
--- a/Yesod/Auth/Message.hs
+++ b/Yesod/Auth/Message.hs
@@ -4,7 +4,6 @@ module Yesod.Auth.Message
     , defaultMessage
     ) where
 
-import Text.Blaze (Html, toHtml)
 import Data.Monoid (mappend)
 import Data.Text (Text)
 
diff --git a/facebook.hs b/facebook.hs
new file mode 100644
index 00000000..c55e87b0
--- /dev/null
+++ b/facebook.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+import Yesod
+import Yesod.Auth
+import Yesod.Auth.Facebook
+import Web.Authenticate.Facebook
+import Yesod.Form
+
+data FB = FB Facebook
+type Handler = GHandler FB FB
+
+fb :: FB
+fb = FB Facebook
+    { facebookClientId = "154414801293567"
+    , facebookClientSecret = "f901e124bee0d162c9188f92b939b370"
+    , facebookRedirectUri = "http://localhost:3000/facebook"
+    }
+
+mkYesod "FB" [parseRoutes|
+/ RootR GET
+/after AfterLoginR GET
+/auth AuthR Auth getAuth
+|]
+
+getRootR :: Handler ()
+getRootR = redirect RedirectTemporary $ AuthR LoginR
+
+getAfterLoginR :: Handler RepHtml
+getAfterLoginR = defaultLayout $ return ()
+
+instance Yesod FB where
+    approot _ = "http://localhost:3000"
+
+instance YesodAuth FB where
+    type AuthId FB = String
+    loginDest _ = AfterLoginR
+    logoutDest _ = AuthR LoginR
+    getAuthId _ = do
+        liftIO $ putStrLn "getAuthId"
+        return $ Just "foo"
+    authPlugins = return $ authFacebook
+        "154414801293567"
+        "f901e124bee0d162c9188f92b939b370"
+        []
+
+instance RenderMessage FB FormMessage where
+    renderMessage _ _ = defaultFormMessage
+
+main :: IO ()
+main = warpDebug 3000 fb