    module Web.Scotty.Util
        ( lazyTextToStrictByteString
        , strictByteStringToLazyText
        , setContent
        , setHeaderWith
        , setStatus
        , mkResponse
        , replace
        , add
        , addIfNotPresent
        , socketDescription
        , readRequestBody
        ) where

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

    import Control.Monad (when)
    import Control.Exception (throw)

    import Network.HTTP.Types

    import qualified Data.ByteString as B
    import qualified Data.Text as TP (pack)
    import qualified Data.Text.Lazy as T
    import qualified Data.Text.Encoding as ES
    import qualified Data.Text.Encoding.Error as ES

    import Web.Scotty.Internal.Types

    lazyTextToStrictByteString :: T.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
    T.toStrict

    strictByteStringToLazyText :: B.ByteString -> T.Text
    strictByteStringToLazyText :: ByteString -> Text
    strictByteStringToLazyText = Text -> Text
    T.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

    setContent :: Content -> ScottyResponse -> ScottyResponse
    setContent :: Content -> ScottyResponse -> ScottyResponse
    setContent Content
    c ScottyResponse
    sr = ScottyResponse
    sr { srContent :: Content
    srContent = Content
    c }

    setHeaderWith :: ([(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> ScottyResponse -> ScottyResponse
    setHeaderWith :: ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
    -> ScottyResponse -> ScottyResponse
    setHeaderWith [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    f ScottyResponse
    sr = ScottyResponse
    sr { srHeaders :: [(HeaderName, ByteString)]
    srHeaders = [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    f (ScottyResponse -> [(HeaderName, ByteString)]
    srHeaders ScottyResponse
    sr) }

    setStatus :: Status -> ScottyResponse -> ScottyResponse
    setStatus :: Status -> ScottyResponse -> ScottyResponse
    setStatus Status
    s ScottyResponse
    sr = ScottyResponse
    sr { srStatus :: Status
    srStatus = Status
    s }

    -- 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 -> [(HeaderName, ByteString)] -> Builder -> Response
    responseBuilder Status
    s [(HeaderName, ByteString)]
    h Builder
    b
                        ContentFile FilePath
    f     -> Status
    -> [(HeaderName, ByteString)]
    -> FilePath
    -> Maybe FilePart
    -> Response
    responseFile Status
    s [(HeaderName, ByteString)]
    h FilePath
    f Maybe FilePart
    forall a. Maybe a
    Nothing
                        ContentStream StreamingBody
    str -> Status -> [(HeaderName, ByteString)] -> StreamingBody -> Response
    responseStream Status
    s [(HeaderName, ByteString)]
    h StreamingBody
    str
        where s :: Status
    s = ScottyResponse -> Status
    srStatus ScottyResponse
    sr
              h :: [(HeaderName, ByteString)]
    h = ScottyResponse -> [(HeaderName, ByteString)]
    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
      SockAddr
    sockName <- Socket -> IO SockAddr
    getSocketName Socket
    sock
      case SockAddr
    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 an exception if request body too big
    readRequestBody :: IO B.ByteString -> ([B.ByteString] -> IO [B.ByteString]) -> Maybe Kilobytes ->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
      ByteString
    b <- IO ByteString
    rbody
      if ByteString -> Bool
    B.null ByteString
    b then
           [ByteString] -> IO [ByteString]
    prefix []
        else
          do
            Maybe Kilobytes -> IO ()
    checkBodyLength Maybe Kilobytes
    maxSize
            IO ByteString
    -> ([ByteString] -> IO [ByteString])
    -> Maybe Kilobytes
    -> IO [ByteString]
    readRequestBody IO ByteString
    rbody ([ByteString] -> IO [ByteString]
    prefix ([ByteString] -> IO [ByteString])
    -> ([ByteString] -> [ByteString])
    -> [ByteString]
    -> IO [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString
    bByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :)) Maybe Kilobytes
    maxSize
        where checkBodyLength :: Maybe Kilobytes ->  IO ()
              checkBodyLength :: Maybe Kilobytes -> IO ()
    checkBodyLength (Just Kilobytes
    maxSize') = [ByteString] -> IO [ByteString]
    prefix [] IO [ByteString] -> ([ByteString] -> 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
    >>= \[ByteString]
    bodySoFar -> Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([ByteString] -> Kilobytes -> Bool
    isBigger [ByteString]
    bodySoFar Kilobytes
    maxSize') IO ()
    forall {b}. IO b
    readUntilEmpty
              checkBodyLength 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
              readUntilEmpty :: IO b
    readUntilEmpty = IO ByteString
    rbody IO ByteString -> (ByteString -> IO b) -> IO b
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ByteString
    b -> if ByteString -> Bool
    B.null ByteString
    b then ScottyException -> IO b
    forall a e. Exception e => e -> a
    throw (ByteString -> Status -> ScottyException
    RequestException (Text -> ByteString
    ES.encodeUtf8 (Text -> ByteString)
    -> (FilePath -> Text) -> FilePath -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text
    TP.pack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Request is too big Jim!") Status
    status413) else IO b
    readUntilEmpty