MasseR/ebook-manager
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

Migrations properly through flyway

Browse Source
This commit is contained in:
Mats Rauhala
2018-08-07 23:25:21 +03:00
parent 5dac8374fd
commit bb7ab38b92
5 changed files with 120 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
src/API/Books.hs
View File

@ -1,3 +1,4 @@
{-# Language DuplicateRecordFields #-}
{-# Language DataKinds #-}
{-# Language TypeFamilies #-}
{-# Language TypeOperators #-}
@ -11,6 +12,7 @@
{-# Language FlexibleInstances #-}
{-# Language TypeApplications #-}
{-# Language DataKinds #-}
{-# Language NamedFieldPuns #-}
module API.Books where
import Servant hiding (contentType)
@ -26,7 +28,14 @@ import Database
import Control.Lens
import Data.Generics.Product
data JsonBook = JsonBook { contentType :: Text
data JsonBook = JsonBook { identifier :: BookID
, contentType :: Text
, title :: Maybe Text
, description :: Maybe Text
, channels :: [JsonChannel] }
deriving (Generic, Show)
data PostBook = PostBook { contentType :: Text
, title :: Maybe Text
, description :: Maybe Text
, channels :: [JsonChannel] }
@ -35,15 +44,27 @@ data JsonBook = JsonBook { contentType :: Text
instance ToJSON JsonBook
instance FromJSON JsonBook
instance ToJSON PostBook
instance FromJSON PostBook
type API = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI
type BaseAPI = "books" :> Get '[JSON] [JsonBook]
-- :<|> "books" :> ReqBody '[JSON] JsonBook :> PUT JsonBook
-- :<|> "books" :> Param "book_id" BookID :> ReqBody '[JSON] JsonBook :> PUT JsonBook
:<|> "books" :> ReqBody '[JSON] PostBook :> Post '[JSON] JsonBook
:<|> "books" :> Capture "book_id" BookID :> ReqBody '[JSON] JsonBook :> Post '[JSON] JsonBook
-- :<|> "books" :> Capture "book_id" BookID :> ReqBody '[JSON] JsonBook :> PUT JsonBook
handler :: ServerT API AppM
handler user = listBooksHandler user
handler user = listBooksHandler user :<|> postBookMetaHandler user :<|> putBookMetaHandler user
postBookMetaHandler :: AuthResult SafeUser -> PostBook -> AppM JsonBook
postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{username} -> do
mIdentifier <- runDB $ insertBook username Book{identifier=def,contentHash=Nothing,..}
maybe (throwM err403{errBody="Could not insert book"}) (\identifier -> pure JsonBook{..}) mIdentifier
putBookMetaHandler :: AuthResult SafeUser -> BookID -> JsonBook -> AppM JsonBook
putBookMetaHandler _ _ _ = throwM err403
listBooksHandler :: AuthResult SafeUser -> AppM [JsonBook]
listBooksHandler = requireLoggedIn $ \user -> do
@ -51,4 +72,4 @@ listBooksHandler = requireLoggedIn $ \user -> do
where
augment Book{identifier=bookId,..} = do
channels <- fmap (\Channel{..} -> JsonChannel{..}) <$> booksChannels bookId
pure JsonBook{..}
pure JsonBook{identifier=bookId,..}