yesod-auth-nopassword (empty) → 0.1.0.1

raw patch · 5 files changed

+318/−0 lines, 5 filesdep +basedep +blaze-markupdep +http-typessetup-changed

Dependencies added: base, blaze-markup, http-types, pwstore-fast, text, uuid, yesod-auth, yesod-core, yesod-form

Files

• LICENSE +21/−0
• README.md +3/−0
• Setup.hs +2/−0
• src/Yesod/Auth/NoPassword.hs +259/−0
• yesod-auth-nopassword.cabal +33/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 Dan Palmer++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,3 @@+### yesod-auth-nopassword++A plugin for Yesod to provide email-only authentication.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,259 @@+-- | This auth plugin for Yesod enabled simple passwordless authentication.+--+-- The only detail required from a user is an email address, and accounts are+-- either updated or created, depending on whether the account exists or not.+-- To actually log in, users are sent an email containing a link that+-- authenticates them and logs them in.+--+-- This plugin provides:+--+-- * Token generation+-- * Orchestration of the login process and email sending+-- * Receiving of the login form data via HTTP POST.+-- * Authentication of users once they return to the site from an email+--+-- This plugin /does not/ provide:+--+-- * A login form+-- * Email rendering or sending+-- * An account model+-- * A viewable interface (i.e. via HTTP GET) for the login form+--+-- These are left for the user of the plugin to implement so that they can+-- retain control over form functionality, account models, email design and+-- email service provider.+--+-- Implementation checklist:+--+-- 1. Implement an instance of 'NoPasswordAuth' for your Yesod application.+-- 2. Implement a Yesod form that resolves to an 'EmailForm'.+-- 3. Add `authNoPassword` to your authentication plugins in your instance of+--    `YesodAuth`, passing the form you wish to use for authentication. This+--    typeclass provides a number of methods for customisation of behaviour,+--    but the minimal implementation is:+--+--     * 'loginRoute'+--     * 'emailSentRoute'+--     * 'sendLoginEmail'+--     * 'getUserByEmail'+--     * 'getEmailAndHashByTokenId'+--     * 'updateLoginHashForUser'+--     * 'newUserWithLoginHash'++module Yesod.Auth.NoPassword (+    -- * Plugin+      authNoPassword+    -- * Form Type+    , EmailForm(..)+    -- * Typeclass+    , NoPasswordAuth(..)+    -- * Types+    , Email+    , Token+    , TokenId+    , Hash+    -- ** Utility+    , loginPostR+) where++import Prelude++import Data.Monoid ((<>))+import Data.Text+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Text.Blaze as B++import qualified Data.UUID as U+import qualified Data.UUID.V4 as U++import Network.HTTP.Types.URI (urlEncode, urlDecode)++import Yesod.Core+import Yesod.Form+import Yesod.Auth+import Crypto.PasswordStore++-- Constants++pluginName :: Text+pluginName = "email"++-- | Route to which the site should POST the email form form.+loginPostR :: AuthRoute+loginPostR = PluginR pluginName ["login"]+++type Email = Text+type Token = Text+type TokenId = Text+type Hash = Text+++-- | Data type required for the Yesod form.+newtype EmailForm = EmailForm+    { efEmail :: Email+    }+++-- Convenience alias for forms+type Form m a = (Html -> MForm (HandlerT m IO) (FormResult a, WidgetT m IO ()))+++-- | Function to create the Yesod Auth plugin. Must be used by a type with an+-- instance for 'NoPasswordAuth', and must be given a form to use.+authNoPassword :: NoPasswordAuth m+               => Form m EmailForm+               -> AuthPlugin m+authNoPassword form = AuthPlugin pluginName dispatch login+    where+        login _ = error "NoPasswordAuth does not provide a login widget"++        dispatch "POST" ["login"] = postEmailR form+        dispatch "GET"  ["login"] = getLoginR+        dispatch _ _ = notFound+++postEmailR :: NoPasswordAuth m+           => Form m EmailForm+           -> HandlerT Auth (HandlerT m IO) TypedContent+postEmailR form = do+    ((result, _), _) <- lift $ runFormPost form+    master <- lift getYesod+    case result of+        FormMissing -> do+            setMessage "Something went wrong, please try again"+            lift $ redirect (emailSentRoute master)+        FormFailure as -> do+            mapM_ (setMessage . B.text) as+            lift $ redirect (emailSentRoute master)+        FormSuccess e -> do+            let email = efEmail e+            strength <- lift $ tokenStrength+            (hash, token) <- liftIO $ genToken strength+            muser <- lift $ getUserByEmail (efEmail e)+            tid <- liftIO genTokenId+            case muser of+                Just user ->+                    lift $ updateLoginHashForUser user (Just hash) tid+                Nothing ->+                    lift $ newUserWithLoginHash email hash tid+            setMessage $ B.text "Check your email for a login link"+            url <- genUrl token tid+            lift $ sendLoginEmail email url+            lift $ redirect (emailSentRoute master)+++getLoginR :: NoPasswordAuth m => HandlerT Auth (HandlerT m IO) TypedContent+getLoginR = do+    paramName <- lift tokenParamName+    loginParam <- lookupGetParam paramName+    case (unpackTokenParam loginParam) of+        Nothing -> permissionDenied "Missing login token"+        Just (tid, loginToken) -> do+            muser <- lift $ getEmailAndHashByTokenId tid+            case muser of+                Nothing -> permissionDenied "No login token sent"+                Just (email, hash) ->+                    if (verifyToken hash loginToken)+                        then lift $ setCredsRedirect (Creds pluginName email [])+                        else permissionDenied "Incorrect login token"+++unpackTokenParam :: Maybe Text -> Maybe (TokenId, Token)+unpackTokenParam param = do+    p <- param+    case (splitOn ":" p) of+        (tid:tkn:[]) -> Just (tid, tkn)+        _ -> Nothing+++genToken :: Int -> IO (Hash, Token)+genToken strength = do+    tokenSalt <- genSaltIO+    let token = exportSalt tokenSalt+    hash <- makePassword token strength+    return (decodeUtf8 hash, decodeUtf8 (urlEncode False token))+++verifyToken :: Hash -> Token -> Bool+verifyToken hash token = verifyPassword t h+    where+        h = encodeUtf8 hash+        t = urlDecode False (encodeUtf8 token)+++genTokenId :: IO TokenId+genTokenId = U.toText <$> U.nextRandom+++genUrl :: NoPasswordAuth m => Token -> TokenId -> HandlerT Auth (HandlerT m IO) Text+genUrl token tid = do+    tm <- getRouteToParent+    render <- lift getUrlRender+    paramName <- lift tokenParamName+    let query = "?" <> paramName <> "=" <> tid <> ":" <> token+    return $ (render $ tm loginPostR) <> query+++class YesodAuthPersist master => NoPasswordAuth master where+    -- | Route to a page that dispays a login form. This is not provided by+    -- the plugin.+    loginRoute :: master -> Route master++    -- | Route to which the user should be sent after entering an email+    -- address. This is not provided by the plugin.+    --+    -- __Note__: the user will not be authenticated when they reach the page.+    emailSentRoute :: master -> Route master++    -- | Send a login email.+    sendLoginEmail :: Email -- ^ The email to send to+                   -> Text  -- ^ The URL that will log the user in+                   -> HandlerT master IO ()++    -- | Get a user by their email address. Used to determine if the user exists or not.+    getUserByEmail :: Email -> HandlerT master IO (Maybe (AuthId master))++    -- | Get a Hash by a TokenId.+    --+    -- Invoked when the user returns to the site from an email. We don't know+    -- who the user is at this point as they may open the link from the email+    -- on another device or in another browser, so session data can't be used.+    -- Equally we do not want to pass the user's ID or email address in a URL+    -- if we don't have to, so instead we look up users by the 'TokenId' that+    -- we issued them earlier in the process.+    getEmailAndHashByTokenId :: TokenId -> HandlerT master IO (Maybe (Email, Hash))++    -- | Update a user's login hash+    --+    -- This is also used to blank out the hash once the user has logged in, or+    -- can be used to prevent the user from logging in, so must accept a value+    -- of `Nothing`.+    --+    -- /It is recommended that the/ 'TokenId' /storage be enforced as unique/.+    -- For this reason, the token is not passed as a maybe, as some storage+    -- backends treat `NULL` values as the same.+    updateLoginHashForUser :: (AuthId master) -> Maybe Hash -> TokenId -> HandlerT master IO ()++    -- | Create a new user with an email address and hash.+    newUserWithLoginHash :: Email -> Hash -> TokenId -> HandlerT master IO ()++    -- | __Optional__ – return a custom token strength.+    --+    -- A token strength of @x@ equates to @2^x@ hash rounds.+    tokenStrength :: HandlerT master IO Int+    tokenStrength = return 17++    -- | __Optional__ – return a custom token param name.+    tokenParamName :: HandlerT master IO Text+    tokenParamName = return "tkn"++    {-+        MINIMAL loginRoute+              , emailSentRoute+              , sendLoginEmail+              , getUserByEmail+              , getEmailAndHashByTokenId+              , updateLoginHashForUser+              , newUserWithLoginHash+    -}

@@ -0,0 +1,33 @@+name:                yesod-auth-nopassword+version:             0.1.0.1+synopsis:            A plugin for Yesod to provide email-only authentication.+description:         Please see README.md+homepage:            https://github.com/danpalmer/yesod-auth-nopassword#readme+license:             MIT+license-file:        LICENSE+author:              Dan Palmer+maintainer:          dan@danpalmer.me+copyright:           2016 Dan Palmer+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Yesod.Auth.NoPassword+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+  build-depends:       base >= 4.7 && < 5+                     , text >= 0.11 && < 2.0+                     , blaze-markup >= 0.7 && < 1.0+                     , pwstore-fast >= 2.4 && < 3.0+                     , uuid >= 1.3 && < 1.4+                     , http-types >= 0.9 && < 1.0+                     , yesod-core >= 1.4.17 && < 1.5+                     , yesod-auth >= 1.4.0 && < 1.5+                     , yesod-form >= 1.4.0 && < 1.5++source-repository head+  type:     git+  location: https://github.com/danpalmer/yesod-auth-nopassword