Compare commits
1 Commits
83e39cbe6c
...
13e8da4eea
Author | SHA1 | Date | |
---|---|---|---|
13e8da4eea |
@ -1,6 +1,3 @@
|
|||||||
-- Initial ebook-manager.cabal generated by cabal init. For further
|
|
||||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
|
||||||
|
|
||||||
name: ebook-manager
|
name: ebook-manager
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
-- synopsis:
|
-- synopsis:
|
||||||
|
@ -98,7 +98,10 @@ class Monad m => VersionedCatalog m (v :: Nat) where
|
|||||||
getChannels :: SafeUser -> m (Catalog v)
|
getChannels :: SafeUser -> m (Catalog v)
|
||||||
|
|
||||||
instance VersionedCatalog AppM 1 where
|
instance VersionedCatalog AppM 1 where
|
||||||
getChannels SafeUser{username} = do
|
getChannels = getChannelsV1
|
||||||
|
|
||||||
|
getChannelsV1 :: SafeUser -> AppM (Catalog 1)
|
||||||
|
getChannelsV1 SafeUser{username} = do
|
||||||
updated <- liftIO getCurrentTime
|
updated <- liftIO getCurrentTime
|
||||||
let self = Rel ("/api/current/" <> selfUrl)
|
let self = Rel ("/api/current/" <> selfUrl)
|
||||||
-- I'm not sure if this safe link approach is really useable with this
|
-- I'm not sure if this safe link approach is really useable with this
|
||||||
@ -118,8 +121,10 @@ instance VersionedCatalog AppM 1 where
|
|||||||
|
|
||||||
type VersionedAPI (v :: Nat) = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI v
|
type VersionedAPI (v :: Nat) = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI v
|
||||||
|
|
||||||
type RootCatalog (v :: Nat) = "catalog" :> Get '[XML] (Catalog v)
|
type CatalogContent = '[XML, OPDS]
|
||||||
type ChannelCatalog (v :: Nat) = "catalog" :> "channel" :> Capture "channel_id" Channel.ChannelID :> Get '[XML] (Catalog v)
|
|
||||||
|
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
|
type BaseAPI (v :: Nat) = RootCatalog v
|
||||||
:<|> ChannelCatalog v
|
:<|> ChannelCatalog v
|
||||||
|
|
||||||
@ -127,6 +132,8 @@ handler :: forall v. VersionedCatalog AppM v => ServerT (VersionedAPI v) AppM
|
|||||||
handler auth = catalogRoot :<|> catalogChannels
|
handler auth = catalogRoot :<|> catalogChannels
|
||||||
where
|
where
|
||||||
catalogChannels :: Channel.ChannelID -> AppM (Catalog v)
|
catalogChannels :: Channel.ChannelID -> AppM (Catalog v)
|
||||||
|
-- Channel specific catalog returns tags inside the catalog
|
||||||
catalogChannels _ = throwM err403{errBody="Not implemented"}
|
catalogChannels _ = throwM err403{errBody="Not implemented"}
|
||||||
catalogRoot :: AppM (Catalog v)
|
catalogRoot :: AppM (Catalog v)
|
||||||
|
-- catalog root returns channels
|
||||||
catalogRoot = flip requireLoggedIn auth getChannels
|
catalogRoot = flip requireLoggedIn auth getChannels
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
{-# Language OverloadedStrings #-}
|
{-# Language OverloadedStrings #-}
|
||||||
{-# Language FlexibleInstances #-}
|
{-# Language FlexibleInstances #-}
|
||||||
{-# Language MultiParamTypeClasses #-}
|
{-# Language MultiParamTypeClasses #-}
|
||||||
|
{-# Language TypeApplications #-}
|
||||||
module Servant.XML
|
module Servant.XML
|
||||||
( ToNode(..)
|
( ToNode(..)
|
||||||
, XML
|
, XML
|
||||||
|
, OPDS
|
||||||
, Text.Hamlet.XML.xml
|
, Text.Hamlet.XML.xml
|
||||||
, iso8601 )
|
, iso8601 )
|
||||||
where
|
where
|
||||||
@ -16,14 +18,22 @@ import Network.HTTP.Media.MediaType
|
|||||||
|
|
||||||
data XML
|
data XML
|
||||||
|
|
||||||
|
data OPDS
|
||||||
|
|
||||||
instance (ToNode a) => MimeRender XML a where
|
instance (ToNode a) => MimeRender XML a where
|
||||||
mimeRender _ a =
|
mimeRender _ a =
|
||||||
let [NodeElement root] = toNode a
|
let [NodeElement root] = toNode a
|
||||||
in renderLBS def (Document (Prologue [] Nothing []) root [])
|
in renderLBS def (Document (Prologue [] Nothing []) root [])
|
||||||
|
|
||||||
|
instance (ToNode a) => MimeRender OPDS a where
|
||||||
|
mimeRender _ a = mimeRender (Proxy @XML) a
|
||||||
|
|
||||||
instance Accept XML where
|
instance Accept XML where
|
||||||
contentType _ = "application" // "xml" /: ("charset", "utf-8")
|
contentType _ = "application" // "xml" /: ("charset", "utf-8")
|
||||||
|
|
||||||
|
instance Accept OPDS where
|
||||||
|
contentType _ = "application" // "atom+xml" /: ("charset", "utf-8") /: ("profile", "opds-catalog")
|
||||||
|
|
||||||
iso8601 :: UTCTime -> Text
|
iso8601 :: UTCTime -> Text
|
||||||
iso8601 = pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"
|
iso8601 = pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user