version bump

This commit is contained in:
nek0 2017-12-24 07:57:23 +01:00
parent 6e0ab2bbbb
commit 7f0c582450
2 changed files with 74 additions and 3 deletions

View File

@ -14,7 +14,7 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleInstances, PackageImports #-}
module Foundation where
@ -39,6 +39,9 @@ import Network.Wai
import Helper hiding (hmacKeccak)
import Yesod.Auth
import Yesod.Auth.HmacKeccak
import "yesod-auth-hmac-keccak" Yesod.Auth.Types (gimmeFile)
import "yesod-auth-hmac-keccak" Yesod.Auth.Message as Auth
import Yesod.Form.Bootstrap3
import System.IO.Unsafe (unsafePerformIO)
-- | The site argument for your application. This can be a good place to
@ -273,6 +276,74 @@ instance RenderMessage App FormMessage where
instance YesodHmacKeccak (HmacPersistDB App User Token) App where
runHmacDB = runHmacPersistDB
rawLoginRoute = Just LoginRawR
getNewAccountR = do
master <- lift $ getYesod
if not (appSignupBlocked $ appSettings master)
then do
tm <- getRouteToParent
lift $ defaultLayout $ do
((_, widget), enctype) <- liftHandlerT $ runFormPost $
renderBootstrap3 BootstrapBasicForm $ eidolonAccountForm
(appTos1 $ appSettings master)
(appTos2 $ appSettings master)
render <- getUrlRenderParams
toWidgetHead $ gimmeFile render
setTitleI MsgRegisterLong
[whamlet|
<div .newaccount>
<form method="post" enctype=#{enctype} action=@{tm newAccountR}>
^{widget}
|]
else do
setMessage "User signup has been disabled"
redirect LoginR
postNewAccountR = do
master <- lift $ getYesod
if not (appSignupBlocked $ appSettings master)
then do
tm <- getRouteToParent
((result, _), _) <- lift $ runFormPost $
renderBootstrap3 BootstrapBasicForm $ eidolonAccountForm
(appTos1 $ appSettings master)
(appTos2 $ appSettings master)
case result of
FormMissing -> invalidArgs ["Form is missing"]
FormFailure m -> do
lift $ setMessage $ toHtml $ T.concat m
redirect newAccountR
FormSuccess d -> do
case (eadTos1 d, eadTos2 d) of
(Just True, Just True) -> do
lift $ setMessageI MsgActivationSent
lift $ createNewAccount
(NewAccountData (eadUsername d) (eadEmail d))
tm
redirect LoginR
_ -> do
lift $ setMessage "Please Accept the Terms of Service"
redirect newAccountR
else do
lift $ setMessage "User signup has been disabled"
redirect LoginR
data EidolonAccountData = EidolonAccountData
{ eadUsername :: T.Text
, eadEmail :: T.Text
, eadTos1 :: Maybe Bool
, eadTos2 :: Maybe Bool
}
eidolonAccountForm tos1 tos2= EidolonAccountData
<$> areq (checkM checkValidUsername textField) userSettings Nothing
<*> areq emailField emailSettings Nothing
<*> aopt checkBoxField (tosSettings tos1) Nothing
<*> aopt checkBoxField (tosSettings tos2) Nothing
<* bootstrapSubmit ("Sign up" :: BootstrapSubmit T.Text)
where
userSettings = bfs (SomeMessage MsgUsername)
emailSettings = bfs (SomeMessage MsgEmail)
tosSettings t = bfs (SomeMessage t)
instance UserCredentials (Entity User) where
userUserName = userName . entityVal

View File

@ -1,5 +1,5 @@
name: eidolon
version: 0.1.11.9
version: 0.1.11.10
synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu
license: AGPL-3
@ -148,7 +148,7 @@ library
, texmath
, fuzzy
, yesod-auth
, yesod-auth-hmac-keccak
, yesod-auth-hmac-keccak >= 0.0.0.4
executable eidolon
if flag(library-only)