eidolon/Handler/Activate.hs

--  eidolon -- A simple gallery in Haskell and Yesod
--  Copyright (C) 2015  Amedeo Molnár
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU Affero General Public License as published
--  by the Free Software Foundation, either version 3 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU Affero General Public License for more details.
--
--  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/>.
module Handler.Activate where

-- import Import as I hiding (returnJson)
-- import Data.Text
-- import Data.Text.Encoding
-- import Data.Maybe
-- import System.Directory
-- import System.FilePath
-- 
-- import qualified Data.ByteString.Char8 as BC
-- 
-- import Handler.Login
-- 
-- -- getActivateR :: Text -> Handler Html
-- getActivateR token = do
--   t <- runDB $ getBy $ UniqueToken token
--   case t of
--     Nothing -> do
--       setMessage "Invalid token!"
--       redirect HomeR
--     Just (Entity tId token) -> do
--       master <- getYesod
--       (Entity uId user) <-
--         runDB $ getJust <$> getBy $ UniqueUser $ tokenUsername token
--       let hexSalt = toHex $ userSalt user
--           addWarn = "http://" `isPrefixOf` appRoot (appSettings master)
--       defaultLayout $ do
--         setTitle "Activate your account"
--         $(widgetFile "activate")
-- 
--   t <- runDB $ selectFirst [ActivatorToken ==. token] []
--   (activateRawWidget, _) <- generateFormPost $
--     renderBootstrap3 BootstrapBasicForm activateForm
--   case t of
--     Nothing -> do
--       mToken <- runDB $ selectFirst [TokenToken ==. encodeUtf8 token, TokenKind ==. "activate"] []
--       case mToken of
--         Just (Entity _ uToken) -> do
--           user <- runDB $ getBy $ UniqueUser $ tokenUsername uToken
--           let hexSalt = toHex $ userSalt user
--           master <- getYesod
--           let addWarn = "http://" `isPrefixOf` appRoot (appSettings master)
--           defaultLayout $ do
--             setTitle "Activate your account"
--             $(widgetFile "activate")
--         _ -> do
--           setMessage "Invalid token!"
--           redirect HomeR
--     Just (Entity _ activator) -> do
--       let uSalt = userSalt $ activatorUser activator
--       mToken <- runDB $ selectFirst [TokenToken ==. encodeUtf8 token, TokenKind ==. "activate"] []
--       case mToken of
--         Just (Entity _ _) -> do
--           let hexSalt = toHex uSalt
--           master <- getYesod
--           let addWarn = "http://" `isPrefixOf` appRoot (appSettings master)
--           defaultLayout $
--             $(widgetFile "activate")
--         _ -> do
--           setMessage "Invalid token!"
--           redirect HomeR
-- 
-- postActivateR :: Text -> Handler RepJson
-- postActivateR token = do
--   msalted <- fromJust <$> lookupPostParam "salted"
--   let salted = fromHex' $ unpack msalted
--   mToken <- runDB $ selectFirst [TokenToken ==. encodeUtf8 token, TokenKind ==. "activate"] []
--   case mToken of
--     Just (Entity uTokenId uToken) ->
--       if
--         isNothing (tokenUser uToken)
--         then do
--           newUser <- runDB $ selectFirst [ActivatorToken ==. token] []
--           case newUser of
--             Just (Entity aId activ) -> do
--               namesakes <- runDB $ selectList [UserName ==. userName (activatorUser activ)] []
--               if
--                 I.null namesakes
--                 then do
--                   -- putting user in active state
--                   uId <- runDB $ insert $ activatorUser activ
--                   runDB $ update uId [UserSalted =. salted]
--                   -- create user directory
--                   liftIO $ createDirectoryIfMissing True $
--                     "static" </> "data" </> unpack (extractKey uId)
--                   -- cleanup
--                   runDB $ delete aId
--                   runDB $ delete uTokenId
--                   -- login and redirect
--                   setSession "userId" (extractKey uId)
--                   welcomeLink <- ($ ProfileR uId) <$> getUrlRender
--                   returnJson ["welcome" .= welcomeLink]
--                 else do
--                   -- cleanup
--                   runDB $ delete aId
--                   runDB $ delete uTokenId
--                   returnJsonError ("Somebody already activated your username. Your token has been deleted" :: String)
--             Nothing ->
--               returnJsonError ("Invalid token" :: String)
--         else do
--           runDB $ update (fromJust $ tokenUser uToken) [UserSalted =. salted]
--           -- cleanup
--           runDB $ delete uTokenId
--           setSession "userId" (extractKey $ fromJust $ tokenUser uToken)
--           welcomeLink <- ($ ProfileR (fromJust $ tokenUser uToken)) <$> getUrlRender
--           returnJson ["welcome" .= welcomeLink]
--     _ ->
--       returnJsonError ("Invalid activation token!" :: String)
-- 
-- data ActivateFormRes = ActivateFormRes
--   { pass1 :: Text
--   , pass2 :: Text
--   }
-- 
-- activateForm :: AForm Handler ActivateFormRes
-- activateForm = ActivateFormRes
--   <$> areq passwordField (bfs ("Password" :: Text)) Nothing
--   <*> areq passwordField (bfs ("Repeat Password" :: Text)) Nothing
--   <*  bootstrapSubmit ("Activate" :: BootstrapSubmit Text)
-- 
-- postActivateRawR :: Text -> Handler Html
-- postActivateRawR token = do
--   ((res, _), _) <- runFormPost $
--     renderBootstrap3 BootstrapBasicForm activateForm
--   case res of
--     FormSuccess pwd -> do
--       if pass1 pwd == pass2 pwd
--       then do
--         mToken <- runDB $ selectFirst [TokenToken ==. encodeUtf8 token, TokenKind ==. "activate"] []
--         case mToken of
--           Just (Entity uTokenId uToken) ->
--             if
--               isNothing (tokenUser uToken)
--               then do
--                 newUser <- runDB $ selectFirst [ActivatorToken ==. token] []
--                 case newUser of
--                   Just (Entity aId activ) -> do
--                     namesakes <- runDB $ selectList [UserName ==. userName (activatorUser activ)] []
--                     if
--                       I.null namesakes
--                       then do
--                         let salted = fromHex' $ BC.unpack $ hmacKeccak (userSalt $ activatorUser activ) (encodeUtf8 $ pass1 pwd)
--                         -- putting user in active state
--                         uId <- runDB $ insert $ activatorUser activ
--                         runDB $ update uId [UserSalted =. salted]
--                         -- create user directory
--                         liftIO $ createDirectoryIfMissing True $
--                           "static" </> "data" </> unpack (extractKey uId)
--                         -- cleanup
--                         runDB $ delete aId
--                         runDB $ delete uTokenId
--                         -- login and redirect
--                         setSession "userId" (extractKey uId)
--                         setMessage "Successfully activated"
--                         redirect $ ProfileR uId
--                       else do
--                         -- cleanup
--                         runDB $ delete aId
--                         runDB $ delete uTokenId
--                         setMessage "Somebody already activated your username. Your token has been deleted"
--                         redirect HomeR
--                   Nothing -> do
--                     setMessage "Invalid token"
--                     redirect HomeR
--               else do
--                 uuser <- runDB $ getJust $ fromJust $ tokenUser uToken
--                 let salted = fromHex' $ BC.unpack $ hmacKeccak (userSalt uuser) (encodeUtf8 $ pass1 pwd)
--                 runDB $ update (fromJust $ tokenUser uToken) [UserSalted =. salted]
--                 -- cleanup
--                 runDB $ delete uTokenId
--                 setSession "userId" (extractKey $ fromJust $ tokenUser uToken)
--                 setMessage "Successfully activated"
--                 redirect $ ProfileR (fromJust $ tokenUser uToken)
--           Nothing -> do
--             setMessage "Invalid activation token!"
--             redirect HomeR
--       else do
--         setMessage "Passwords must match!"
--         redirect $ ActivateR token
--     _ -> do
--       setMessage "Activation error"
--       redirect HomeR

-- returnJson :: (Monad m, a ~ Value) =>
--               [(Text, a)] -> m RepJson
-- returnJson = return . repJson . object

-- returnJsonError :: Text -> Handler RepJson
-- returnJsonError = returnJson . (:[]) . ("error" .=)