Start implementing channel listing (#2)
This commit is contained in:
		@@ -96,9 +96,23 @@ instance ToNode (Catalog 1) where
 | 
			
		||||
 | 
			
		||||
class Monad m => VersionedCatalog m (v :: Nat) where
 | 
			
		||||
  getChannels :: SafeUser -> m (Catalog v)
 | 
			
		||||
  getBooks :: Channel.ChannelID -> SafeUser -> m (Catalog v)
 | 
			
		||||
 | 
			
		||||
instance VersionedCatalog AppM 1 where
 | 
			
		||||
  getChannels = getChannelsV1
 | 
			
		||||
  getBooks = getBooksV1
 | 
			
		||||
 | 
			
		||||
getBooksV1 :: Channel.ChannelID -> SafeUser -> AppM (Catalog 1)
 | 
			
		||||
getBooksV1 identifier SafeUser{} = do
 | 
			
		||||
  updated <- liftIO getCurrentTime
 | 
			
		||||
  let self = Rel ("/api/current" <> selfUrl)
 | 
			
		||||
      start = Rel ("/api/current" <> startUrl)
 | 
			
		||||
      selfUrl = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(ChannelCatalog 1)) identifier
 | 
			
		||||
      startUrl = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(RootCatalog 1))
 | 
			
		||||
      entries = mempty
 | 
			
		||||
      pagination = Pagination Nothing Nothing
 | 
			
		||||
  pure CatalogV1{..}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
getChannelsV1 :: SafeUser -> AppM (Catalog 1)
 | 
			
		||||
getChannelsV1 SafeUser{username} = do
 | 
			
		||||
@@ -133,7 +147,7 @@ handler auth = catalogRoot :<|> catalogChannels
 | 
			
		||||
  where
 | 
			
		||||
    catalogChannels :: Channel.ChannelID -> AppM (Catalog v)
 | 
			
		||||
    -- Channel specific catalog returns tags inside the catalog
 | 
			
		||||
    catalogChannels _ = throwM err403{errBody="Not implemented"}
 | 
			
		||||
    catalogChannels identifier = flip requireLoggedIn auth (getBooks identifier)
 | 
			
		||||
    catalogRoot :: AppM (Catalog v)
 | 
			
		||||
    -- catalog root returns channels
 | 
			
		||||
    catalogRoot = flip requireLoggedIn auth getChannels
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user