UI: Component: POST handlers for team add/approve/remove buttons

src/Vervis/Foundation.hs

@@ -942,6 +942,10 @@ instance YesodBreadcrumbs App where
 
         RepoTeamsR r -> ("Teams", Just $ RepoR r)
 
+        RepoAddTeamR r -> ("", Nothing)
+        RepoApproveTeamR r t -> ("", Nothing)
+        RepoRemoveTeamR r t -> ("", Nothing)
+
         DeckR d             -> ("Ticket Tracker =" <> keyHashidText d, Just HomeR)
         DeckInboxR d        -> ("Inbox", Just $ DeckR d)
         DeckOutboxR d       -> ("Outbox", Just $ DeckR d)
@@ -973,6 +977,10 @@ instance YesodBreadcrumbs App where
 
         DeckTeamsR d -> ("Teams", Just $ DeckR d)
 
+        DeckAddTeamR d -> ("", Nothing)
+        DeckApproveTeamR d t -> ("", Nothing)
+        DeckRemoveTeamR d t -> ("", Nothing)
+
         TicketR d t            -> ("#" <> keyHashidText t, Just $ DeckTicketsR d)
         TicketDiscussionR d t  -> ("Discussion", Just $ TicketR d t)
         TicketEventsR d t      -> ("Events", Just $ TicketR d t)
@@ -1010,6 +1018,10 @@ instance YesodBreadcrumbs App where
 
         LoomTeamsR l -> ("Teams", Just $ LoomR l)
 
+        LoomAddTeamR l -> ("", Nothing)
+        LoomApproveTeamR l t -> ("", Nothing)
+        LoomRemoveTeamR l t -> ("", Nothing)
+
         ClothR l c            -> ("#" <> keyHashidText c, Just $ LoomClothsR l)
         ClothDiscussionR l c  -> ("Discussion", Just $ ClothR l c)
         ClothEventsR l c      -> ("Events", Just $ ClothR l c)

src/Vervis/Handler/Deck.hs

@@ -49,6 +49,9 @@ module Vervis.Handler.Deck
 
     , getDeckTeamsR
 
+    , postDeckAddTeamR
+    , postDeckApproveTeamR
+    , postDeckRemoveTeamR
 
 
 
@@ -747,6 +750,142 @@ getDeckTeamsR deckHash = do
         komponentResource <$> getJust komponentID
     serveTeamsCollection (DeckR deckHash) (DeckTeamsR deckHash) resourceID
 
+addTeamForm = renderDivs $
+    areq fedUriField "(URI) Team" Nothing
+
+postDeckAddTeamR :: KeyHashid Deck -> Handler ()
+postDeckAddTeamR deckHash = do
+    deckID <- decodeKeyHashid404 deckHash
+    uTeam <-
+        runFormPostRedirect (DeckCollabsR deckHash) addTeamForm
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    let uCollection = encodeRouteHome $ DeckTeamsR deckHash
+
+    result <- runExceptT $ do
+        (maybeSummary, audience, add) <- C.add personID uTeam uCollection AP.RoleAdmin
+        cap <- do
+            maybeItem <- lift $ runDB $ do
+                resourceID <- deckResource <$> get404 deckID
+                getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Deck to add teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AddActivity add
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> setMessage $ toHtml e
+        Right inviteID -> setMessage "Add sent"
+    redirect $ DeckCollabsR deckHash
+
+postDeckApproveTeamR :: KeyHashid Deck -> SquadId -> Handler Html
+postDeckApproveTeamR deckHash squadID = do
+    deckID <- decodeKeyHashid404 deckHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            deck <- MaybeT $ get deckID
+            Squad _ resourceID <- MaybeT $ get squadID
+            guard $ resourceID == deckResource deck
+
+            uAdd <- lift $ do
+                add <- getSquadAdd squadID
+                renderActivityURI add
+
+            topic <- lift $ bimap snd snd <$> getSquadTeam squadID
+            lift $
+                (deckResource deck,uAdd,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, accept) <- do
+            uTeam <-
+                case pidOrU of
+                    Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g
+                    Right u -> pure u
+            let uDeck = encodeRouteHome $ DeckR deckHash
+            C.acceptParentChild personID uAdd uTeam uDeck
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Deck to approve teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AcceptActivity accept
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Accept sent"
+    redirect $ DeckCollabsR deckHash
+
+postDeckRemoveTeamR :: KeyHashid Deck -> SquadId -> Handler Html
+postDeckRemoveTeamR deckHash squadID = do
+    deckID <- decodeKeyHashid404 deckHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            deck <- MaybeT $ get deckID
+            Squad _ resourceID <- MaybeT $ get squadID
+            guard $ resourceID == deckResource deck
+            acceptID <- MaybeT $ getKeyBy $ UniqueSquadUsAccept squadID
+            _ <- MaybeT $ getBy $ UniqueSquadUsStart acceptID
+
+            uAdd <- lift $ do
+                add <- getSquadAdd squadID
+                renderActivityURI add
+
+            topic <- lift $ bimap snd snd <$> getSquadTeam squadID
+            lift $
+                (deckResource deck,uAdd,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, remove) <- do
+            uTeam <-
+                case pidOrU of
+                    Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g
+                    Right u -> pure u
+            let uCollection = encodeRouteHome $ DeckTeamsR deckHash
+            C.remove personID uTeam uCollection
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Deck to remove teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Remove sent"
+    redirect $ DeckCollabsR deckHash
+
 {-
 getProjectsR :: ShrIdent -> Handler Html
 getProjectsR ident = do

src/Vervis/Handler/Loom.hs

@@ -36,6 +36,10 @@ module Vervis.Handler.Loom
     , getLoomProjectsR
 
     , getLoomTeamsR
+
+    , postLoomAddTeamR
+    , postLoomApproveTeamR
+    , postLoomRemoveTeamR
     )
 where
 
