Commit 0c476c68 authored by Nicolas Lenz's avatar Nicolas Lenz

User management

parent 3564afff
......@@ -6,3 +6,6 @@
/add AddR POST
/log LogR GET
/user/#Text UserR PUT DELETE
/user UsersR GET
......@@ -41,7 +41,8 @@ addUser :: MonadIO m => Text -> Text -> ReaderT SqlBackend m ()
addUser name pass = do
salt <- liftIO generateSalt
let hashed = Auth.hash salt (encodeUtf8 pass)
insert_ $ User name salt hashed
_ <- upsert (User name salt hashed) [UserPasshash =. hashed, UserSalt =. salt]
return ()
-- | Checks a name with the database.
checkCredentials :: Text -> ByteString -> ReaderT SqlBackend IO Bool
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Handler.Misc where
import Import
import Auth
postAddR :: Handler Value
postAddR = do
......@@ -22,3 +24,24 @@ getLogR :: Handler Value
getLogR = do
results <- runDB $ selectList [] []
returnJson (entityVal <$> (results :: [Entity Log]))
getUsersR :: Handler Value
getUsersR = do
users <- runDB $ selectList [] []
returnJson $ userName . entityVal <$> (users :: [Entity User])
newtype Password = Password {
password :: Text
} deriving (Show, Generic)
instance FromJSON Password
putUserR :: Text -> Handler ()
putUserR username = do
password' <- requireCheckJsonBody :: Handler Password
runDB $ Auth.addUser username (password password')
deleteUserR :: Text -> Handler ()
deleteUserR username = runDB $ deleteBy (UniqueUser username)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment