Switch actor ID URIs to be /s/ACTOR instead of /p and /g

See Vervis ticket #60.

config/routes

@@ -51,14 +51,10 @@
 /s                                           SharersR             GET
 /s/#ShrIdent                                 SharerR              GET
 
-/p                                           PeopleR              GET POST
+/p                                           PeopleR              GET
-/p/!new                                      PersonNewR           GET
-/p/#ShrIdent                                 PersonR              GET POST
-/p/#ShrIdent/activities                      PersonActivitiesR    GET
 
 /g                                           GroupsR              GET POST
 /g/!new                                      GroupNewR            GET
-/g/#ShrIdent                                 GroupR               GET
 /g/#ShrIdent/m                               GroupMembersR        GET POST
 /g/#ShrIdent/m/!new                          GroupMemberNewR      GET
 /g/#ShrIdent/m/#ShrIdent                     GroupMemberR         GET DELETE POST

src/Vervis/ActivityStreams.hs

@@ -217,8 +217,8 @@ provideAS2 as2 = do
 
 makeActor ur shr =
     Actor
-        { actorId     = ur $ PersonR shr
+        { actorId     = ur $ SharerR shr
         , actorType   = "Person"
-        , actorInbox  = ur $ PersonR shr
+        , actorInbox  = ur $ SharerR shr
-        , actorOutbox = ur $ PersonActivitiesR shr
+        , actorOutbox = ur $ error "We don't have outboxes yet"
         }

src/Vervis/Foundation.hs

@@ -719,14 +719,10 @@ instance YesodBreadcrumbs App where
         SharerR shar                     -> (shr2text shar, Just SharersR)
 
         PeopleR                          -> ("People", Just HomeR)
-        PersonNewR                       -> ("New", Just PeopleR)
-        PersonR shar                     -> (shr2text shar, Just PeopleR)
-        PersonActivitiesR shr            -> ("Activities", Just $ PersonR shr)
 
         GroupsR                          -> ("Groups", Just HomeR)
         GroupNewR                        -> ("New", Just GroupsR)
-        GroupR shar                      -> (shr2text shar, Just GroupsR)
+        GroupMembersR shar               -> ("Members", Just $ SharerR shar)
-        GroupMembersR shar               -> ("Members", Just $ GroupR shar)
         GroupMemberNewR shar             -> ("New", Just $ GroupMembersR shar)
         GroupMemberR grp memb            -> ( shr2text memb
                                             , Just $ GroupMembersR grp
@@ -754,7 +750,7 @@ instance YesodBreadcrumbs App where
                                             , Just $ ProjectRoleOpsR shr rl
                                             )
 
-        ReposR shar                      -> ("Repos", Just $ PersonR shar)
+        ReposR shar                      -> ("Repos", Just $ SharerR shar)
         RepoNewR shar                    -> ("New", Just $ ReposR shar)
         RepoR shar repo                  -> (rp2text repo, Just $ ReposR shar)
         RepoEditR shr rp                 -> ("Edit", Just $ RepoR shr rp)
@@ -784,7 +780,7 @@ instance YesodBreadcrumbs App where
         GitRefDiscoverR _ _              -> ("", Nothing)
         GitUploadRequestR _ _            -> ("", Nothing)
 
-        ProjectsR shar                   -> ("Projects", Just $ PersonR shar)
+        ProjectsR shar                   -> ("Projects", Just $ SharerR shar)
         ProjectNewR shar                 -> ("New", Just $ ProjectsR shar)
         ProjectR shar proj               -> ( prj2text proj
                                             , Just $ ProjectsR shar

src/Vervis/Handler/Group.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -17,7 +17,7 @@ module Vervis.Handler.Group
     ( getGroupsR
     , postGroupsR
     , getGroupNewR
-    , getGroupR
+    , getGroup
     , getGroupMembersR
     , postGroupMembersR
     , getGroupMemberNewR
@@ -37,7 +37,8 @@ import Database.Persist
 import Text.Blaze.Html (Html)
 import Yesod.Auth (requireAuthId)
 import Yesod.Core (defaultLayout, setMessage)
-import Yesod.Core.Handler (redirect, lookupPostParam, notFound)
+import Yesod.Core.Content (TypedContent)
+import Yesod.Core.Handler
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
 import Yesod.Persist.Core (runDB, getBy404)
@@ -86,7 +87,7 @@ postGroupsR = do
                         , groupMemberJoined = now
                         }
                 insert_ member
-            redirect $ GroupR $ ngIdent ng
+            redirect $ SharerR $ ngIdent ng
         FormMissing -> do
             setMessage "Field(s) missing"
             defaultLayout $(widgetFile "group/new")
@@ -99,12 +100,8 @@ getGroupNewR = do
     ((_result, widget), enctype) <- runFormPost newGroupForm
     defaultLayout $(widgetFile "group/new")
 
-getGroupR :: ShrIdent -> Handler Html
+getGroup :: ShrIdent -> Group -> Handler TypedContent
-getGroupR shar = do
+getGroup shar group = selectRep $ provideRep $
-    group <- runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharer shar
-        Entity _gid g <- getBy404 $ UniqueGroup sid
-        return g
     defaultLayout $(widgetFile "group/one")
 
 getGroupMembersR :: ShrIdent -> Handler Html

src/Vervis/Handler/Inbox.hs

@@ -232,8 +232,8 @@ postOutboxR = do
                 return $ sharerIdent sharer
             renderUrl <- getUrlRender
             let route2uri = route2uri' renderUrl
-                actor = route2uri $ PersonR shr
+                actor = route2uri $ SharerR shr
-                actorID = renderUrl $ PersonR shr
+                actorID = renderUrl $ SharerR shr
                 appendPath u t = u { furiPath = furiPath u <> t }
                 activity = CreateActivity Create
                     { createId     = appendPath actor "/fake-activity"

src/Vervis/Handler/Person.hs

@@ -16,11 +16,7 @@
 module Vervis.Handler.Person
     ( getResendVerifyEmailR
     , getPeopleR
-    , postPeopleR
+    , getPerson
-    , getPersonNewR
-    , getPersonR
-    , postPersonR
-    , getPersonActivitiesR
     )
 where
 
@@ -69,10 +65,10 @@ getPeopleR = do
         return $ sharer ^. SharerIdent
     defaultLayout $(widgetFile "people")
 
+{-
 -- | Create new user
 postPeopleR :: Handler Html
 postPeopleR = redirect $ AuthR newAccountR
-{-
     settings <- getsYesod appSettings
     if appRegister settings
         then do
@@ -118,9 +114,9 @@ postPeopleR = redirect $ AuthR newAccountR
             redirect PeopleR
 -}
 
+{-
 getPersonNewR :: Handler Html
 getPersonNewR = redirect $ AuthR newAccountR
-{-
     regEnabled <- getsYesod $ appRegister . appSettings
     if regEnabled
         then do
@@ -129,18 +125,14 @@ getPersonNewR = redirect $ AuthR newAccountR
         else notFound
 -}
 
-getPersonR :: ShrIdent -> Handler TypedContent
+getPerson :: ShrIdent -> Person -> Handler TypedContent
-getPersonR shr = do
+getPerson shr person = do
-    person <- runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharer shr
-        Entity _pid p <- getBy404 $ UniquePersonIdent sid
-        return p
     renderUrl <- getUrlRender
     let route2uri route =
             case parseFedURI $ renderUrl route of
                 Left e -> error $ "getRenderUrl produced invalid FedURI!!! " ++ e
                 Right u -> u
-        me = route2uri $ PersonR shr
+        me = route2uri $ SharerR shr
     selectRep $ do
         provideRep $ do
             secure <- getSecure
@@ -155,9 +147,3 @@ getPersonR shr = do
                 , publicKey2 = Just $ Left $ route2uri ActorKey2R
                 }
             }
-
-postPersonR :: ShrIdent -> Handler TypedContent
-postPersonR _ = notFound
-
-getPersonActivitiesR :: ShrIdent -> Handler TypedContent
-getPersonActivitiesR _ = notFound

src/Vervis/Handler/Sharer.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -21,15 +21,20 @@ where
 
 import Prelude
 
+import Control.Applicative ((<|>))
 import Control.Monad.Logger (logWarn)
+import Control.Monad.Trans.Maybe
 import Data.Monoid ((<>))
 import Database.Persist
 import Text.Blaze.Html (Html)
 import Yesod.Core (defaultLayout)
+import Yesod.Core.Content (TypedContent)
 import Yesod.Core.Handler (redirect, notFound)
 import Yesod.Persist.Core (runDB, getBy404)
 
 import Vervis.Foundation
+import Vervis.Handler.Person
+import Vervis.Handler.Group
 import Vervis.Model
 import Vervis.Model.Ident (ShrIdent, shr2text)
 import Vervis.Paginate
@@ -46,21 +51,18 @@ getSharersR = do
     let pageNav = navWidget navModel
     defaultLayout $(widgetFile "sharer/list")
 
-getSharerR :: ShrIdent -> Handler Html
+getSharerR :: ShrIdent -> Handler TypedContent
 getSharerR shr = do
-    isperson <- runDB $ do
+    ment <- runDB $ do
         Entity sid _sharer <- getBy404 $ UniqueSharer shr
-        mp <- getBy $ UniquePersonIdent sid
+        runMaybeT
-        case mp of
+            $   Left  <$> MaybeT (getBy $ UniquePersonIdent sid)
-            Just _  -> return $ Just True
+            <|> Right <$> MaybeT (getBy $ UniqueGroup sid)
-            Nothing -> do
+    case ment of
-                mg <- getBy $ UniqueGroup sid
-                case mg of
-                    Just _  -> return $ Just False
-                    Nothing -> return Nothing
-    case isperson of
         Nothing -> do
             $logWarn $ "Found non-person non-group sharer: " <> shr2text shr
             notFound
-        Just True -> redirect $ PersonR shr
+        Just ent ->
-        Just False -> redirect $ GroupR shr
+            case ent of
+                Left (Entity _ p) -> getPerson shr p
+                Right (Entity _ g) -> getGroup shr g

src/Vervis/Widget/Sharer.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -36,7 +36,7 @@ sharerLinkW :: Sharer -> Widget
 sharerLinkW = link SharerR
 
 personLinkW :: Sharer -> Widget
-personLinkW = link PersonR
+personLinkW = link SharerR
 
 groupLinkW :: Sharer -> Widget
-groupLinkW = link GroupR
+groupLinkW = link SharerR

templates/homepage.hamlet

@@ -50,7 +50,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   $forall (sharer, mproj, repo, vcs, ago) <- rows
     <tr>
       <td>
-        <a href=@{PersonR sharer}>#{shr2text sharer}
+        <a href=@{SharerR sharer}>#{shr2text sharer}
       <td>
         $maybe proj <- mproj
           <a href=@{ProjectR sharer proj}>#{prj2text proj}

templates/people.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -18,4 +18,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <ul>
   $forall Value ident <- people
     <li>
-      <a href=@{PersonR ident}>#{shr2text ident}
+      <a href=@{SharerR ident}>#{shr2text ident}