{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Network.Wai.Parse (
parseHttpAccept,
parseRequestBody,
RequestBodyType (..),
getRequestBodyType,
sinkRequestBody,
sinkRequestBodyEx,
RequestParseException (..),
BackEnd,
lbsBackEnd,
tempFileBackEnd,
tempFileBackEndOpts,
Param,
File,
FileInfo (..),
parseContentType,
ParseRequestBodyOptions,
defaultParseRequestBodyOptions,
noLimitParseRequestBodyOptions,
parseRequestBodyEx,
setMaxRequestKeyLength,
clearMaxRequestKeyLength,
setMaxRequestNumFiles,
clearMaxRequestNumFiles,
setMaxRequestFileSize,
clearMaxRequestFileSize,
setMaxRequestFilesSize,
clearMaxRequestFilesSize,
setMaxRequestParmsSize,
clearMaxRequestParmsSize,
setMaxHeaderLines,
clearMaxHeaderLines,
setMaxHeaderLineLength,
clearMaxHeaderLineLength,
#if TEST
Bound (..),
findBound,
sinkTillBound,
killCR,
killCRLF,
takeLine,
#endif
) where
import Prelude hiding (lines)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Exception (catchJust)
import qualified Control.Exception as E
import Control.Monad (guard, unless, when)
import Control.Monad.Trans.Resource (
InternalState,
allocate,
register,
release,
runInternalState,
)
import Data.Bifunctor (bimap)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.CaseInsensitive (mk)
import Data.Function (fix, on)
import Data.IORef
import Data.Int (Int64)
import Data.List (sortBy)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Typeable
import Data.Word8
import Network.HTTP.Types (hContentType)
import qualified Network.HTTP.Types as H
import Network.Wai
import Network.Wai.Handler.Warp (InvalidRequest (..))
import System.Directory (getTemporaryDirectory, removeFile)
import System.IO (hClose, openBinaryTempFile)
import System.IO.Error (isDoesNotExistError)
breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
breakDiscard :: Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard Word8
w ByteString
s =
let (ByteString
x, ByteString
y) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w) ByteString
s
in (ByteString
x, Int -> ByteString -> ByteString
S.drop Int
1 ByteString
y)
parseHttpAccept :: S.ByteString -> [S.ByteString]
parseHttpAccept :: ByteString -> [ByteString]
parseHttpAccept =
((ByteString, (Double, Int)) -> ByteString)
-> [(ByteString, (Double, Int))] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, (Double, Int)) -> ByteString
forall a b. (a, b) -> a
fst
([(ByteString, (Double, Int))] -> [ByteString])
-> (ByteString -> [(ByteString, (Double, Int))])
-> ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, (Double, Int))
-> (ByteString, (Double, Int)) -> Ordering)
-> [(ByteString, (Double, Int))] -> [(ByteString, (Double, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Double, Int) -> (Double, Int) -> Ordering
rcompare ((Double, Int) -> (Double, Int) -> Ordering)
-> ((ByteString, (Double, Int)) -> (Double, Int))
-> (ByteString, (Double, Int))
-> (ByteString, (Double, Int))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ByteString, (Double, Int)) -> (Double, Int)
forall a b. (a, b) -> b
snd)
([(ByteString, (Double, Int))] -> [(ByteString, (Double, Int))])
-> (ByteString -> [(ByteString, (Double, Int))])
-> ByteString
-> [(ByteString, (Double, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (ByteString, (Double, Int)))
-> [ByteString] -> [(ByteString, (Double, Int))]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString, Double) -> (ByteString, (Double, Int))
forall {a}. (ByteString, a) -> (ByteString, (a, Int))
addSpecificity ((ByteString, Double) -> (ByteString, (Double, Int)))
-> (ByteString -> (ByteString, Double))
-> ByteString
-> (ByteString, (Double, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, Double)
forall {b}. (Read b, Fractional b) => ByteString -> (ByteString, b)
grabQ)
([ByteString] -> [(ByteString, (Double, Int))])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, (Double, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
S.split Word8
_comma
where
rcompare :: (Double, Int) -> (Double, Int) -> Ordering
rcompare :: (Double, Int) -> (Double, Int) -> Ordering
rcompare = ((Double, Int) -> (Double, Int) -> Ordering)
-> (Double, Int) -> (Double, Int) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Double, Int) -> (Double, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
addSpecificity :: (ByteString, a) -> (ByteString, (a, Int))
addSpecificity (ByteString
s, a
q) =
let semicolons :: Int
semicolons = Word8 -> ByteString -> Int
S.count Word8
_semicolon ByteString
s
stars :: Int
stars = Word8 -> ByteString -> Int
S.count Word8
_asterisk ByteString
s
in (ByteString
s, (a
q, Int
semicolons Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
stars))
grabQ :: ByteString -> (ByteString, b)
grabQ ByteString
s =
let (ByteString
s', ByteString
q) = ByteString -> ByteString -> (ByteString, ByteString)
S.breakSubstring ByteString
";q=" ((Word8 -> Bool) -> ByteString -> ByteString
S.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_space) ByteString
s)
q' :: ByteString
q' = (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_semicolon) (Int -> ByteString -> ByteString
S.drop Int
3 ByteString
q)
in (ByteString
s', ByteString -> b
forall {a}. (Read a, Fractional a) => ByteString -> a
readQ ByteString
q')
readQ :: ByteString -> a
readQ ByteString
s = case ReadS a
forall a. Read a => ReadS a
reads ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ ByteString -> String
S8.unpack ByteString
s of
(a
x, String
_) : [(a, String)]
_ -> a
x
[(a, String)]
_ -> a
1.0
lbsBackEnd
:: Monad m => ignored1 -> ignored2 -> m S.ByteString -> m L.ByteString
lbsBackEnd :: forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd ignored1
_ ignored2
_ m ByteString
popper =
([ByteString] -> [ByteString]) -> m ByteString
loop [ByteString] -> [ByteString]
forall a. a -> a
id
where
loop :: ([ByteString] -> [ByteString]) -> m ByteString
loop [ByteString] -> [ByteString]
front = do
bs <- m ByteString
popper
if S.null bs
then return $ L.fromChunks $ front []
else loop $ front . (bs :)
tempFileBackEnd
:: InternalState -> ignored1 -> ignored2 -> IO S.ByteString -> IO FilePath
tempFileBackEnd :: forall ignored1 ignored2.
InternalState -> ignored1 -> ignored2 -> IO ByteString -> IO String
tempFileBackEnd = IO String
-> String
-> InternalState
-> ignored1
-> ignored2
-> IO ByteString
-> IO String
forall ignored1 ignored2.
IO String
-> String
-> InternalState
-> ignored1
-> ignored2
-> IO ByteString
-> IO String
tempFileBackEndOpts IO String
getTemporaryDirectory String
"webenc.buf"
tempFileBackEndOpts
:: IO FilePath
-> String
-> InternalState
-> ignored1
-> ignored2
-> IO S.ByteString
-> IO FilePath
tempFileBackEndOpts :: forall ignored1 ignored2.
IO String
-> String
-> InternalState
-> ignored1
-> ignored2
-> IO ByteString
-> IO String
tempFileBackEndOpts IO String
getTmpDir String
pattrn InternalState
internalState ignored1
_ ignored2
_ IO ByteString
popper = do
(key, (fp, h)) <-
(ResourceT IO (ReleaseKey, (String, Handle))
-> InternalState -> IO (ReleaseKey, (String, Handle)))
-> InternalState
-> ResourceT IO (ReleaseKey, (String, Handle))
-> IO (ReleaseKey, (String, Handle))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ResourceT IO (ReleaseKey, (String, Handle))
-> InternalState -> IO (ReleaseKey, (String, Handle))
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState InternalState
internalState (ResourceT IO (ReleaseKey, (String, Handle))
-> IO (ReleaseKey, (String, Handle)))
-> ResourceT IO (ReleaseKey, (String, Handle))
-> IO (ReleaseKey, (String, Handle))
forall a b. (a -> b) -> a -> b
$ IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ResourceT IO (ReleaseKey, (String, Handle))
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate IO (String, Handle)
it (Handle -> IO ()
hClose (Handle -> IO ())
-> ((String, Handle) -> Handle) -> (String, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Handle) -> Handle
forall a b. (a, b) -> b
snd)
_ <- runInternalState (register $ removeFileQuiet fp) internalState
fix $ \IO ()
loop -> do
bs <- IO ByteString
popper
unless (S.null bs) $ do
S.hPut h bs
loop
release key
return fp
where
it :: IO (String, Handle)
it = do
tempDir <- IO String
getTmpDir
openBinaryTempFile tempDir pattrn
removeFileQuiet :: String -> IO ()
removeFileQuiet String
fp =
(IOError -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust
(Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
(String -> IO ()
removeFile String
fp)
(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
data ParseRequestBodyOptions = ParseRequestBodyOptions
{ ParseRequestBodyOptions -> Maybe Int
prboKeyLength :: Maybe Int
, ParseRequestBodyOptions -> Maybe Int
prboMaxNumFiles :: Maybe Int
, ParseRequestBodyOptions -> Maybe Int64
prboMaxFileSize :: Maybe Int64
, ParseRequestBodyOptions -> Maybe Int64
prboMaxFilesSize :: Maybe Int64
, ParseRequestBodyOptions -> Maybe Int
prboMaxParmsSize :: Maybe Int
, :: Maybe Int
, :: Maybe Int
}
setMaxRequestKeyLength
:: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestKeyLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestKeyLength Int
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboKeyLength = Just l}
clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestKeyLength ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboKeyLength = Nothing}
setMaxRequestNumFiles
:: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestNumFiles :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestNumFiles Int
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxNumFiles = Just l}
clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestNumFiles ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxNumFiles = Nothing}
setMaxRequestFileSize
:: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestFileSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestFileSize Int64
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxFileSize = Just l}
clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestFileSize ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxFileSize = Nothing}
setMaxRequestFilesSize
:: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestFilesSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestFilesSize Int64
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxFilesSize = Just l}
clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestFilesSize ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxFilesSize = Nothing}
setMaxRequestParmsSize
:: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestParmsSize :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
setMaxRequestParmsSize Int
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxParmsSize = Just l}
clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
clearMaxRequestParmsSize ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxParmsSize = Nothing}
setMaxHeaderLines :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
Int
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxHeaderLines = Just l}
clearMaxHeaderLines :: ParseRequestBodyOptions -> ParseRequestBodyOptions
ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxHeaderLines = Nothing}
setMaxHeaderLineLength
:: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
Int
l ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxHeaderLineLength = Just l}
clearMaxHeaderLineLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
ParseRequestBodyOptions
p = ParseRequestBodyOptions
p{prboMaxHeaderLineLength = Nothing}
defaultParseRequestBodyOptions :: ParseRequestBodyOptions
defaultParseRequestBodyOptions :: ParseRequestBodyOptions
defaultParseRequestBodyOptions =
ParseRequestBodyOptions
{ prboKeyLength :: Maybe Int
prboKeyLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
32
, prboMaxNumFiles :: Maybe Int
prboMaxNumFiles = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
, prboMaxFileSize :: Maybe Int64
prboMaxFileSize = Maybe Int64
forall a. Maybe a
Nothing
, prboMaxFilesSize :: Maybe Int64
prboMaxFilesSize = Maybe Int64
forall a. Maybe a
Nothing
, prboMaxParmsSize :: Maybe Int
prboMaxParmsSize = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
65336
, prboMaxHeaderLines :: Maybe Int
prboMaxHeaderLines = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
32
, prboMaxHeaderLineLength :: Maybe Int
prboMaxHeaderLineLength = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8190
}
noLimitParseRequestBodyOptions :: ParseRequestBodyOptions
noLimitParseRequestBodyOptions :: ParseRequestBodyOptions
noLimitParseRequestBodyOptions =
ParseRequestBodyOptions
{ prboKeyLength :: Maybe Int
prboKeyLength = Maybe Int
forall a. Maybe a
Nothing
, prboMaxNumFiles :: Maybe Int
prboMaxNumFiles = Maybe Int
forall a. Maybe a
Nothing
, prboMaxFileSize :: Maybe Int64
prboMaxFileSize = Maybe Int64
forall a. Maybe a
Nothing
, prboMaxFilesSize :: Maybe Int64
prboMaxFilesSize = Maybe Int64
forall a. Maybe a
Nothing
, prboMaxParmsSize :: Maybe Int
prboMaxParmsSize = Maybe Int
forall a. Maybe a
Nothing
, prboMaxHeaderLines :: Maybe Int
prboMaxHeaderLines = Maybe Int
forall a. Maybe a
Nothing
, prboMaxHeaderLineLength :: Maybe Int
prboMaxHeaderLineLength = Maybe Int
forall a. Maybe a
Nothing
}
data FileInfo c = FileInfo
{ forall c. FileInfo c -> ByteString
fileName :: S.ByteString
, forall c. FileInfo c -> ByteString
fileContentType :: S.ByteString
, forall c. FileInfo c -> c
fileContent :: c
}
deriving (FileInfo c -> FileInfo c -> Bool
(FileInfo c -> FileInfo c -> Bool)
-> (FileInfo c -> FileInfo c -> Bool) -> Eq (FileInfo c)
forall c. Eq c => FileInfo c -> FileInfo c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => FileInfo c -> FileInfo c -> Bool
== :: FileInfo c -> FileInfo c -> Bool
$c/= :: forall c. Eq c => FileInfo c -> FileInfo c -> Bool
/= :: FileInfo c -> FileInfo c -> Bool
Eq, Int -> FileInfo c -> ShowS
[FileInfo c] -> ShowS
FileInfo c -> String
(Int -> FileInfo c -> ShowS)
-> (FileInfo c -> String)
-> ([FileInfo c] -> ShowS)
-> Show (FileInfo c)
forall c. Show c => Int -> FileInfo c -> ShowS
forall c. Show c => [FileInfo c] -> ShowS
forall c. Show c => FileInfo c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> FileInfo c -> ShowS
showsPrec :: Int -> FileInfo c -> ShowS
$cshow :: forall c. Show c => FileInfo c -> String
show :: FileInfo c -> String
$cshowList :: forall c. Show c => [FileInfo c] -> ShowS
showList :: [FileInfo c] -> ShowS
Show)
type Param = (S.ByteString, S.ByteString)
type File y = (S.ByteString, FileInfo y)
type BackEnd a =
S.ByteString
-> FileInfo ()
-> IO S.ByteString
-> IO a
data RequestBodyType
=
UrlEncoded
|
Multipart S.ByteString
getRequestBodyType :: Request -> Maybe RequestBodyType
getRequestBodyType :: Request -> Maybe RequestBodyType
getRequestBodyType Request
req = do
ctype' <- HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType ([(HeaderName, ByteString)] -> Maybe ByteString)
-> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> [(HeaderName, ByteString)]
requestHeaders Request
req
let (ctype, attrs) = parseContentType ctype'
case ctype of
ByteString
"application/x-www-form-urlencoded" -> RequestBodyType -> Maybe RequestBodyType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return RequestBodyType
UrlEncoded
ByteString
"multipart/form-data" | Just ByteString
bound <- ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"boundary" [(ByteString, ByteString)]
attrs -> RequestBodyType -> Maybe RequestBodyType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestBodyType -> Maybe RequestBodyType)
-> RequestBodyType -> Maybe RequestBodyType
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBodyType
Multipart ByteString
bound
ByteString
_ -> Maybe RequestBodyType
forall a. Maybe a
Nothing
parseContentType
:: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
parseContentType :: ByteString -> (ByteString, [(ByteString, ByteString)])
parseContentType ByteString
a = do
let (ByteString
ctype, ByteString
b) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_semicolon) ByteString
a
attrs :: [(ByteString, ByteString)]
attrs = ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> ByteString -> [(ByteString, ByteString)]
forall {c}. ([(ByteString, ByteString)] -> c) -> ByteString -> c
goAttrs [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> a
id (ByteString -> [(ByteString, ByteString)])
-> ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop Int
1 ByteString
b
in (ByteString
ctype, [(ByteString, ByteString)]
attrs)
where
dq :: ByteString -> ByteString
dq ByteString
s =
if ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_quotedbl Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
ByteString -> Word8
S.last ByteString
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_quotedbl
then HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.tail (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.init ByteString
s
else ByteString
s
goAttrs :: ([(ByteString, ByteString)] -> c) -> ByteString -> c
goAttrs [(ByteString, ByteString)] -> c
front ByteString
bs
| ByteString -> Bool
S.null ByteString
bs = [(ByteString, ByteString)] -> c
front []
| Bool
otherwise =
let (ByteString
x, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_semicolon) ByteString
bs
in ([(ByteString, ByteString)] -> c) -> ByteString -> c
goAttrs ([(ByteString, ByteString)] -> c
front ([(ByteString, ByteString)] -> c)
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (ByteString, ByteString)
goAttr ByteString
x (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
:)) (ByteString -> c) -> ByteString -> c
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop Int
1 ByteString
rest
goAttr :: ByteString -> (ByteString, ByteString)
goAttr ByteString
bs =
let (ByteString
k, ByteString
v') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_equal) ByteString
bs
v :: ByteString
v = Int -> ByteString -> ByteString
S.drop Int
1 ByteString
v'
in (ByteString -> ByteString
strip ByteString
k, ByteString -> ByteString
dq (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
strip ByteString
v)
strip :: ByteString -> ByteString
strip = (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.breakEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_space)
parseRequestBody
:: BackEnd y
-> Request
-> IO ([Param], [File y])
parseRequestBody :: forall y.
BackEnd y -> Request -> IO ([(ByteString, ByteString)], [File y])
parseRequestBody = ParseRequestBodyOptions
-> BackEnd y
-> Request
-> IO ([(ByteString, ByteString)], [File y])
forall y.
ParseRequestBodyOptions
-> BackEnd y
-> Request
-> IO ([(ByteString, ByteString)], [File y])
parseRequestBodyEx ParseRequestBodyOptions
noLimitParseRequestBodyOptions
parseRequestBodyEx
:: ParseRequestBodyOptions
-> BackEnd y
-> Request
-> IO ([Param], [File y])
parseRequestBodyEx :: forall y.
ParseRequestBodyOptions
-> BackEnd y
-> Request
-> IO ([(ByteString, ByteString)], [File y])
parseRequestBodyEx ParseRequestBodyOptions
o BackEnd y
s Request
r =
case Request -> Maybe RequestBodyType
getRequestBodyType Request
r of
Maybe RequestBodyType
Nothing -> ([(ByteString, ByteString)], [File y])
-> IO ([(ByteString, ByteString)], [File y])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
Just RequestBodyType
rbt -> ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO ByteString
-> IO ([(ByteString, ByteString)], [File y])
forall y.
ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO ByteString
-> IO ([(ByteString, ByteString)], [File y])
sinkRequestBodyEx ParseRequestBodyOptions
o BackEnd y
s RequestBodyType
rbt (Request -> IO ByteString
getRequestBodyChunk Request
r)
sinkRequestBody
:: BackEnd y
-> RequestBodyType
-> IO S.ByteString
-> IO ([Param], [File y])
sinkRequestBody :: forall y.
BackEnd y
-> RequestBodyType
-> IO ByteString
-> IO ([(ByteString, ByteString)], [File y])
sinkRequestBody = ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO ByteString
-> IO ([(ByteString, ByteString)], [File y])
forall y.
ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO ByteString
-> IO ([(ByteString, ByteString)], [File y])
sinkRequestBodyEx ParseRequestBodyOptions
noLimitParseRequestBodyOptions
sinkRequestBodyEx
:: ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO S.ByteString
-> IO ([Param], [File y])
sinkRequestBodyEx :: forall y.
ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO ByteString
-> IO ([(ByteString, ByteString)], [File y])
sinkRequestBodyEx ParseRequestBodyOptions
o BackEnd y
s RequestBodyType
r IO ByteString
body = do
ref <- ([(ByteString, ByteString)], [File y])
-> IO (IORef ([(ByteString, ByteString)], [File y]))
forall a. a -> IO (IORef a)
newIORef ([], [])
let add Either (ByteString, ByteString) (File y)
x = IORef ([(ByteString, ByteString)], [File y])
-> (([(ByteString, ByteString)], [File y])
-> (([(ByteString, ByteString)], [File y]), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ([(ByteString, ByteString)], [File y])
ref ((([(ByteString, ByteString)], [File y])
-> (([(ByteString, ByteString)], [File y]), ()))
-> IO ())
-> (([(ByteString, ByteString)], [File y])
-> (([(ByteString, ByteString)], [File y]), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \([(ByteString, ByteString)]
y, [File y]
z) ->
case Either (ByteString, ByteString) (File y)
x of
Left (ByteString, ByteString)
y' -> (((ByteString, ByteString)
y' (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: [(ByteString, ByteString)]
y, [File y]
z), ())
Right File y
z' -> (([(ByteString, ByteString)]
y, File y
z' File y -> [File y] -> [File y]
forall a. a -> [a] -> [a]
: [File y]
z), ())
conduitRequestBodyEx o s r body add
bimap reverse reverse <$> readIORef ref
conduitRequestBodyEx
:: ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO S.ByteString
-> (Either Param (File y) -> IO ())
-> IO ()
conduitRequestBodyEx :: forall y.
ParseRequestBodyOptions
-> BackEnd y
-> RequestBodyType
-> IO ByteString
-> (Either (ByteString, ByteString) (File y) -> IO ())
-> IO ()
conduitRequestBodyEx ParseRequestBodyOptions
o BackEnd y
_ RequestBodyType
UrlEncoded IO ByteString
rbody Either (ByteString, ByteString) (File y) -> IO ()
add = do
let loop :: Int -> ([ByteString] -> [ByteString]) -> IO ByteString
loop Int
size [ByteString] -> [ByteString]
front = do
bs <- IO ByteString
rbody
if S.null bs
then return $ S.concat $ front []
else do
let newsize = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
S.length ByteString
bs
case prboMaxParmsSize o of
Just Int
maxSize ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newsize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxSize) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestParseException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RequestParseException -> IO ()) -> RequestParseException -> IO ()
forall a b. (a -> b) -> a -> b
$
Int -> RequestParseException
MaxParamSizeExceeded Int
newsize
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop newsize $ front . (bs :)
bs <- Int -> ([ByteString] -> [ByteString]) -> IO ByteString
loop Int
0 [ByteString] -> [ByteString]
forall a. a -> a
id
mapM_ (add . Left) $ H.parseSimpleQuery bs
conduitRequestBodyEx ParseRequestBodyOptions
o BackEnd y
backend (Multipart ByteString
bound) IO ByteString
rbody Either (ByteString, ByteString) (File y) -> IO ()
add =
ParseRequestBodyOptions
-> BackEnd y
-> ByteString
-> IO ByteString
-> (Either (ByteString, ByteString) (File y) -> IO ())
-> IO ()
forall y.
ParseRequestBodyOptions
-> BackEnd y
-> ByteString
-> IO ByteString
-> (Either (ByteString, ByteString) (File y) -> IO ())
-> IO ()
parsePiecesEx ParseRequestBodyOptions
o BackEnd y
backend (String -> ByteString
S8.pack String
"--" ByteString -> ByteString -> ByteString
`S.append` ByteString
bound) IO ByteString
rbody Either (ByteString, ByteString) (File y) -> IO ()
add
takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)
takeLine :: Maybe Int -> Source -> IO (Maybe ByteString)
takeLine Maybe Int
maxlen Source
src =
ByteString -> IO (Maybe ByteString)
go ByteString
""
where
go :: ByteString -> IO (Maybe ByteString)
go ByteString
front = do
bs <- Source -> IO ByteString
readSource Source
src
case maxlen of
Just Int
maxlen' ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
S.length ByteString
front Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxlen') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
InvalidRequest -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO InvalidRequest
RequestHeaderFieldsTooLarge
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if S.null bs
then close front
else push front bs
close :: ByteString -> IO (Maybe ByteString)
close ByteString
front = Source -> ByteString -> IO ()
leftover Source
src ByteString
front IO () -> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
push :: ByteString -> ByteString -> IO (Maybe ByteString)
push ByteString
front ByteString
bs = do
let (ByteString
x, ByteString
y) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_lf) ByteString
bs
in if ByteString -> Bool
S.null ByteString
y
then ByteString -> IO (Maybe ByteString)
go (ByteString -> IO (Maybe ByteString))
-> ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
front ByteString -> ByteString -> ByteString
`S.append` ByteString
x
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
S.length ByteString
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Source -> ByteString -> IO ()
leftover Source
src (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop Int
1 ByteString
y
let res :: ByteString
res = ByteString
front ByteString -> ByteString -> ByteString
`S.append` ByteString
x
case Maybe Int
maxlen of
Just Int
maxlen' ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
S.length ByteString
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxlen') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
InvalidRequest -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO InvalidRequest
RequestHeaderFieldsTooLarge
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> IO (Maybe ByteString))
-> ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
killCR ByteString
res
takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString]
takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [ByteString]
takeLines' Maybe Int
lineLength Maybe Int
maxLines Source
source =
[ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Maybe Int -> Maybe Int -> Source -> IO [ByteString]
takeLines'' [] Maybe Int
lineLength Maybe Int
maxLines Source
source
takeLines''
:: [S.ByteString]
-> Maybe Int
-> Maybe Int
-> Source
-> IO [S.ByteString]
takeLines'' :: [ByteString] -> Maybe Int -> Maybe Int -> Source -> IO [ByteString]
takeLines'' [ByteString]
lines Maybe Int
lineLength Maybe Int
maxLines Source
src = do
case Maybe Int
maxLines of
Just Int
maxLines' ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
lines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLines') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestParseException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RequestParseException -> IO ()) -> RequestParseException -> IO ()
forall a b. (a -> b) -> a -> b
$
Int -> RequestParseException
TooManyHeaderLines ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
lines)
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
res <- Maybe Int -> Source -> IO (Maybe ByteString)
takeLine Maybe Int
lineLength Source
src
case res of
Maybe ByteString
Nothing -> [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
lines
Just ByteString
l
| ByteString -> Bool
S.null ByteString
l -> [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
lines
| Bool
otherwise -> [ByteString] -> Maybe Int -> Maybe Int -> Source -> IO [ByteString]
takeLines'' (ByteString
l ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
lines) Maybe Int
lineLength Maybe Int
maxLines Source
src
data Source = Source (IO S.ByteString) (IORef S.ByteString)
mkSource :: IO S.ByteString -> IO Source
mkSource :: IO ByteString -> IO Source
mkSource IO ByteString
f = do
ref <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
S.empty
return $ Source f ref
readSource :: Source -> IO S.ByteString
readSource :: Source -> IO ByteString
readSource (Source IO ByteString
f IORef ByteString
ref) = do
bs <- IORef ByteString
-> (ByteString -> (ByteString, ByteString)) -> IO ByteString
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ByteString
ref ((ByteString -> (ByteString, ByteString)) -> IO ByteString)
-> (ByteString -> (ByteString, ByteString)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> (ByteString
S.empty, ByteString
bs)
if S.null bs
then f
else return bs
leftover :: Source -> S.ByteString -> IO ()
leftover :: Source -> ByteString -> IO ()
leftover (Source IO ByteString
_ IORef ByteString
ref) = IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
ref
parsePiecesEx
:: ParseRequestBodyOptions
-> BackEnd y
-> S.ByteString
-> IO S.ByteString
-> (Either Param (File y) -> IO ())
-> IO ()
parsePiecesEx :: forall y.
ParseRequestBodyOptions
-> BackEnd y
-> ByteString
-> IO ByteString
-> (Either (ByteString, ByteString) (File y) -> IO ())
-> IO ()
parsePiecesEx ParseRequestBodyOptions
o BackEnd y
sink ByteString
bound IO ByteString
rbody Either (ByteString, ByteString) (File y) -> IO ()
add =
IO ByteString -> IO Source
mkSource IO ByteString
rbody IO Source -> (Source -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> Int -> Int64 -> Source -> IO ()
loop Int
0 Int
0 Int
0 Int64
0
where
loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
loop Int
numParms Int
numFiles Int
parmSize Int64
filesSize Source
src = do
_boundLine <- Maybe Int -> Source -> IO (Maybe ByteString)
takeLine (ParseRequestBodyOptions -> Maybe Int
prboMaxHeaderLineLength ParseRequestBodyOptions
o) Source
src
res' <-
takeLines'
(prboMaxHeaderLineLength o)
(prboMaxHeaderLines o)
src
unless (null res') $ do
let ls' = (ByteString -> (HeaderName, ByteString))
-> [ByteString] -> [(HeaderName, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (HeaderName, ByteString)
parsePair [ByteString]
res'
let x = do
cd <- HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
contDisp [(HeaderName, ByteString)]
ls'
let ct = HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
contType [(HeaderName, ByteString)]
ls'
let attrs = ByteString -> [(ByteString, ByteString)]
parseAttrs ByteString
cd
name <- lookup "name" attrs
return (ct, name, lookup "filename" attrs)
case x of
Just (Maybe ByteString
mct, ByteString
name, Just ByteString
filename) -> do
case ParseRequestBodyOptions -> Maybe Int
prboKeyLength ParseRequestBodyOptions
o of
Just Int
maxKeyLength ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
S.length ByteString
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxKeyLength) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestParseException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RequestParseException -> IO ()) -> RequestParseException -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> Int -> RequestParseException
FilenameTooLong ByteString
name Int
maxKeyLength
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case ParseRequestBodyOptions -> Maybe Int
prboMaxNumFiles ParseRequestBodyOptions
o of
Just Int
maxFiles ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numFiles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxFiles) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestParseException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RequestParseException -> IO ()) -> RequestParseException -> IO ()
forall a b. (a -> b) -> a -> b
$
Int -> RequestParseException
MaxFileNumberExceeded Int
numFiles
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let ct :: ByteString
ct = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"application/octet-stream" Maybe ByteString
mct
fi0 :: FileInfo ()
fi0 = ByteString -> ByteString -> () -> FileInfo ()
forall c. ByteString -> ByteString -> c -> FileInfo c
FileInfo ByteString
filename ByteString
ct ()
fs :: [Int64]
fs =
[Maybe Int64] -> [Int64]
forall a. [Maybe a] -> [a]
catMaybes
[ ParseRequestBodyOptions -> Maybe Int64
prboMaxFileSize ParseRequestBodyOptions
o
, Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
subtract Int64
filesSize (Int64 -> Int64) -> Maybe Int64 -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseRequestBodyOptions -> Maybe Int64
prboMaxFilesSize ParseRequestBodyOptions
o
]
mfs :: Maybe Int64
mfs = if [Int64] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int64]
fs then Maybe Int64
forall a. Maybe a
Nothing else Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ [Int64] -> Int64
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int64]
fs
((wasFound, fileSize), y) <- ByteString
-> ByteString
-> FileInfo ()
-> BackEnd y
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), y)
forall y.
ByteString
-> ByteString
-> FileInfo ()
-> BackEnd y
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), y)
sinkTillBound' ByteString
bound ByteString
name FileInfo ()
fi0 BackEnd y
sink Source
src Maybe Int64
mfs
let newFilesSize = Int64
filesSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
fileSize
add $ Right (name, fi0{fileContent = y})
when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
Just (Maybe ByteString
_ct, ByteString
name, Maybe ByteString
Nothing) -> do
case ParseRequestBodyOptions -> Maybe Int
prboKeyLength ParseRequestBodyOptions
o of
Just Int
maxKeyLength ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
S.length ByteString
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxKeyLength) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestParseException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RequestParseException -> IO ()) -> RequestParseException -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> Int -> RequestParseException
ParamNameTooLong ByteString
name Int
maxKeyLength
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let seed :: a -> a
seed = a -> a
forall a. a -> a
id
let iter :: ([a] -> c) -> a -> m ([a] -> c)
iter [a] -> c
front a
bs = ([a] -> c) -> m ([a] -> c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (([a] -> c) -> m ([a] -> c)) -> ([a] -> c) -> m ([a] -> c)
forall a b. (a -> b) -> a -> b
$ [a] -> c
front ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) a
bs
((wasFound, _fileSize), front) <-
ByteString
-> (([ByteString] -> [ByteString])
-> ByteString -> IO ([ByteString] -> [ByteString]))
-> ([ByteString] -> [ByteString])
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), [ByteString] -> [ByteString])
forall x.
ByteString
-> (x -> ByteString -> IO x)
-> x
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), x)
sinkTillBound
ByteString
bound
([ByteString] -> [ByteString])
-> ByteString -> IO ([ByteString] -> [ByteString])
forall {m :: * -> *} {a} {c}.
Monad m =>
([a] -> c) -> a -> m ([a] -> c)
iter
[ByteString] -> [ByteString]
forall a. a -> a
seed
Source
src
(Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Maybe Int -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseRequestBodyOptions -> Maybe Int
prboMaxParmsSize ParseRequestBodyOptions
o)
let bs = [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
let x' = (ByteString
name, ByteString
bs)
let newParmSize = Int
parmSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
S.length ByteString
name Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
S.length ByteString
bs
case prboMaxParmsSize o of
Just Int
maxParmSize ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newParmSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxParmSize) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestParseException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RequestParseException -> IO ()) -> RequestParseException -> IO ()
forall a b. (a -> b) -> a -> b
$
Int -> RequestParseException
MaxParamSizeExceeded Int
newParmSize
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
add $ Left x'
when wasFound $
loop
(numParms + 1)
numFiles
newParmSize
filesSize
src
Maybe (Maybe ByteString, ByteString, Maybe ByteString)
_ -> do
let seed :: ()
seed = ()
iter :: () -> p -> m ()
iter () p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
((wasFound, _fileSize), ()) <- ByteString
-> (() -> ByteString -> IO ())
-> ()
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), ())
forall x.
ByteString
-> (x -> ByteString -> IO x)
-> x
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), x)
sinkTillBound ByteString
bound () -> ByteString -> IO ()
forall {m :: * -> *} {p}. Monad m => () -> p -> m ()
iter ()
seed Source
src Maybe Int64
forall a. Maybe a
Nothing
when wasFound $ loop numParms numFiles parmSize filesSize src
where
contDisp :: HeaderName
contDisp = ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack String
"Content-Disposition"
contType :: HeaderName
contType = ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack String
"Content-Type"
parsePair :: ByteString -> (HeaderName, ByteString)
parsePair ByteString
s =
let (ByteString
x, ByteString
y) = Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard Word8
_colon ByteString
s
in (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
mk ByteString
x, (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space) ByteString
y)
data RequestParseException
= MaxParamSizeExceeded Int
| ParamNameTooLong S.ByteString Int
| MaxFileNumberExceeded Int
| FilenameTooLong S.ByteString Int
| Int
deriving (RequestParseException -> RequestParseException -> Bool
(RequestParseException -> RequestParseException -> Bool)
-> (RequestParseException -> RequestParseException -> Bool)
-> Eq RequestParseException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestParseException -> RequestParseException -> Bool
== :: RequestParseException -> RequestParseException -> Bool
$c/= :: RequestParseException -> RequestParseException -> Bool
/= :: RequestParseException -> RequestParseException -> Bool
Eq, Typeable)
instance E.Exception RequestParseException
instance Show RequestParseException where
show :: RequestParseException -> String
show = \case
MaxParamSizeExceeded Int
lmax -> [String] -> String
unwords [String
"maximum parameter size exceeded:", Int -> String
forall a. Show a => a -> String
show Int
lmax]
ParamNameTooLong ByteString
s Int
lmax -> [String] -> String
unwords [String
"parameter name", ByteString -> String
S8.unpack ByteString
s, String
"is too long:", Int -> String
forall a. Show a => a -> String
show Int
lmax]
MaxFileNumberExceeded Int
lmax -> [String] -> String
unwords [String
"maximum number of files exceeded:", Int -> String
forall a. Show a => a -> String
show Int
lmax]
FilenameTooLong ByteString
fn Int
lmax ->
[String] -> String
unwords [String
"file name", ByteString -> String
S8.unpack ByteString
fn, String
"too long:", Int -> String
forall a. Show a => a -> String
show Int
lmax]
TooManyHeaderLines Int
nmax -> [String] -> String
unwords [String
"Too many lines in mime/multipart header:", Int -> String
forall a. Show a => a -> String
show Int
nmax]
data Bound
= FoundBound S.ByteString S.ByteString
| NoBound
| PartialBound
deriving (Bound -> Bound -> Bool
(Bound -> Bound -> Bool) -> (Bound -> Bound -> Bool) -> Eq Bound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bound -> Bound -> Bool
== :: Bound -> Bound -> Bool
$c/= :: Bound -> Bound -> Bool
/= :: Bound -> Bound -> Bool
Eq, Int -> Bound -> ShowS
[Bound] -> ShowS
Bound -> String
(Int -> Bound -> ShowS)
-> (Bound -> String) -> ([Bound] -> ShowS) -> Show Bound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bound -> ShowS
showsPrec :: Int -> Bound -> ShowS
$cshow :: Bound -> String
show :: Bound -> String
$cshowList :: [Bound] -> ShowS
showList :: [Bound] -> ShowS
Show)
findBound :: S.ByteString -> S.ByteString -> Bound
findBound :: ByteString -> ByteString -> Bound
findBound ByteString
b ByteString
bs = (ByteString, ByteString) -> Bound
handleBreak ((ByteString, ByteString) -> Bound)
-> (ByteString, ByteString) -> Bound
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
S.breakSubstring ByteString
b ByteString
bs
where
handleBreak :: (ByteString, ByteString) -> Bound
handleBreak (ByteString
h, ByteString
t)
| ByteString -> Bool
S.null ByteString
t = [Int] -> Bound
go [Int
lowBound .. ByteString -> Int
S.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
| Bool
otherwise = ByteString -> ByteString -> Bound
FoundBound ByteString
h (ByteString -> Bound) -> ByteString -> Bound
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
b) ByteString
t
lowBound :: Int
lowBound = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
b
go :: [Int] -> Bound
go [] = Bound
NoBound
go (Int
i : [Int]
is)
| [Int] -> [Int] -> Bool
mismatch [Int
0 .. ByteString -> Int
S.length ByteString
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Int
i .. ByteString -> Int
S.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] = [Int] -> Bound
go [Int]
is
| Bool
otherwise =
let endI :: Int
endI = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
S.length ByteString
b
in if Int
endI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
S.length ByteString
bs
then Bound
PartialBound
else ByteString -> ByteString -> Bound
FoundBound (Int -> ByteString -> ByteString
S.take Int
i ByteString
bs) (Int -> ByteString -> ByteString
S.drop Int
endI ByteString
bs)
mismatch :: [Int] -> [Int] -> Bool
mismatch [] [Int]
_ = Bool
False
mismatch [Int]
_ [] = Bool
False
mismatch (Int
x : [Int]
xs) (Int
y : [Int]
ys)
| HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
b Int
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
bs Int
y = [Int] -> [Int] -> Bool
mismatch [Int]
xs [Int]
ys
| Bool
otherwise = Bool
True
sinkTillBound'
:: S.ByteString
-> S.ByteString
-> FileInfo ()
-> BackEnd y
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), y)
sinkTillBound' :: forall y.
ByteString
-> ByteString
-> FileInfo ()
-> BackEnd y
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), y)
sinkTillBound' ByteString
bound ByteString
name FileInfo ()
fi BackEnd y
sink Source
src Maybe Int64
max' = do
(next, final) <- ByteString
-> Source -> Maybe Int64 -> IO (IO ByteString, IO (Bool, Int64))
wrapTillBound ByteString
bound Source
src Maybe Int64
max'
y <- sink name fi next
b <- final
return (b, y)
data WTB
= WTBWorking (S.ByteString -> S.ByteString)
| WTBDone Bool
wrapTillBound
:: S.ByteString
-> Source
-> Maybe Int64
-> IO (IO S.ByteString, IO (Bool, Int64))
wrapTillBound :: ByteString
-> Source -> Maybe Int64 -> IO (IO ByteString, IO (Bool, Int64))
wrapTillBound ByteString
bound Source
src Maybe Int64
max' = do
ref <- WTB -> IO (IORef WTB)
forall a. a -> IO (IORef a)
newIORef (WTB -> IO (IORef WTB)) -> WTB -> IO (IORef WTB)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> WTB
WTBWorking ByteString -> ByteString
forall a. a -> a
id
sref <- newIORef (0 :: Int64)
return (go ref sref, final ref sref)
where
final :: IORef WTB -> IORef b -> IO (Bool, b)
final IORef WTB
ref IORef b
sref = do
x <- IORef WTB -> IO WTB
forall a. IORef a -> IO a
readIORef IORef WTB
ref
case x of
WTBWorking ByteString -> ByteString
_ -> String -> IO (Bool, b)
forall a. HasCallStack => String -> a
error String
"wrapTillBound did not finish"
WTBDone Bool
y -> do
siz <- IORef b -> IO b
forall a. IORef a -> IO a
readIORef IORef b
sref
return (y, siz)
go :: IORef WTB -> IORef Int64 -> IO ByteString
go IORef WTB
ref IORef Int64
sref = do
state <- IORef WTB -> IO WTB
forall a. IORef a -> IO a
readIORef IORef WTB
ref
case state of
WTBDone Bool
_ -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
S.empty
WTBWorking ByteString -> ByteString
front -> do
bs <- Source -> IO ByteString
readSource Source
src
cur <- atomicModifyIORef' sref $ \Int64
cur ->
let new :: Int64
new = Int64
cur Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
bs) in (Int64
new, Int64
new)
case max' of
Just Int64
max'' | Int64
cur Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
max'' -> InvalidRequest -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO InvalidRequest
PayloadTooLarge
Maybe Int64
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if S.null bs
then do
writeIORef ref $ WTBDone False
return $ front bs
else push $ front bs
where
push :: ByteString -> IO ByteString
push ByteString
bs = do
case ByteString -> ByteString -> Bound
findBound ByteString
bound ByteString
bs of
FoundBound ByteString
before ByteString
after -> do
let before' :: ByteString
before' = ByteString -> ByteString
killCRLF ByteString
before
Source -> ByteString -> IO ()
leftover Source
src ByteString
after
IORef WTB -> WTB -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WTB
ref (WTB -> IO ()) -> WTB -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> WTB
WTBDone Bool
True
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
before'
Bound
NoBound -> do
let (ByteString
toEmit, ByteString -> ByteString
front') =
if Bool -> Bool
not (ByteString -> Bool
S8.null ByteString
bs) Bool -> Bool -> Bool
&& ByteString -> Char
S8.last ByteString
bs Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\r', Char
'\n']
then
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (ByteString -> Int
S.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ByteString
bs
in (ByteString
x, ByteString -> ByteString -> ByteString
S.append ByteString
y)
else (ByteString
bs, ByteString -> ByteString
forall a. a -> a
id)
IORef WTB -> WTB -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WTB
ref (WTB -> IO ()) -> WTB -> IO ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> WTB
WTBWorking ByteString -> ByteString
front'
if ByteString -> Bool
S.null ByteString
toEmit
then IORef WTB -> IORef Int64 -> IO ByteString
go IORef WTB
ref IORef Int64
sref
else ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
toEmit
Bound
PartialBound -> do
IORef WTB -> WTB -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WTB
ref (WTB -> IO ()) -> WTB -> IO ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> WTB
WTBWorking ((ByteString -> ByteString) -> WTB)
-> (ByteString -> ByteString) -> WTB
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
S.append ByteString
bs
IORef WTB -> IORef Int64 -> IO ByteString
go IORef WTB
ref IORef Int64
sref
sinkTillBound
:: S.ByteString
-> (x -> S.ByteString -> IO x)
-> x
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), x)
sinkTillBound :: forall x.
ByteString
-> (x -> ByteString -> IO x)
-> x
-> Source
-> Maybe Int64
-> IO ((Bool, Int64), x)
sinkTillBound ByteString
bound x -> ByteString -> IO x
iter x
seed0 Source
src Maybe Int64
max' = do
(next, final) <- ByteString
-> Source -> Maybe Int64 -> IO (IO ByteString, IO (Bool, Int64))
wrapTillBound ByteString
bound Source
src Maybe Int64
max'
let loop x
seed = do
bs <- IO ByteString
next
if S.null bs
then return seed
else iter seed bs >>= loop
seed <- loop seed0
b <- final
return (b, seed)
parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
parseAttrs :: ByteString -> [(ByteString, ByteString)]
parseAttrs = (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ByteString, ByteString)
go ([ByteString] -> [(ByteString, ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
S.split Word8
_semicolon
where
tw :: ByteString -> ByteString
tw = (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_space)
dq :: ByteString -> ByteString
dq ByteString
s =
if ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_quotedbl Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
ByteString -> Word8
S.last ByteString
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_quotedbl
then HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.tail (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.init ByteString
s
else ByteString
s
go :: ByteString -> (ByteString, ByteString)
go ByteString
s =
let (ByteString
x, ByteString
y) = Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard Word8
_equal ByteString
s
in (ByteString -> ByteString
tw ByteString
x, ByteString -> ByteString
dq (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
tw ByteString
y)
killCRLF :: S.ByteString -> S.ByteString
killCRLF :: ByteString -> ByteString
killCRLF ByteString
bs
| ByteString -> Bool
S.null ByteString
bs Bool -> Bool -> Bool
|| HasCallStack => ByteString -> Word8
ByteString -> Word8
S.last ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_lf = ByteString
bs
| Bool
otherwise = ByteString -> ByteString
killCR (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.init ByteString
bs
killCR :: S.ByteString -> S.ByteString
killCR :: ByteString -> ByteString
killCR ByteString
bs
| ByteString -> Bool
S.null ByteString
bs Bool -> Bool -> Bool
|| HasCallStack => ByteString -> Word8
ByteString -> Word8
S.last ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_cr = ByteString
bs
| Bool
otherwise = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S.init ByteString
bs