Add admin endpoint for creating orgs

src/Share/Web/Admin/API.hs

@@ -5,10 +5,10 @@
 
 module Share.Web.Admin.API where
 
+import Servant
 import Share.IDs
 import Share.OAuth.Session
 import Share.Web.Admin.Types
-import Servant
 
 type API =
   AuthenticatedSession :> UnauthenticatedAPI
@@ -21,6 +21,7 @@ type UnauthenticatedAPI =
              :> ( ("delete-user" :> DeleteUserEndpoint)
                 )
          )
+    :<|> ("orgs" :> "create" :> AdminCreateOrgEndpoint)
 
 type CreateMissingLooseCodeMappingsEndpoint =
   Post '[JSON] ()
@@ -54,3 +55,7 @@ type AddCloudUserEndpoint =
 type RemoveCloudUserEndpoint =
   ReqBody '[JSON] RemoveCloudUserRequest
     :> Delete '[JSON] ()
+
+type AdminCreateOrgEndpoint =
+  ReqBody '[JSON] AdminCreateOrgRequest
+    :> Post '[JSON] AdminCreateOrgResponse

src/Share/Web/Admin/Impl.hs

@@ -8,6 +8,7 @@ module Share.Web.Admin.Impl where
 
 import Data.Either (partitionEithers)
 import Data.Time qualified as Time
+import Servant
 import Share.IDs
 import Share.Postgres qualified as PG
 import Share.Postgres.Admin qualified as Admin
@@ -20,7 +21,8 @@ import Share.Web.Admin.Types
 import Share.Web.App
 import Share.Web.Authorization qualified as AuthZ
 import Share.Web.Errors
-import Servant
+import Share.Web.Share.Orgs.Operations qualified as OrgOps
+import Share.Web.Share.Orgs.Queries qualified as OrgQ
 import Unison.Util.Monoid qualified as Monoid
 
 -- | Ensure we have name lookups for views for this user.
@@ -69,13 +71,21 @@ removeFromCatalogCategoryEndpoint !_authzReceipt removals = do
     respondError (EntityMissing (ErrorID "catalog-categories:missing") msg)
   pure NoContent
 
+createOrgEndpoint :: AuthZ.AuthZReceipt -> AdminCreateOrgRequest -> WebApp AdminCreateOrgResponse
+createOrgEndpoint !authZReceipt AdminCreateOrgRequest {orgName, orgHandle, orgEmail, orgAvatarUrl, orgOwner, isCommercial} = do
+  User {user_id = ownerUserId} <- PGO.expectUserByHandle orgOwner
+  PG.runTransactionOrRespondError $ do
+    orgId <- OrgOps.createOrg authZReceipt orgName orgHandle orgEmail orgAvatarUrl ownerUserId ownerUserId isCommercial
+    AdminCreateOrgResponse <$> OrgQ.orgDisplayInfoOf id orgId
+
 server :: ServerT Admin.API WebApp
 server authedSession =
   let catalogServer authzReceipt = addToCatalogCategoryEndpoint authzReceipt :<|> removeFromCatalogCategoryEndpoint authzReceipt
    in hoistServer (Proxy @Admin.UnauthenticatedAPI) requireAdmin $
         catalogServer authzReceipt
           :<|> ( \userHandle -> deleteUserEndpoint authzReceipt userHandle
                )
+          :<|> createOrgEndpoint authzReceipt
   where
     -- Require that the user has re-authenticated within the last 2 hours in order to
     -- perform admin actions.

src/Share/Web/Admin/Types.hs

@@ -4,8 +4,11 @@
 module Share.Web.Admin.Types where
 
 import Data.Aeson
+import Data.Text (Text)
 import Data.Time (Day)
 import Share.IDs
+import Share.Utils.URI
+import Share.Web.Share.DisplayInfo.Types (OrgDisplayInfo)
 
 data ProjectCategory = ProjectCategory
   { categoryName :: CategoryName,
@@ -46,3 +49,50 @@ data DeleteUserRequest = DeleteUserRequest
 instance FromJSON DeleteUserRequest where
   parseJSON = withObject "DeleteUserRequest" $ \o ->
     DeleteUserRequest <$> o .: "currentDate"
+
+data AdminCreateOrgRequest = AdminCreateOrgRequest
+  { orgName :: Text,
+    orgHandle :: OrgHandle,
+    orgEmail :: Maybe Email,
+    orgAvatarUrl :: Maybe URIParam,
+    orgOwner :: UserHandle,
+    isCommercial :: Bool
+  }
+  deriving (Show)
+
+instance FromJSON AdminCreateOrgRequest where
+  parseJSON = withObject "AdminCreateOrgRequest" $ \o -> do
+    orgName <- o .: "name"
+    orgHandle <- o .: "handle"
+    orgEmail <- o .:? "email"
+    orgAvatarUrl <- o .:? "avatarUrl"
+    orgOwner <- o .: "owner"
+    isCommercial <- o .:? "isCommercial" .!= False
+    pure AdminCreateOrgRequest {..}
+
+instance ToJSON AdminCreateOrgRequest where
+  toJSON AdminCreateOrgRequest {..} =
+    object
+      [ "name" .= orgName,
+        "handle" .= orgHandle,
+        "email" .= orgEmail,
+        "avatarUrl" .= orgAvatarUrl,
+        "owner" .= orgOwner,
+        "isCommercial" .= isCommercial
+      ]
+
+data AdminCreateOrgResponse = AdminCreateOrgResponse
+  { org :: OrgDisplayInfo
+  }
+  deriving (Show)
+
+instance FromJSON AdminCreateOrgResponse where
+  parseJSON = withObject "AdminCreateOrgResponse" $ \o -> do
+    org <- o .: "org"
+    pure AdminCreateOrgResponse {..}
+
+instance ToJSON AdminCreateOrgResponse where
+  toJSON AdminCreateOrgResponse {..} =
+    object
+      [ "org" .= org
+      ]