module Network.HTTP.Pony.Transformer.StartLine where
import Control.Lens (over, ASetter, _1, _2, view
, Field1, Field2, set, Getting)
import Data.Attoparsec.ByteString (parse, eitherResult)
import Data.ByteString (ByteString)
import qualified Network.HTTP.Types as HTTP
import qualified Network.HTTP.Pony.Transformer.StartLine.Builder as Builder
import qualified Network.HTTP.Pony.Transformer.StartLine.Parser as Parser
import Network.HTTP.Pony.Transformer.StartLine.Type (RequestURI, RequestLine, ResponseLine)
startLineWith :: (Monoid a, Monad f) => Getting ByteString s ByteString
-> ASetter s t a1 RequestLine
-> ASetter s1 a ResponseLine ByteString
-> (t -> f s1)
-> s
-> f a
startLineWith f f' g app request = do
let requestLine = view f request
case eitherResult (parse Parser.requestLineTokens requestLine) of
Left _ -> pure mempty
Right r -> do
response <- app (set f' r request)
pure (over g Builder.response response)
startLine :: ( Field1 s3 b2 ByteString ByteString
, Field1 s3 b ByteString (HTTP.Method, RequestURI, HTTP.HttpVersion)
, Field1 s2 b1 ResponseLine ByteString
, Field1 s1 a s2 b1
, Field1 s s s3 b2
, Field1 s t s3 b
, Monoid a
, Monad f) => (t -> f s1) -> s -> f a
startLine = startLineWith (_1 . _1) (_1 . _1) (_1 . _1)