diff --git a/Yesod/Auth/BrowserId.hs b/Yesod/Auth/BrowserId.hs new file mode 100644 index 00000000..ddb975ef --- /dev/null +++ b/Yesod/Auth/BrowserId.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Yesod.Auth.BrowserId + ( authBrowserId + ) where + +import Yesod.Auth +import Web.Authenticate.BrowserId +import Data.Text (Text) +import Yesod.Core +import Text.Hamlet (hamlet) +import Control.Monad.IO.Class (liftIO) + +#include "qq.h" + +pid :: Text +pid = "browserid" + +complete :: AuthRoute +complete = PluginR pid [] + +authBrowserId :: YesodAuth m + => Text -- ^ audience + -> AuthPlugin m +authBrowserId audience = AuthPlugin + { apName = pid + , apDispatch = \m ps -> + case (m, ps) of + ("GET", [assertion]) -> do + memail <- liftIO $ checkAssertion audience assertion + case memail of + Nothing -> error "Invalid assertion" + Just email -> setCreds True Creds + { credsPlugin = pid + , credsIdent = email + , credsExtra = [] + } + (_, []) -> badMethod + _ -> notFound + , apLogin = \toMaster -> do + addScriptRemote browserIdJs + addHamlet [QQ(hamlet)| +

+ + +|] + } diff --git a/browserid.hs b/browserid.hs new file mode 100644 index 00000000..12da848d --- /dev/null +++ b/browserid.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} +import Yesod.Core +import Yesod.Auth +import Yesod.Auth.BrowserId +import Data.Text (Text) +import Text.Hamlet (hamlet) +import Control.Monad.IO.Class (liftIO) +import Yesod.Form +import Network.Wai.Handler.Warp (run) + +data BID = BID +type Handler = GHandler BID BID + +mkYesod "BID" [parseRoutes| +/ RootR GET +/after AfterLoginR GET +/auth AuthR Auth getAuth +|] + +getRootR :: Handler () +getRootR = redirect RedirectTemporary $ AuthR LoginR + +getAfterLoginR :: Handler RepHtml +getAfterLoginR = do + mauth <- maybeAuthId + defaultLayout $ addHamlet [hamlet| +

Auth: #{show mauth} +|] + +instance Yesod BID where + approot _ = "http://localhost:3000" + +instance YesodAuth BID where + type AuthId BID = Text + loginDest _ = AfterLoginR + logoutDest _ = AuthR LoginR + getAuthId = return . Just . credsIdent + authPlugins = [authBrowserId "localhost:3000"] + +instance RenderMessage BID FormMessage where + renderMessage _ _ = defaultFormMessage + +main :: IO () +main = toWaiApp BID >>= run 3000 diff --git a/yesod-auth.cabal b/yesod-auth.cabal index 6776fe7e..37892683 100644 --- a/yesod-auth.cabal +++ b/yesod-auth.cabal @@ -20,7 +20,7 @@ library cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3 - build-depends: authenticate >= 0.9 && < 0.10 + build-depends: authenticate >= 0.9.2 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10 , yesod-core >= 0.9 && < 0.10 , wai >= 0.4 && < 0.5 @@ -45,6 +45,7 @@ library , pwstore-fast >= 2.1 && < 2.2 exposed-modules: Yesod.Auth + Yesod.Auth.BrowserId Yesod.Auth.Dummy Yesod.Auth.Email Yesod.Auth.Facebook