Listing books

src/API/Books.hs

@@ -0,0 +1,51 @@
+{-# Language DataKinds #-}
+{-# Language TypeFamilies #-}
+{-# Language TypeOperators #-}
+{-# Language NoImplicitPrelude #-}
+{-# Language MultiParamTypeClasses #-}
+{-# Language OverloadedStrings #-}
+{-# Language TemplateHaskell #-}
+{-# Language QuasiQuotes #-}
+{-# Language RecordWildCards #-}
+{-# Language DeriveGeneric #-}
+{-# Language FlexibleInstances #-}
+{-# Language TypeApplications #-}
+{-# Language DataKinds #-}
+module API.Books where
+
+import Servant hiding (contentType)
+import Types
+import ClassyPrelude
+import Server.Auth
+import Servant.Auth as SA
+import Data.Aeson
+import API.Channels (JsonChannel(..))
+import Database.Book
+import Database.Channel
+import Database
+import Control.Lens
+import Data.Generics.Product
+
+data JsonBook = JsonBook { contentType :: Text
+                         , title :: Maybe Text
+                         , description :: Maybe Text
+                         , channels :: [JsonChannel] }
+              deriving (Generic, Show)
+
+instance ToJSON JsonBook
+instance FromJSON JsonBook
+
+type API = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI
+
+type BaseAPI = "books" :> Get '[JSON] [JsonBook]
+
+handler :: ServerT API AppM
+handler user = listBooksHandler user
+
+listBooksHandler :: AuthResult SafeUser -> AppM [JsonBook]
+listBooksHandler = requireLoggedIn $ \user -> do
+  runDB (usersBooks (view (field @"username") user) >>= mapM augment)
+    where
+      augment Book{..} = do
+        channels <- fmap (\Channel{..} -> JsonChannel{..}) <$> booksChannels contentHash
+        pure JsonBook{..}

src/API/Channels.hs

@@ -11,7 +11,7 @@
 {-# Language FlexibleInstances #-}
 {-# Language TypeApplications #-}
 {-# Language DataKinds #-}
-module API.Channels (API, handler) where
+module API.Channels (API, handler, JsonChannel(..)) where
 
 import Servant
 import Types