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

Reading and writing binary files

Browse Source
This commit is contained in:
Mats Rauhala
2018-08-08 23:56:16 +03:00
parent 84a838e141
commit 1a8646df46
8 changed files with 153 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
src/API/Books.hs
View File

@ -28,6 +28,12 @@ import Database
import Control.Lens
import Data.Generics.Product
import Control.Monad.Trans.Maybe
import qualified Datastore as DS
import Data.ByteArray (convert)
import Crypto.Hash (digestFromByteString)
data JsonBook = JsonBook { identifier :: BookID
, contentType :: Text
, title :: Maybe Text
@ -51,11 +57,36 @@ type API = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI
type BaseAPI = "books" :> Get '[JSON] [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
:<|> "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
handler :: ServerT API AppM
handler user = listBooksHandler user :<|> postBookMetaHandler user :<|> putBookMetaHandler user
handler user = listBooksHandler user
:<|> postBookMetaHandler user
:<|> putBookMetaHandler user
:<|> putBookContentHandler user
:<|> getBookContentHandler user
getBookContentHandler :: AuthResult SafeUser -> BookID -> AppM ByteString
getBookContentHandler auth bookId = requireBookOwner auth bookId $ \SafeUser{username} -> do
content <- runMaybeT $ do
Book{contentHash=mHash} <- MaybeT $ runDB (getBook bookId username)
contentHash <- MaybeT $ return (mHash >>= digestFromByteString . unHex)
MaybeT $ DS.get contentHash
maybe (throwM err404) return content
requireBookOwner :: AuthResult SafeUser -> BookID -> (SafeUser -> AppM a) -> AppM a
requireBookOwner auth bookId f = flip requireLoggedIn auth $ \u@SafeUser{username} -> do
exists <- runDB $ bookExists bookId
unless exists $ throwM err404
runDB (isBookOwner bookId username) >>= \o -> if o then f u else throwM err403
putBookContentHandler :: AuthResult SafeUser -> BookID -> ByteString -> AppM NoContent
putBookContentHandler auth bookId content = requireBookOwner auth bookId $ \SafeUser{username} -> do
key <- HashDigest . convert <$> DS.put content
runDB (setContent bookId username key)
return NoContent
postBookMetaHandler :: AuthResult SafeUser -> PostBook -> AppM JsonBook
postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{username} -> do
@ -65,7 +96,7 @@ postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{us
putBookMetaHandler :: AuthResult SafeUser -> BookID -> JsonBook -> AppM JsonBook
putBookMetaHandler auth bookId b@JsonBook{..}
| bookId == identifier = flip requireLoggedIn auth $ \SafeUser{username=owner} ->
| bookId == identifier = requireBookOwner auth bookId $ \SafeUser{username=owner} ->
maybe (throwM err403) (const (return b)) =<< runDB (updateBook UpdateBook{..})
| otherwise = throwM err403