@@ -43,6 +47,8 @@ import Control.Monad
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Data.Aeson
+import Data.Bifunctor
+import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Default.Class
 import Data.Foldable
@@ -82,6 +88,7 @@ import Yesod.Persist.Local
 
 import Vervis.Access
 import Vervis.API
+import Vervis.Data.Actor
 import Vervis.Federation.Auth
 import Vervis.Federation.Discussion
 import Vervis.Federation.Offer
@@ -397,3 +404,139 @@ getLoomTeamsR loomHash = do
         komponentID <- loomKomponent <$> get404 loomID
         komponentResource <$> getJust komponentID
     serveTeamsCollection (LoomR loomHash) (LoomTeamsR loomHash) resourceID
+
+addTeamForm = renderDivs $
+    areq fedUriField "(URI) Team" Nothing
+
+postLoomAddTeamR :: KeyHashid Loom -> Handler ()
+postLoomAddTeamR loomHash = do
+    loomID <- decodeKeyHashid404 loomHash
+    uTeam <-
+        runFormPostRedirect (LoomCollabsR loomHash) addTeamForm
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    let uCollection = encodeRouteHome $ LoomTeamsR loomHash
+
+    result <- runExceptT $ do
+        (maybeSummary, audience, add) <- C.add personID uTeam uCollection AP.RoleAdmin
+        cap <- do
+            maybeItem <- lift $ runDB $ do
+                resourceID <- loomResource <$> get404 loomID
+                getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Loom to add teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AddActivity add
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> setMessage $ toHtml e
+        Right inviteID -> setMessage "Add sent"
+    redirect $ LoomCollabsR loomHash
+
+postLoomApproveTeamR :: KeyHashid Loom -> SquadId -> Handler Html
+postLoomApproveTeamR loomHash squadID = do
+    loomID <- decodeKeyHashid404 loomHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            loom <- MaybeT $ get loomID
+            Squad _ resourceID <- MaybeT $ get squadID
+            guard $ resourceID == loomResource loom
+
+            uAdd <- lift $ do
+                add <- getSquadAdd squadID
+                renderActivityURI add
+
+            topic <- lift $ bimap snd snd <$> getSquadTeam squadID
+            lift $
+                (loomResource loom,uAdd,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, accept) <- do
+            uTeam <-
+                case pidOrU of
+                    Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g
+                    Right u -> pure u
+            let uLoom = encodeRouteHome $ LoomR loomHash
+            C.acceptParentChild personID uAdd uTeam uLoom
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Loom to approve teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AcceptActivity accept
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Accept sent"
+    redirect $ LoomCollabsR loomHash
+
+postLoomRemoveTeamR :: KeyHashid Loom -> SquadId -> Handler Html
+postLoomRemoveTeamR loomHash squadID = do
+    loomID <- decodeKeyHashid404 loomHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            loom <- MaybeT $ get loomID
+            Squad _ resourceID <- MaybeT $ get squadID
+            guard $ resourceID == loomResource loom
+            acceptID <- MaybeT $ getKeyBy $ UniqueSquadUsAccept squadID
+            _ <- MaybeT $ getBy $ UniqueSquadUsStart acceptID
+
+            uAdd <- lift $ do
+                add <- getSquadAdd squadID
+                renderActivityURI add
+
+            topic <- lift $ bimap snd snd <$> getSquadTeam squadID
+            lift $
+                (loomResource loom,uAdd,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, remove) <- do
+            uTeam <-
+                case pidOrU of
+                    Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g
+                    Right u -> pure u
+            let uCollection = encodeRouteHome $ LoomTeamsR loomHash
+            C.remove personID uTeam uCollection
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Loom to remove teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Remove sent"
+    redirect $ LoomCollabsR loomHash

