Prevent non-admins from creating Manager or Admin accounts

Client-side, I'm not exposing the role option to users. Server-side, I'm
asserting that requests to create Manager and Admin accounts are attempted by
users with a session tied to an admin account.
This commit is contained in:
William Carroll 2020-08-01 11:48:55 +01:00
parent a3732300e1
commit 83f4f8e9d6
2 changed files with 29 additions and 14 deletions

View file

@ -16,6 +16,7 @@ type SessionCookie = Header' '[Required] "Cookie" T.SessionCookie
type API = type API =
-- accounts: Create -- accounts: Create
"accounts" "accounts"
:> Header "Cookie" T.SessionCookie
:> ReqBody '[JSON] T.CreateAccountRequest :> ReqBody '[JSON] T.CreateAccountRequest
:> Post '[JSON] NoContent :> Post '[JSON] NoContent
:<|> "verify" :<|> "verify"

View file

@ -77,20 +77,34 @@ server config@T.Config{..} = createAccount
adminsOnly cookie = adminsAnd cookie (const True) adminsOnly cookie = adminsAnd cookie (const True)
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
createAccount :: T.CreateAccountRequest -> Handler NoContent createAccount :: Maybe T.SessionCookie
createAccount T.CreateAccountRequest{..} = do -> T.CreateAccountRequest
secretUUID <- liftIO $ T.RegistrationSecret <$> Random.randomIO -> Handler NoContent
liftIO $ PendingAccounts.create dbFile createAccount mCookie T.CreateAccountRequest{..} =
secretUUID case (mCookie, createAccountRequestRole) of
createAccountRequestUsername (_, T.RegularUser) ->
createAccountRequestPassword doCreateAccount
createAccountRequestRole (Nothing, T.Manager) ->
createAccountRequestEmail throwError err401 { errBody = "Only admins can create Manager accounts" }
liftIO $ sendVerifyEmail config mailgunAPIKey (Nothing, T.Admin) ->
createAccountRequestUsername throwError err401 { errBody = "Only admins can create Admin accounts" }
createAccountRequestEmail (Just cookie, _) ->
secretUUID adminsOnly cookie doCreateAccount
pure NoContent where
doCreateAccount :: Handler NoContent
doCreateAccount = do
secretUUID <- liftIO $ T.RegistrationSecret <$> Random.randomIO
liftIO $ PendingAccounts.create dbFile
secretUUID
createAccountRequestUsername
createAccountRequestPassword
createAccountRequestRole
createAccountRequestEmail
liftIO $ sendVerifyEmail config mailgunAPIKey
createAccountRequestUsername
createAccountRequestEmail
secretUUID
pure NoContent
verifyAccount :: Text -> Text -> Handler NoContent verifyAccount :: Text -> Text -> Handler NoContent
verifyAccount username secret = do verifyAccount username secret = do