From efa7ed7f920d5d78f2c1f35cab9c9a1aa06b0ac2 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 28 Aug 2018 23:14:11 +0300 Subject: [PATCH] WIP --- src/API/Books.hs | 8 +++++--- src/API/Catalogue.hs | 16 ++++++++++++---- src/Database/Book.hs | 4 ++-- src/Database/Channel.hs | 5 +++++ src/Database/Schema.hs | 4 ++-- 5 files changed, 26 insertions(+), 11 deletions(-) diff --git a/src/API/Books.hs b/src/API/Books.hs index 3cb0369..6a9ebdb 100644 --- a/src/API/Books.hs +++ b/src/API/Books.hs @@ -36,14 +36,14 @@ import Crypto.Hash (digestFromByteString) data JsonBook = JsonBook { identifier :: BookID , contentType :: Text - , title :: Maybe Text + , title :: Text , description :: Maybe Text , channels :: [Text] , tags :: [Text] } deriving (Generic, Show) data PostBook = PostBook { contentType :: Text - , title :: Maybe Text + , title :: Text , description :: Maybe Text , channels :: [Text] , tags :: [Text] } @@ -61,7 +61,9 @@ type BaseAPI = "books" :> Get '[JSON] [JsonBook] :<|> "books" :> ReqBody '[JSON] PostBook :> Post '[JSON] JsonBook :<|> "books" :> Capture "book_id" BookID :> "meta" :> ReqBody '[JSON] JsonBook :> Put '[JSON] JsonBook :<|> "books" :> Capture "book_id" BookID :> ReqBody '[OctetStream] ByteString :> Put '[JSON] NoContent - :<|> "books" :> Capture "book_id" BookID :> Get '[OctetStream] ByteString + :<|> GetBook + +type GetBook = "books" :> Capture "book_id" BookID :> Get '[OctetStream] ByteString handler :: ServerT API AppM handler user = listBooksHandler user diff --git a/src/API/Catalogue.hs b/src/API/Catalogue.hs index 74872aa..9a36699 100644 --- a/src/API/Catalogue.hs +++ b/src/API/Catalogue.hs @@ -17,14 +17,16 @@ module API.Catalogue (VersionedAPI, handler) where import Types -import Servant +import Servant hiding (contentType) import ClassyPrelude import GHC.TypeLits import Server.Auth import Servant.Auth as SA import Servant.XML import qualified Database.Channel as Channel +import Database.Book (Book(..)) import Database +import qualified API.Books -- This is my first try on going to versioned apis, things might change -- I think my rule of thumb is that you can add new things as you want, but @@ -106,15 +108,21 @@ relUrl :: Link -> Rel relUrl x = Rel ("/api/current/" <> (pack . uriPath . linkURI $ x)) getBooksV1 :: Channel.ChannelID -> SafeUser -> AppM (Catalog 1) -getBooksV1 identifier SafeUser{} = do +getBooksV1 channelID SafeUser{username} = do updated <- liftIO getCurrentTime let self = relUrl selfUrl start = relUrl startUrl - selfUrl = safeLink (Proxy @(BaseAPI 1)) (Proxy @(ChannelCatalog 1)) identifier + selfUrl = safeLink (Proxy @(BaseAPI 1)) (Proxy @(ChannelCatalog 1)) channelID startUrl = safeLink (Proxy @(BaseAPI 1)) (Proxy @(RootCatalog 1)) - entries = mempty pagination = Pagination Nothing Nothing + entries <- map (toEntry updated) <$> runDB (Channel.channelBooks username channelID) pure CatalogV1{..} + where + toEntry updated Book{description,title,identifier=bookId} = + let content = fromMaybe "no content" description + identifier = pack . show $ bookId + link = Right (Acquisition (relUrl (safeLink (Proxy @API.Books.BaseAPI) (Proxy @API.Books.GetBook) bookId))) + in EntryV1{..} getChannelsV1 :: SafeUser -> AppM (Catalog 1) getChannelsV1 SafeUser{username} = do diff --git a/src/Database/Book.hs b/src/Database/Book.hs index eb78b9d..8ce492c 100644 --- a/src/Database/Book.hs +++ b/src/Database/Book.hs @@ -51,7 +51,7 @@ getBook identifier owner = listToMaybe . fromRels <$> query q return book data InsertBook = InsertBook { contentType :: Text - , title :: Maybe Text + , title :: Text , description :: Maybe Text , owner :: Username } @@ -68,7 +68,7 @@ insertBook InsertBook{..} = do data UpdateBook = UpdateBook { identifier :: BookID , contentType :: Text - , title :: Maybe Text + , title :: Text , description :: Maybe Text , owner :: Username , tags :: [Text] diff --git a/src/Database/Channel.hs b/src/Database/Channel.hs index 10d84bc..4af4fc3 100644 --- a/src/Database/Channel.hs +++ b/src/Database/Channel.hs @@ -11,6 +11,7 @@ module Database.Channel , Visibility(..) , clearChannels , booksChannels + , channelBooks , Channel(..) , ChannelID(..) ) where @@ -80,6 +81,10 @@ insertChannel username channel visibility = runMaybeT $ do restrict (user .== literal username) return userId +channelBooks :: (MonadSelda m, MonadMask m, MonadIO m) => Username -> ChannelID -> m [Book] +channelBooks _username _channelID = do + return [] + booksChannels :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m [Channel] booksChannels bookId = fromRels <$> query q where diff --git a/src/Database/Schema.hs b/src/Database/Schema.hs index 8084168..598abdb 100644 --- a/src/Database/Schema.hs +++ b/src/Database/Schema.hs @@ -42,7 +42,7 @@ instance SqlType Username where newtype UserID = UserID {unUserID :: Int} deriving (Show) -newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord) +newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord, ToHttpApiData) newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON) @@ -101,7 +101,7 @@ newtype HashDigest = HashDigest { unHex :: ByteString } deriving Show data Book = Book { identifier :: BookID , contentHash :: Maybe HashDigest , contentType :: Text - , title :: Maybe Text + , title :: Text , description :: Maybe Text , owner :: UserID } deriving (Show, Generic)