diff --git a/src/Control/User.hs b/src/Control/User.hs index 711a5be..082971d 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -23,10 +23,12 @@ import Model userNew :: UserSubmit -> MateHandler Int -userNew us = do +userNew (UserSubmit ident email passhash) = do now <- liftIO $ getCurrentTime conn <- rsConnection <$> ask - insertUser us (utctDay now) conn + uid <- insertUser ident email (utctDay now) conn + void $ putUserAuthInfo uid PrimaryPass passhash conn + return uid userGet :: Maybe (Int, AuthMethod) diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index fe30428..bcab2d7 100644 --- a/src/Model/Auth.hs +++ b/src/Model/Auth.hs @@ -147,9 +147,23 @@ getUserAuthInfo uid method conn = do putUserAuthInfo :: Int -> AuthMethod + -> T.Text -> PGS.Connection -> 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 diff --git a/src/Model/User.hs b/src/Model/User.hs index 12e8032..bb84cb9 100644 --- a/src/Model/User.hs +++ b/src/Model/User.hs @@ -145,19 +145,20 @@ userBalanceSelect conn uid = do insertUser - :: UserSubmit + :: T.Text + -> Maybe T.Text -> Day -> PGS.Connection -> 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 , iRows = [ ( C.constant (Nothing :: Maybe Int) - , C.constant (userSubmitIdent us) + , C.constant ident , C.constant (0 :: Int) , C.constant now - , C.constant (userSubmitEmail us) + , C.constant email , C.constant (Nothing :: Maybe Int) ) ] diff --git a/src/Types/User.hs b/src/Types/User.hs index 3a4b57f..f1ed0b9 100644 --- a/src/Types/User.hs +++ b/src/Types/User.hs @@ -41,9 +41,9 @@ instance FromJSON UserSummary data UserSubmit = UserSubmit - { userSubmitIdent :: T.Text - , userSubmitEmail :: Maybe T.Text - --, userSubmitPin :: Maybe T.Text + { userSubmitIdent :: T.Text + , userSubmitEmail :: Maybe T.Text + , userSubmitPassHash :: T.Text } deriving (Generic, Show)