Apply stylish-haskell
This commit is contained in:
Arthur Sakhievich Fayzrakhmanov
parent
8f83462134
commit
814584d7d9
@ -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")
|
||||
|
||||
@ -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) ->
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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|
|
||||
|
||||
Loading…
Reference in New Issue
Block a user