@ -98,28 +98,33 @@ class Monad m => VersionedCatalog m (v :: Nat) where
|
||||
getChannels :: SafeUser -> m (Catalog v)
|
||||
|
||||
instance VersionedCatalog AppM 1 where
|
||||
getChannels SafeUser{username} = do
|
||||
updated <- liftIO getCurrentTime
|
||||
let self = Rel ("/api/current/" <> selfUrl)
|
||||
-- I'm not sure if this safe link approach is really useable with this
|
||||
-- api hierarchy since I can't access the topmost api from here. Also
|
||||
-- authentication would bring a little bit of extra effort as well
|
||||
selfUrl = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(RootCatalog 1))
|
||||
start = self
|
||||
pagination = Pagination Nothing Nothing
|
||||
entries <- map (fromChannel updated) <$> runDB (Channel.userChannels username)
|
||||
pure CatalogV1{..}
|
||||
where
|
||||
fromChannel :: UTCTime -> Channel.Channel -> Entry 1
|
||||
fromChannel updated Channel.Channel{..} =
|
||||
let url = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(ChannelCatalog 1)) identifier
|
||||
self = Rel ("/api/current/" <> url)
|
||||
in EntryV1 channel channel updated channel (Left $ SubSection self)
|
||||
getChannels = getChannelsV1
|
||||
|
||||
getChannelsV1 :: SafeUser -> AppM (Catalog 1)
|
||||
getChannelsV1 SafeUser{username} = do
|
||||
updated <- liftIO getCurrentTime
|
||||
let self = Rel ("/api/current/" <> selfUrl)
|
||||
-- I'm not sure if this safe link approach is really useable with this
|
||||
-- api hierarchy since I can't access the topmost api from here. Also
|
||||
-- authentication would bring a little bit of extra effort as well
|
||||
selfUrl = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(RootCatalog 1))
|
||||
start = self
|
||||
pagination = Pagination Nothing Nothing
|
||||
entries <- map (fromChannel updated) <$> runDB (Channel.userChannels username)
|
||||
pure CatalogV1{..}
|
||||
where
|
||||
fromChannel :: UTCTime -> Channel.Channel -> Entry 1
|
||||
fromChannel updated Channel.Channel{..} =
|
||||
let url = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(ChannelCatalog 1)) identifier
|
||||
self = Rel ("/api/current/" <> url)
|
||||
in EntryV1 channel channel updated channel (Left $ SubSection self)
|
||||
|
||||
type VersionedAPI (v :: Nat) = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI v
|
||||
|
||||
type RootCatalog (v :: Nat) = "catalog" :> Get '[XML] (Catalog v)
|
||||
type ChannelCatalog (v :: Nat) = "catalog" :> "channel" :> Capture "channel_id" Channel.ChannelID :> Get '[XML] (Catalog v)
|
||||
type CatalogContent = '[XML, OPDS]
|
||||
|
||||
type RootCatalog (v :: Nat) = "catalog" :> Get CatalogContent (Catalog v)
|
||||
type ChannelCatalog (v :: Nat) = "catalog" :> "channel" :> Capture "channel_id" Channel.ChannelID :> Get CatalogContent (Catalog v)
|
||||
type BaseAPI (v :: Nat) = RootCatalog v
|
||||
:<|> ChannelCatalog v
|
||||
|
||||
@ -127,6 +132,8 @@ handler :: forall v. VersionedCatalog AppM v => ServerT (VersionedAPI v) AppM
|
||||
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"}
|
||||
catalogRoot :: AppM (Catalog v)
|
||||
-- catalog root returns channels
|
||||
catalogRoot = flip requireLoggedIn auth getChannels
|
||||
|
Reference in New Issue
Block a user