src/Vervis/Handler/Repo.hs

@@ -54,6 +54,9 @@ module Vervis.Handler.Repo
 
     , getRepoTeamsR
 
+    , postRepoAddTeamR
+    , postRepoApproveTeamR
+    , postRepoRemoveTeamR
 
 
 
@@ -84,6 +87,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Data.Bifunctor
 import Data.Binary.Put
+import Data.Bitraversable
 import Data.ByteString (ByteString)
 import Data.Foldable
 import Data.Git.Graph
@@ -154,6 +158,7 @@ import Yesod.RenderSource
 
 import qualified Web.ActivityPub as AP
 
+import Control.Monad.Trans.Except.Local
 import Data.ByteString.Char8.Local (takeLine)
 import Data.Either.Local
 import Data.Git.Local
@@ -169,6 +174,7 @@ import qualified Darcs.Local.Repository as D (createRepo)
 import Vervis.Access
 import Vervis.ActivityPub
 import Vervis.API
+import Vervis.Data.Actor
 import Vervis.Federation.Auth
 import Vervis.Federation.Offer
 import Vervis.FedURI
@@ -821,6 +827,141 @@ getRepoTeamsR repoHash = do
         komponentResource <$> getJust komponentID
     serveTeamsCollection (RepoR repoHash) (RepoTeamsR repoHash) resourceID
 
+addTeamForm = renderDivs $
+    areq fedUriField "(URI) Team" Nothing
+
+postRepoAddTeamR :: KeyHashid Repo -> Handler ()
+postRepoAddTeamR repoHash = do
+    repoID <- decodeKeyHashid404 repoHash
+    uTeam <-
+        runFormPostRedirect (RepoCollabsR repoHash) addTeamForm
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    let uCollection = encodeRouteHome $ RepoTeamsR repoHash
+
+    result <- runExceptT $ do
+        (maybeSummary, audience, add) <- C.add personID uTeam uCollection AP.RoleAdmin
+        cap <- do
+            maybeItem <- lift $ runDB $ do
+                resourceID <- repoResource <$> get404 repoID
+                getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Repo to add teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AddActivity add
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> setMessage $ toHtml e
+        Right inviteID -> setMessage "Add sent"
+    redirect $ RepoCollabsR repoHash
+
+postRepoApproveTeamR :: KeyHashid Repo -> SquadId -> Handler Html
+postRepoApproveTeamR repoHash squadID = do
+    repoID <- decodeKeyHashid404 repoHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            repo <- MaybeT $ get repoID
+            Squad _ resourceID <- MaybeT $ get squadID
+            guard $ resourceID == repoResource repo
+
+            uAdd <- lift $ do
+                add <- getSquadAdd squadID
+                renderActivityURI add
+
+            topic <- lift $ bimap snd snd <$> getSquadTeam squadID
+            lift $
+                (repoResource repo,uAdd,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, accept) <- do
+            uTeam <-
+                case pidOrU of
+                    Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g
+                    Right u -> pure u
+            let uRepo = encodeRouteHome $ RepoR repoHash
+            C.acceptParentChild personID uAdd uTeam uRepo
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Repo to approve teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AcceptActivity accept
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Accept sent"
+    redirect $ RepoCollabsR repoHash
+
+postRepoRemoveTeamR :: KeyHashid Repo -> SquadId -> Handler Html
+postRepoRemoveTeamR repoHash squadID = do
+    repoID <- decodeKeyHashid404 repoHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+
+    result <- runExceptT $ do
+        mpidOrU <- lift $ runDB $ runMaybeT $ do
+            repo <- MaybeT $ get repoID
+            Squad _ resourceID <- MaybeT $ get squadID
+            guard $ resourceID == repoResource repo
+            acceptID <- MaybeT $ getKeyBy $ UniqueSquadUsAccept squadID
+            _ <- MaybeT $ getBy $ UniqueSquadUsStart acceptID
+
+            uAdd <- lift $ do
+                add <- getSquadAdd squadID
+                renderActivityURI add
+
+            topic <- lift $ bimap snd snd <$> getSquadTeam squadID
+            lift $
+                (repoResource repo,uAdd,) <$>
+                bitraverse
+                    pure
+                    (getRemoteActorURI <=< getJust)
+                    topic
+        (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU
+        (maybeSummary, audience, remove) <- do
+            uTeam <-
+                case pidOrU of
+                    Left g -> encodeRouteHome . GroupR <$> encodeKeyHashid g
+                    Right u -> pure u
+            let uCollection = encodeRouteHome $ RepoTeamsR repoHash
+            C.remove personID uTeam uCollection
+        cap <- do
+            maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin
+            fromMaybeE maybeItem "You need to be have Admin access to the Repo to remove teams"
+        uCap <- lift $ renderActivityURI cap
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
+        let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
+        handleViaActor
+            personID (Just cap') localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+        Right removeID ->
+            setMessage "Remove sent"
+    redirect $ RepoCollabsR repoHash
 
 
 

src/Vervis/Persist/Collab.hs

@@ -62,6 +62,9 @@ module Vervis.Persist.Collab
     , getStemDrafts
 
     , getResourceTeams
+
+    , getSquadAdd
+    , getSquadTeam
     )
 where
 
@@ -1412,3 +1415,53 @@ getResourceTeams resourceID =
                 , ra
                 , squad E.^. SquadId
                 )
