create user's AuthData on user creation

This commit is contained in:
nek0 2019-09-15 16:11:56 +02:00
parent ffb559cb36
commit ac6034761d
4 changed files with 27 additions and 10 deletions

View file

@ -23,10 +23,12 @@ import Model
userNew userNew
:: UserSubmit :: UserSubmit
-> MateHandler Int -> MateHandler Int
userNew us = do userNew (UserSubmit ident email passhash) = do
now <- liftIO $ getCurrentTime now <- liftIO $ getCurrentTime
conn <- rsConnection <$> ask conn <- rsConnection <$> ask
insertUser us (utctDay now) conn uid <- insertUser ident email (utctDay now) conn
void $ putUserAuthInfo uid PrimaryPass passhash conn
return uid
userGet userGet
:: Maybe (Int, AuthMethod) :: Maybe (Int, AuthMethod)

View file

@ -147,9 +147,23 @@ getUserAuthInfo uid method conn = do
putUserAuthInfo putUserAuthInfo
:: Int :: Int
-> AuthMethod -> AuthMethod
-> T.Text
-> PGS.Connection -> PGS.Connection
-> MateHandler Int -> MateHandler Int
putUserAuthInfo uid method conn = error "Not yet implemented: putUserAuthInfo" putUserAuthInfo uid method payload conn =
fmap head $ liftIO $ runInsert_ conn $ Insert
{ iTable = authDataTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant uid
, C.constant (fromEnum method)
, C.constant payload
)
]
, iReturning = rReturning (\(adid, _, _, _) -> adid)
, iOnConflict = Nothing
}
validateToken validateToken

View file

@ -145,19 +145,20 @@ userBalanceSelect conn uid = do
insertUser insertUser
:: UserSubmit :: T.Text
-> Maybe T.Text
-> Day -> Day
-> PGS.Connection -> PGS.Connection
-> MateHandler Int -> MateHandler Int
insertUser us now conn = fmap head $ liftIO $ runInsert_ conn $ Insert insertUser ident email now conn = fmap head $ liftIO $ runInsert_ conn $ Insert
{ iTable = userTable { iTable = userTable
, iRows = , iRows =
[ [
( C.constant (Nothing :: Maybe Int) ( C.constant (Nothing :: Maybe Int)
, C.constant (userSubmitIdent us) , C.constant ident
, C.constant (0 :: Int) , C.constant (0 :: Int)
, C.constant now , C.constant now
, C.constant (userSubmitEmail us) , C.constant email
, C.constant (Nothing :: Maybe Int) , C.constant (Nothing :: Maybe Int)
) )
] ]

View file

@ -41,9 +41,9 @@ instance FromJSON UserSummary
data UserSubmit = UserSubmit data UserSubmit = UserSubmit
{ userSubmitIdent :: T.Text { userSubmitIdent :: T.Text
, userSubmitEmail :: Maybe T.Text , userSubmitEmail :: Maybe T.Text
--, userSubmitPin :: Maybe T.Text , userSubmitPassHash :: T.Text
} }
deriving (Generic, Show) deriving (Generic, Show)