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.

2 files changed, 29 insertions, 14 deletions

diff --git a/src/API.hs b/src/API.hs
index 461c851126a4..956e745b30fd 100644
--- a/src/API.hs
+++ b/src/API.hs
@@ -16,6 +16,7 @@ type SessionCookie = Header' '[Required] "Cookie" T.SessionCookie
 type API =
       -- accounts: Create
            "accounts"
+           :> Header "Cookie" T.SessionCookie
            :> ReqBody '[JSON] T.CreateAccountRequest
            :> Post '[JSON] NoContent
       :<|> "verify"
diff --git a/src/App.hs b/src/App.hs
index abd1bfba96bd..6f52dabccc22 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -77,20 +77,34 @@ server config@T.Config{..} = createAccount
     adminsOnly cookie = adminsAnd cookie (const True)
 
     -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
-    createAccount :: T.CreateAccountRequest -> Handler NoContent
-    createAccount T.CreateAccountRequest{..} = 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
+    createAccount :: Maybe T.SessionCookie
+                  -> T.CreateAccountRequest
+                  -> Handler NoContent
+    createAccount mCookie T.CreateAccountRequest{..} =
+      case (mCookie, createAccountRequestRole) of
+        (_, T.RegularUser) ->
+          doCreateAccount
+        (Nothing, T.Manager) ->
+          throwError err401 { errBody = "Only admins can create Manager accounts" }
+        (Nothing, T.Admin) ->
+          throwError err401 { errBody = "Only admins can create Admin accounts" }
+        (Just cookie, _) ->
+          adminsOnly cookie doCreateAccount
+      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 username secret = do