version bump

Foundation.hs

@@ -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

eidolon.cabal

@@ -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)