forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Serve AS2 in getSharerInboxR

Browse source
This commit is contained in:
fr33domlover 2019-05-21 00:14:49 +00:00
parent 7bcbe52274
commit 40d9a0990d
1 changed files with 47 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
src/Vervis/Handler/Inbox.hs
View file

@ -140,13 +140,54 @@ getInboxR = do
getSharerInboxR :: ShrIdent -> Handler TypedContent getSharerInboxR :: ShrIdent -> Handler TypedContent
getSharerInboxR shr = do getSharerInboxR shr = do
(_, _, items, navModel) <- getPageAndNavTop $ \ off lim -> runDB $ do (total, pages, mpage) <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr sid <- getKeyBy404 $ UniqueSharer shr
pid <- getKeyBy404 $ UniquePersonIdent sid pid <- getKeyBy404 $ UniquePersonIdent sid
(,) <$> countItems pid getPageAndNavCount
<*> (map adaptItem <$> getItems pid off lim) (countItems pid)
let pageNav = navWidget navModel (\ off lim -> map adaptItem <$> getItems pid off lim)
selectRep $ provideRep $ defaultLayout $(widgetFile "person/inbox") let here = OutboxR shr
encodeRouteLocal <- getEncodeRouteLocal
encodeRoutePageLocal <- getEncodeRoutePageLocal
let pageUrl = encodeRoutePageLocal here
host <- getsYesod $ appInstanceHost . appSettings
selectRep $
case mpage of
Nothing -> do
provideAP $ pure $ Doc host $ Collection
{ collectionId = encodeRouteLocal here
, collectionType = CollectionTypeOrdered
, collectionTotalItems = Just total
, collectionCurrent = Nothing
, collectionFirst = Just $ pageUrl 1
, collectionLast = Just $ pageUrl pages
, collectionItems = [] :: [Text]
}
provideRep (redirectFirstPage here :: Handler Html)
Just (items, navModel) -> do
let current = nmCurrent navModel
provideAP $ pure $ Doc host $ CollectionPage
{ collectionPageId = pageUrl current
, collectionPageType = CollectionPageTypeOrdered
, collectionPageTotalItems = Nothing
, collectionPageCurrent = Just $ pageUrl current
, collectionPageFirst = Just $ pageUrl 1
, collectionPageLast = Just $ pageUrl pages
, collectionPagePartOf = encodeRouteLocal here
, collectionPagePrev =
if current > 1
then Just $ pageUrl $ current - 1
else Nothing
, collectionPageNext =
if current < pages
then Just $ pageUrl $ current + 1
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems = map fromEither items
}
provideRep $
let pageNav = navWidget navModel
in defaultLayout $(widgetFile "person/inbox")
where where
countItems pid = countItems pid =
(+) <$> count [InboxItemLocalPerson ==. pid] (+) <$> count [InboxItemLocalPerson ==. pid]
@ -320,7 +361,7 @@ getOutboxR shr = do
encodeRoutePageLocal <- getEncodeRoutePageLocal encodeRoutePageLocal <- getEncodeRoutePageLocal
let pageUrl = encodeRoutePageLocal here let pageUrl = encodeRoutePageLocal here
host <- getsYesod $ appInstanceHost . appSettings host <- getsYesod $ appInstanceHost . appSettings
selectRep $ do selectRep $
case mpage of case mpage of
Nothing -> do Nothing -> do
provideAP $ pure $ Doc host $ Collection provideAP $ pure $ Doc host $ Collection