Skip to content
Browse files

Beginning of megarepo

  • Loading branch information...
1 parent 22f331b commit acdc3d52ecc929545e9f76435ec9bf0ca9acbc07 @snoyberg snoyberg committed Jan 24, 2012
View
0 LICENSE → authenticate/LICENSE
File renamed without changes.
View
0 OpenId2/Discovery.hs → authenticate/OpenId2/Discovery.hs
File renamed without changes.
View
0 OpenId2/Normalization.hs → authenticate/OpenId2/Normalization.hs
File renamed without changes.
View
0 OpenId2/Types.hs → authenticate/OpenId2/Types.hs
File renamed without changes.
View
0 OpenId2/XRDS.hs → authenticate/OpenId2/XRDS.hs
File renamed without changes.
View
0 Setup.lhs → authenticate/Setup.lhs
File renamed without changes.
View
0 Web/Authenticate/BrowserId.hs → authenticate/Web/Authenticate/BrowserId.hs
File renamed without changes.
View
0 Web/Authenticate/Internal.hs → authenticate/Web/Authenticate/Internal.hs
File renamed without changes.
View
0 Web/Authenticate/Kerberos.hs → authenticate/Web/Authenticate/Kerberos.hs
File renamed without changes.
View
0 Web/Authenticate/OAuth.hs → authenticate/Web/Authenticate/OAuth.hs
File renamed without changes.
View
0 Web/Authenticate/OpenId.hs → authenticate/Web/Authenticate/OpenId.hs
File renamed without changes.
View
0 Web/Authenticate/OpenId/Providers.hs → ...cate/Web/Authenticate/OpenId/Providers.hs
File renamed without changes.
View
0 Web/Authenticate/Rpxnow.hs → authenticate/Web/Authenticate/Rpxnow.hs
File renamed without changes.
View
0 authenticate.cabal → authenticate/authenticate.cabal
File renamed without changes.
View
0 browserid.hs → authenticate/browserid.hs
File renamed without changes.
View
0 openid2.hs → authenticate/openid2.hs
File renamed without changes.
View
0 rpxnow.hs → authenticate/rpxnow.hs
File renamed without changes.
View
73 facebook.hs
@@ -1,73 +0,0 @@
-{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
-import Yesod
-import Web.Authenticate.Facebook
-import Data.Maybe (fromMaybe)
-import qualified Data.Aeson as A
-import qualified Data.Vector as V
-import qualified Data.Map as M
-
-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
-/facebook FacebookR GET
-|]
-
-instance Yesod FB where approot _ = "http://localhost:3000"
-
-getRootR :: Handler ()
-getRootR = do
- FB f <- getYesod
- let s = getForwardUrl f ["email"]
- liftIO $ print ("Redirecting" :: String, s)
- redirectText RedirectTemporary s
-
-getFacebookR :: Handler RepHtml
-getFacebookR = do
- FB f <- getYesod
- code <- runFormGet' $ stringInput "code"
- at <- liftIO $ getAccessToken f code
- liftIO $ print at
- mreq <- runFormGet' $ maybeStringInput "req"
- let req = fromMaybe "me" mreq
- Right so <- liftIO $ getGraphData at req
- let so' = objToHamlet so
- hamletToRepHtml [hamlet|\
-<form>
- <input type="hidden" name="code" value="#{code}">
- \Request:
- <input type="text" name="req" value="#{req}">
- \
- <input type="submit">
-<hr>
-\^{so'}
-|]
-
-main :: IO ()
-main = warpDebug 3000 fb
-
-objToHamlet :: A.Value -> Hamlet url
-objToHamlet (A.String s) = [hamlet|#{s}|]
-objToHamlet (A.Array list) = [hamlet|
-<ul>
- $forall o <- V.toList list
- <li>^{objToHamlet o}
-|]
-objToHamlet (A.Object pairs) = [hamlet|\
-<dl>
- $forall pair <- M.toList pairs
- <dt>#{fst pair}
- <dd>^{objToHamlet $ snd pair}
-|]
-objToHamlet (A.Number i) = [hamlet|<i>#{show i}|]
-objToHamlet (A.Bool True) = [hamlet|<i>true|]
-objToHamlet (A.Bool False) = [hamlet|<i>false|]
-objToHamlet A.Null = [hamlet|<i>null|]

0 comments on commit acdc3d5

Please sign in to comment.
Something went wrong with that request. Please try again.