    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# options_ghc -Wno-unused-imports #-}
    module Web.Scotty.Util
        ( lazyTextToStrictByteString
        , strictByteStringToLazyText
        , decodeUtf8Lenient
        , mkResponse
        , replace
        , add
        , addIfNotPresent
        , socketDescription
        , readRequestBody
        ) where

    import Network.Socket (SockAddr(..), Socket, getSocketName, socketPort)
    import Network.Wai

    import Control.Exception
    import Control.Monad (when)
    import qualified Data.ByteString as B
    import qualified Data.Text as TP (Text, pack)
    import qualified Data.Text.Lazy as TL
    import           Data.Text.Encoding as ES
    import qualified Data.Text.Encoding.Error as ES

    import Web.Scotty.Internal.Types

    lazyTextToStrictByteString :: TL.Text -> B.ByteString
    lazyTextToStrictByteString :: Text -> ByteString
    lazyTextToStrictByteString = Text -> ByteString
    ES.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    TL.toStrict

    strictByteStringToLazyText :: B.ByteString -> TL.Text
    strictByteStringToLazyText :: ByteString -> Text
    strictByteStringToLazyText = Text -> Text
    TL.fromStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OnDecodeError -> ByteString -> Text
    ES.decodeUtf8With OnDecodeError
    ES.lenientDecode

    #if !MIN_VERSION_text(2,0,0)
    decodeUtf8Lenient :: B.ByteString -> TP.Text
    decodeUtf8Lenient = ES.decodeUtf8With ES.lenientDecode
    #endif

    -- Note: we currently don't support responseRaw, which may be useful
    -- for websockets. However, we always read the request body, which
    -- is incompatible with responseRaw responses.
    mkResponse :: ScottyResponse -> Response
    mkResponse :: ScottyResponse -> Response
    mkResponse ScottyResponse
    sr = case ScottyResponse -> Content
    srContent ScottyResponse
    sr of
                        ContentBuilder  Builder
    b   -> Status -> ResponseHeaders -> Builder -> Response
    responseBuilder Status
    s ResponseHeaders
    h Builder
    b
                        ContentFile     FilePath
    f   -> Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
    responseFile Status
    s ResponseHeaders
    h FilePath
    f Maybe FilePart
    forall a. Maybe a
    Nothing
                        ContentStream   StreamingBody
    str -> Status -> ResponseHeaders -> StreamingBody -> Response
    responseStream Status
    s ResponseHeaders
    h StreamingBody
    str
                        ContentResponse Response
    res -> Response
    res
        where s :: Status
    s = ScottyResponse -> Status
    srStatus ScottyResponse
    sr
              h :: ResponseHeaders
    h = ScottyResponse -> ResponseHeaders
    srHeaders ScottyResponse
    sr

    -- Note: we assume headers are not sensitive to order here (RFC 2616 specifies they are not)
    replace :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
    replace :: forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
    replace a
    k b
    v = a -> b -> [(a, b)] -> [(a, b)]
    forall a b. a -> b -> [(a, b)] -> [(a, b)]
    add a
    k b
    v ([(a, b)] -> [(a, b)])
    -> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    k) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, b) -> a
    forall a b. (a, b) -> a
    fst)

    add :: a -> b -> [(a,b)] -> [(a,b)]
    add :: forall a b. a -> b -> [(a, b)] -> [(a, b)]
    add a
    k b
    v [(a, b)]
    m = (a
    k,b
    v)(a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    :[(a, b)]
    m

    addIfNotPresent :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
    addIfNotPresent :: forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
    addIfNotPresent a
    k b
    v = [(a, b)] -> [(a, b)]
    go
        where go :: [(a, b)] -> [(a, b)]
    go []         = [(a
    k,b
    v)]
              go l :: [(a, b)]
    l@((a
    x,b
    y):[(a, b)]
    r)
                | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    k    = [(a, b)]
    l
                | Bool
    otherwise = (a
    x,b
    y) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)] -> [(a, b)]
    go [(a, b)]
    r

    -- Assemble a description from the Socket's PortID.
    socketDescription :: Socket -> IO String
    socketDescription :: Socket -> IO FilePath
    socketDescription Socket
    sock = do
      sockName <- Socket -> IO SockAddr
    getSocketName Socket
    sock
      case sockName of
        SockAddrUnix FilePath
    u -> FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "unix socket " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    u
        SockAddr
    _              -> (PortNumber -> FilePath) -> IO PortNumber -> IO FilePath
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\PortNumber
    port -> FilePath
    "port " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ PortNumber -> FilePath
    forall a. Show a => a -> FilePath
    show PortNumber
    port) (IO PortNumber -> IO FilePath) -> IO PortNumber -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ Socket -> IO PortNumber
    socketPort Socket
    sock

    -- | return request body or throw a 'ScottyException' if request body too big
    readRequestBody :: IO B.ByteString -- ^ body chunk reader
                    -> ([B.ByteString] -> IO [B.ByteString])
                    -> Maybe Kilobytes -- ^ max body size
                    -> IO [B.ByteString]
    readRequestBody :: IO ByteString
    -> ([ByteString] -> IO [ByteString])
    -> Maybe Kilobytes
    -> IO [ByteString]
    readRequestBody IO ByteString
    rbody [ByteString] -> IO [ByteString]
    prefix Maybe Kilobytes
    maxSize = do
      b <- IO ByteString
    rbody
      if B.null b then
           prefix []
        else
          do
            checkBodyLength maxSize
            readRequestBody rbody (prefix . (b:)) maxSize
        where checkBodyLength :: Maybe Kilobytes ->  IO ()
              checkBodyLength :: Maybe Kilobytes -> IO ()
    checkBodyLength = \case
                Just Kilobytes
    maxSize' -> do
                  bodySoFar <- [ByteString] -> IO [ByteString]
    prefix []
                  when (bodySoFar `isBigger` maxSize') readUntilEmpty
                Maybe Kilobytes
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              isBigger :: [ByteString] -> Kilobytes -> Bool
    isBigger [ByteString]
    bodySoFar Kilobytes
    maxSize' = (ByteString -> Kilobytes
    B.length (ByteString -> Kilobytes)
    -> ([ByteString] -> ByteString) -> [ByteString] -> Kilobytes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    B.concat ([ByteString] -> Kilobytes) -> [ByteString] -> Kilobytes
    forall a b. (a -> b) -> a -> b
    $ [ByteString]
    bodySoFar) Kilobytes -> Kilobytes -> Bool
    forall a. Ord a => a -> a -> Bool
    > Kilobytes
    maxSize' Kilobytes -> Kilobytes -> Kilobytes
    forall a. Num a => a -> a -> a
    * Kilobytes
    1024 -- XXX this looks both inefficient and wrong
              readUntilEmpty :: IO b
    readUntilEmpty = do
                b <- IO ByteString
    rbody
                if B.null b
                  then throwIO RequestTooLarge
                  else readUntilEmpty