diff --git a/yesod-auth/Yesod/Auth/Dummy.hs b/yesod-auth/Yesod/Auth/Dummy.hs index 5b1b703c..6c470f22 100644 --- a/yesod-auth/Yesod/Auth/Dummy.hs +++ b/yesod-auth/Yesod/Auth/Dummy.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} -- | Provides a dummy authentication module that simply lets a user specify -- their identifier. This is not intended for real world use, just for -- testing. This plugin supports form submissions via JSON (since 1.6.8). @@ -36,12 +36,12 @@ module Yesod.Auth.Dummy ( authDummy ) where -import Yesod.Auth -import Yesod.Form (runInputPost, textField, ireq) -import Yesod.Core -import Data.Text (Text) -import Data.Aeson.Types (Result(..), Parser) +import Data.Aeson.Types (Parser, Result (..)) import qualified Data.Aeson.Types as A (parseEither, withObject) +import Data.Text (Text) +import Yesod.Auth +import Yesod.Core +import Yesod.Form (ireq, runInputPost, textField) identParser :: Value -> Parser Text identParser = A.withObject "Ident" (.: "ident") diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index 2395ed67..5eceff35 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -117,29 +117,30 @@ module Yesod.Auth.Email , defaultRegisterHelper ) where -import Yesod.Auth -import qualified Yesod.Auth.Message as Msg -import Yesod.Core -import Yesod.Form -import qualified Yesod.Auth.Util.PasswordStore as PS -import Control.Applicative ((<$>), (<*>)) -import qualified Crypto.Hash as H -import qualified Crypto.Nonce as Nonce -import Data.ByteString.Base16 as B16 -import Data.Text (Text) -import qualified Data.Text as TS -import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8With, encodeUtf8) -import qualified Data.Text.Encoding as TE -import Data.Text.Encoding.Error (lenientDecode) -import Data.Time (addUTCTime, getCurrentTime) -import Safe (readMay) -import System.IO.Unsafe (unsafePerformIO) +import Control.Applicative ((<$>), (<*>)) +import qualified Crypto.Hash as H +import qualified Crypto.Nonce as Nonce +import Data.Aeson.Types (Parser, Result (..), parseMaybe, + withObject, (.:?)) +import Data.ByteArray (convert) +import Data.ByteString.Base16 as B16 +import Data.Maybe (isJust) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text as TS +import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +import qualified Data.Text.Encoding as TE +import Data.Text.Encoding.Error (lenientDecode) +import Data.Time (addUTCTime, getCurrentTime) +import Safe (readMay) +import System.IO.Unsafe (unsafePerformIO) import qualified Text.Email.Validate -import Data.Aeson.Types (Parser, Result(..), parseMaybe, withObject, (.:?)) -import Data.Maybe (isJust) -import Data.ByteArray (convert) -import Yesod.Core.Types (TypedContent(TypedContent)) +import Yesod.Auth +import qualified Yesod.Auth.Message as Msg +import qualified Yesod.Auth.Util.PasswordStore as PS +import Yesod.Core +import Yesod.Core.Types (TypedContent (TypedContent)) +import Yesod.Form loginR, registerR, forgotPasswordR, setpassR :: AuthRoute loginR = PluginR "email" ["login"] @@ -440,7 +441,7 @@ authEmail = dispatch "POST" ["forgot-password"] = postForgotPasswordR >>= sendResponse dispatch "GET" ["verify", eid, verkey] = case fromPathPiece eid of - Nothing -> notFound + Nothing -> notFound Just eid' -> getVerifyR eid' verkey False >>= sendResponse dispatch "GET" ["verify", eid, verkey, hasSetPass] = case fromPathPiece eid of @@ -578,7 +579,7 @@ defaultRegisterHelper allowUsername forgotPassword dest = do _ -> do (creds :: Result Value) <- parseCheckJsonBody return $ case creds of - Error _ -> Nothing + Error _ -> Nothing Success val -> parseMaybe parseRegister val let eidentifier = case creds of @@ -591,7 +592,7 @@ defaultRegisterHelper allowUsername forgotPassword dest = do let mpass = case (forgotPassword, creds) of (False, Just (_, mp)) -> mp - _ -> Nothing + _ -> Nothing case eidentifier of Left failMsg -> loginErrorMessageI dest failMsg @@ -622,7 +623,7 @@ defaultRegisterHelper allowUsername forgotPassword dest = do then sendConfirmationEmail creds else case emailPreviouslyRegisteredResponse identifier of Just response -> response - Nothing -> sendConfirmationEmail creds + Nothing -> sendConfirmationEmail creds where sendConfirmationEmail (lid, _, verKey, email) = do render <- getUrlRender tp <- getRouteToParent @@ -741,7 +742,7 @@ postLoginR = do _ -> do (creds :: Result Value) <- parseCheckJsonBody case creds of - Error _ -> return Nothing + Error _ -> return Nothing Success val -> return $ parseMaybe parseCreds val case midentifier of @@ -872,7 +873,7 @@ postPasswordR = do maid <- maybeAuthId (creds :: Result Value) <- parseCheckJsonBody let jcreds = case creds of - Error _ -> Nothing + Error _ -> Nothing Success val -> parseMaybe parsePassword val let doJsonParsing = isJust jcreds case maid of @@ -884,7 +885,7 @@ postPasswordR = do res <- runInputPostResult $ ireq textField "current" let fcurrent = case res of FormSuccess currentPass -> Just currentPass - _ -> Nothing + _ -> Nothing let current = if doJsonParsing then getThird jcreds else fcurrent @@ -903,9 +904,9 @@ postPasswordR = do where msgOk = Msg.PassUpdated getThird (Just (_,_,t)) = t - getThird Nothing = Nothing + getThird Nothing = Nothing getNewConfirm (Just (a,b,_)) = Just (a,b) - getNewConfirm _ = Nothing + getNewConfirm _ = Nothing confirmPassword aid tm jcreds = do res <- runInputPostResult $ (,) <$> ireq textField "new" @@ -914,7 +915,7 @@ postPasswordR = do then getNewConfirm jcreds else case res of FormSuccess res' -> Just res' - _ -> Nothing + _ -> Nothing case creds of Nothing -> loginErrorMessageI setpassR Msg.PassMismatch Just (new, confirm) -> diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index 5dbbd6d1..cf79a57f 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -53,55 +53,55 @@ module Yesod.Auth.GoogleEmail2 , pid ) where -import Yesod.Auth (Auth, AuthPlugin (AuthPlugin), - AuthRoute, Creds (Creds), - Route (PluginR), YesodAuth, - runHttpRequest, setCredsRedirect, - logoutDest, AuthHandler) -import qualified Yesod.Auth.Message as Msg -import Yesod.Core (HandlerSite, MonadHandler, - TypedContent, getRouteToParent, - getUrlRender, invalidArgs, - liftIO, lookupGetParam, - lookupSession, notFound, redirect, - setSession, whamlet, (.:), - addMessage, getYesod, - toHtml, liftSubHandler) +import Yesod.Auth (Auth, AuthHandler, + AuthPlugin (AuthPlugin), + AuthRoute, Creds (Creds), + Route (PluginR), YesodAuth, + logoutDest, runHttpRequest, + setCredsRedirect) +import qualified Yesod.Auth.Message as Msg +import Yesod.Core (HandlerSite, MonadHandler, + TypedContent, addMessage, + getRouteToParent, getUrlRender, + getYesod, invalidArgs, liftIO, + liftSubHandler, lookupGetParam, + lookupSession, notFound, redirect, + setSession, toHtml, whamlet, (.:)) -import Blaze.ByteString.Builder (fromByteString, toByteString) -import Control.Applicative ((<$>), (<*>)) -import Control.Arrow (second) -import Control.Monad (unless, when) -import Control.Monad.IO.Class (MonadIO) -import qualified Crypto.Nonce as Nonce -import Data.Aeson ((.:?)) -import qualified Data.Aeson as A +import Blaze.ByteString.Builder (fromByteString, toByteString) +import Control.Applicative ((<$>), (<*>)) +import Control.Arrow (second) +import Control.Monad (unless, when) +import Control.Monad.IO.Class (MonadIO) +import qualified Crypto.Nonce as Nonce +import Data.Aeson ((.:?)) +import qualified Data.Aeson as A #if MIN_VERSION_aeson(1,0,0) -import qualified Data.Aeson.Text as A +import qualified Data.Aeson.Text as A #else -import qualified Data.Aeson.Encode as A +import qualified Data.Aeson.Encode as A #endif -import Data.Aeson.Parser (json') -import Data.Aeson.Types (FromJSON (parseJSON), parseEither, - parseMaybe, withObject, withText) +import Data.Aeson.Parser (json') +import Data.Aeson.Types (FromJSON (parseJSON), parseEither, + parseMaybe, withObject, withText) import Data.Conduit -import Data.Conduit.Attoparsec (sinkParser) -import qualified Data.HashMap.Strict as M -import Data.Maybe (fromMaybe) -import Data.Monoid (mappend) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8, encodeUtf8) -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Builder as TL -import Network.HTTP.Client (Manager, requestHeaders, - responseBody, urlEncodedBody) -import qualified Network.HTTP.Client as HTTP +import Data.Conduit.Attoparsec (sinkParser) +import qualified Data.HashMap.Strict as M +import Data.Maybe (fromMaybe) +import Data.Monoid (mappend) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TL +import Network.HTTP.Client (Manager, requestHeaders, + responseBody, urlEncodedBody) +import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.Conduit (Request, bodyReaderSource) -import Network.HTTP.Conduit (http) -import Network.HTTP.Types (renderQueryText) -import System.IO.Unsafe (unsafePerformIO) +import Network.HTTP.Conduit (http) +import Network.HTTP.Types (renderQueryText) +import System.IO.Unsafe (unsafePerformIO) -- | Plugin identifier. This is used to identify the plugin used for @@ -239,7 +239,7 @@ authPlugin storeToken clientID clientSecret = value <- makeHttpRequest req token@(Token accessToken' tokenType') <- case parseEither parseJSON value of - Left e -> error e + Left e -> error e Right t -> return t unless (tokenType' == "Bearer") $ error $ "Unknown token type: " ++ show tokenType' @@ -251,14 +251,14 @@ authPlugin storeToken clientID clientSecret = personValue <- makeHttpRequest personValReq person <- case parseEither parseJSON personValue of - Left e -> error e + Left e -> error e Right x -> return x email <- case map emailValue $ filter (\e -> emailType e == EmailAccount) $ personEmails person of [e] -> return e - [] -> error "No account email" - x -> error $ "Too many account emails: " ++ show x + [] -> error "No account email" + x -> error $ "Too many account emails: " ++ show x setCredsRedirect $ Creds pid email $ allPersonInfo personValue dispatch _ _ = notFound @@ -452,16 +452,16 @@ data RelationshipStatus = Single -- ^ Person is single instance FromJSON RelationshipStatus where parseJSON = withText "RelationshipStatus" $ \t -> return $ case t of - "single" -> Single - "in_a_relationship" -> InRelationship - "engaged" -> Engaged - "married" -> Married - "its_complicated" -> Complicated - "open_relationship" -> OpenRelationship - "widowed" -> Widowed - "in_domestic_partnership" -> DomesticPartnership - "in_civil_union" -> CivilUnion - _ -> RelationshipStatus t + "single" -> Single + "in_a_relationship" -> InRelationship + "engaged" -> Engaged + "married" -> Married + "its_complicated" -> Complicated + "open_relationship" -> OpenRelationship + "widowed" -> Widowed + "in_domestic_partnership" -> DomesticPartnership + "in_civil_union" -> CivilUnion + _ -> RelationshipStatus t -------------------------------------------------------------------------------- -- | The URI of the person's profile photo. diff --git a/yesod-auth/Yesod/Auth/Hardcoded.hs b/yesod-auth/Yesod/Auth/Hardcoded.hs index e8bdccdb..b700dbd4 100644 --- a/yesod-auth/Yesod/Auth/Hardcoded.hs +++ b/yesod-auth/Yesod/Auth/Hardcoded.hs @@ -131,10 +131,9 @@ module Yesod.Auth.Hardcoded , loginR ) where -import Yesod.Auth (AuthPlugin (..), AuthRoute, +import Yesod.Auth (AuthHandler, AuthPlugin (..), AuthRoute, Creds (..), Route (..), YesodAuth, - loginErrorMessageI, setCredsRedirect, - AuthHandler) + loginErrorMessageI, setCredsRedirect) import qualified Yesod.Auth.Message as Msg import Yesod.Core import Yesod.Form (ireq, runInputPost, textField) @@ -161,7 +160,7 @@ authHardcoded = where dispatch :: YesodAuthHardcoded m => Text -> [Text] -> AuthHandler m TypedContent dispatch "POST" ["login"] = postLoginR >>= sendResponse - dispatch _ _ = notFound + dispatch _ _ = notFound loginWidget toMaster = do request <- getRequest [whamlet|