diff --git a/src/Share/Web/Admin/API.hs b/src/Share/Web/Admin/API.hs index 06da5ab0..196fef12 100644 --- a/src/Share/Web/Admin/API.hs +++ b/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 diff --git a/src/Share/Web/Admin/Impl.hs b/src/Share/Web/Admin/Impl.hs index f465814b..51a87acc 100644 --- a/src/Share/Web/Admin/Impl.hs +++ b/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,6 +71,13 @@ 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 @@ -76,6 +85,7 @@ server authedSession = 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. diff --git a/src/Share/Web/Admin/Types.hs b/src/Share/Web/Admin/Types.hs index 738964ff..b3606d1d 100644 --- a/src/Share/Web/Admin/Types.hs +++ b/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 + ]