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 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 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 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 = forall a b. a -> b -> [(a, b)] -> [(a, b)]
add a
k b
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= a
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)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 forall a. Eq a => a -> a -> Bool
== a
k    = [(a, b)]
l
            | Bool
otherwise = (a
x,b
y) 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
"unix socket " forall a. [a] -> [a] -> [a]
++ FilePath
u
    SockAddr
_              -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PortNumber
port -> FilePath
"port " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show PortNumber
port) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bforall a. a -> [a] -> [a]
:)) Maybe Kilobytes
maxSize
    where checkBodyLength :: Maybe Kilobytes ->  IO ()
          checkBodyLength :: Maybe Kilobytes -> IO ()
checkBodyLength (Just Kilobytes
maxSize') = [ByteString] -> IO [ByteString]
prefix [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ByteString]
bodySoFar -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ByteString] -> Kilobytes -> Bool
isBigger [ByteString]
bodySoFar Kilobytes
maxSize') forall {b}. IO b
readUntilEmpty
          checkBodyLength Maybe Kilobytes
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
          isBigger :: [ByteString] -> Kilobytes -> Bool
isBigger [ByteString]
bodySoFar Kilobytes
maxSize' = (ByteString -> Kilobytes
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ [ByteString]
bodySoFar) forall a. Ord a => a -> a -> Bool
> Kilobytes
maxSize' forall a. Num a => a -> a -> a
* Kilobytes
1024
          readUntilEmpty :: IO b
readUntilEmpty = IO ByteString
rbody forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
b -> if ByteString -> Bool
B.null ByteString
b then forall a e. Exception e => e -> a
throw (ByteString -> Status -> ScottyException
RequestException (Text -> ByteString
ES.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
TP.pack forall a b. (a -> b) -> a -> b
$ FilePath
"Request is too big Jim!") Status
status413) else IO b
readUntilEmpty