+
+getSquadAdd
+    :: MonadIO m
+    => SquadId
+    -> ReaderT SqlBackend m
+        (Either
+            (LocalActorBy Key, OutboxItemId)
+            FedURI
+        )
+getSquadAdd squadID = do
+    usOrThem <-
+        requireEitherAlt
+            (getKeyBy $ UniqueSquadOriginUs squadID)
+            (getKeyBy $ UniqueSquadOriginThem squadID)
+            "Neither us nor them"
+            "Both us and them"
+    add <-
+        case usOrThem of
+            Left _usID ->
+                requireEitherAlt
+                    (fmap squadUsGestureLocalActivity <$> getValBy (UniqueSquadUsGestureLocal squadID))
+                    (fmap squadUsGestureRemoteActivity <$> getValBy (UniqueSquadUsGestureRemote squadID))
+                    "Neither local not remote"
+                    "Both local and remote"
+            Right themID ->
+                requireEitherAlt
+                    (fmap squadThemGestureLocalAdd <$> getValBy (UniqueSquadThemGestureLocal themID))
+                    (fmap squadThemGestureRemoteAdd <$> getValBy (UniqueSquadThemGestureRemote themID))
+                    "Neither local not remote"
+                    "Both local and remote"
+    getActivityIdent add
+
+getSquadTeam
+    :: MonadIO m
+    => SquadId
+    -> ReaderT SqlBackend m
+        (Either
+            (SquadTopicLocalId, GroupId)
+            (SquadTopicRemoteId, RemoteActorId)
+        )
+getSquadTeam squadID =
+    bimap
+        (\ (Entity k v) -> (k, squadTopicLocalGroup v))
+        (\ (Entity k v) -> (k, squadTopicRemoteTopic v))
+        <$>
+        requireEitherAlt
+            (getBy $ UniqueSquadTopicLocal squadID)
+            (getBy $ UniqueSquadTopicRemote squadID)
+            "Found Squad without topic"
+            "Found Squad with both local and remote topic"

th/routes

@@ -236,6 +236,10 @@
 
 /repos/#RepoKeyHashid/teams                       RepoTeamsR         GET
 
+/repos/#RepoKeyHashid/add-team              RepoAddTeamR     POST
+/repos/#RepoKeyHashid/approve-team/#SquadId RepoApproveTeamR POST
+/repos/#RepoKeyHashid/remove-team/#SquadId  RepoRemoveTeamR  POST
+
 ---- Deck --------------------------------------------------------------------
 
 /decks/#DeckKeyHashid                             DeckR           GET
@@ -270,6 +274,10 @@
 
 /decks/#DeckKeyHashid/teams                       DeckTeamsR      GET
 
+/decks/#DeckKeyHashid/add-team              DeckAddTeamR     POST
+/decks/#DeckKeyHashid/approve-team/#SquadId DeckApproveTeamR POST
+/decks/#DeckKeyHashid/remove-team/#SquadId  DeckRemoveTeamR  POST
+
 ---- Ticket ------------------------------------------------------------------
 
 /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid            TicketR            GET
@@ -325,6 +333,10 @@
 
 /looms/#LoomKeyHashid/teams                       LoomTeamsR      GET
 
+/looms/#LoomKeyHashid/add-team              LoomAddTeamR     POST
+/looms/#LoomKeyHashid/approve-team/#SquadId LoomApproveTeamR POST
+/looms/#LoomKeyHashid/remove-team/#SquadId  LoomRemoveTeamR  POST
+
 ---- Cloth -------------------------------------------------------------------
 
 /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid            ClothR            GET