diff --git a/src/Data/Binary/Local.hs b/src/Data/Binary/Local.hs index a903672..9f6f050 100644 --- a/src/Data/Binary/Local.hs +++ b/src/Data/Binary/Local.hs @@ -76,7 +76,6 @@ decodeIncremental -- value again from the same stream, pass the buffer to the next call of -- this function. decodeIncremental src readBytes buf decode = go buf $ runGetIncremental decode - --readBytes <- requestBody <$> waiRequest where go _ (Fail remains consumed err) = do let df = DecodeFail diff --git a/src/Vervis/BinaryBody.hs b/src/Vervis/BinaryBody.hs new file mode 100644 index 0000000..ef6c30d --- /dev/null +++ b/src/Vervis/BinaryBody.hs @@ -0,0 +1,42 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | Support for working with HTTP request bodies which contain binary +-- serialization, using the @binary@ package. +-- +-- TODO add ToContent, ToTypedContent etc. instances with Get and Put support +-- TODO rename module to Yesod...Local +-- TODO maybe split into entirely separate small trivial package? +module Vervis.BinaryBody + ( decodeRequestBody + ) +where + +import Prelude + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Logger (MonadLogger) +import Data.Binary.Get (Get) +import Network.Wai (requestBody) +import Yesod.Core (MonadHandler) +import Yesod.Core.Handler (waiRequest) + +import Data.Binary.Local + +decodeRequestBody + :: (MonadLogger m, MonadHandler m) => Get a -> m (Either DecodeFail a) +decodeRequestBody decode = do + readBytes <- liftIO . requestBody <$> waiRequest + fmap snd <$> decodeIncremental "DecodeReq" readBytes Nothing decode diff --git a/vervis.cabal b/vervis.cabal index 01f8677..362657a 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -42,6 +42,7 @@ library Network.SSH.Local Text.FilePath.Local Vervis.Application + Vervis.BinaryBody Vervis.Content Vervis.Field.Key Vervis.Field.Person