- Relates to #2
This commit is contained in:
2018-08-14 22:11:52 +03:00
parent 0333345aa3
commit 13e8da4eea
3 changed files with 36 additions and 22 deletions

View File

@ -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