    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE BangPatterns #-}

    module Network.Wai.Handler.Warp.ResponseHeader (composeHeader) where

    import qualified Data.ByteString as S
    import Data.ByteString.Internal (create)
    import qualified Data.CaseInsensitive as CI
    import Foreign.Ptr
    import GHC.Storable
    import qualified Network.HTTP.Types as H

    import Network.Wai.Handler.Warp.Buffer (copy)
    import Network.Wai.Handler.Warp.Imports

    ----------------------------------------------------------------

    composeHeader :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> IO ByteString
    composeHeader :: HttpVersion -> Status -> ResponseHeaders -> IO ByteString
    composeHeader !HttpVersion
    httpversion !Status
    status !ResponseHeaders
    responseHeaders = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    create Int
    len ((Ptr Word8 -> IO ()) -> IO ByteString)
    -> (Ptr Word8 -> IO ()) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ptr :: Ptr Word8
    ptr -> do
        Ptr Word8
    ptr1 <- Ptr Word8 -> HttpVersion -> Status -> IO (Ptr Word8)
    copyStatus Ptr Word8
    ptr HttpVersion
    httpversion Status
    status
        Ptr Word8
    ptr2 <- Ptr Word8 -> ResponseHeaders -> IO (Ptr Word8)
    copyHeaders Ptr Word8
    ptr1 ResponseHeaders
    responseHeaders
        IO (Ptr Word8) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Ptr Word8 -> IO (Ptr Word8)
    copyCRLF Ptr Word8
    ptr2
      where
        !len :: Int
    len = 17 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    slen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int -> (CI ByteString, ByteString) -> Int)
    -> Int -> ResponseHeaders -> Int
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Int -> (CI ByteString, ByteString) -> Int
    fieldLength 0 ResponseHeaders
    responseHeaders
        fieldLength :: Int -> (CI ByteString, ByteString) -> Int
    fieldLength !Int
    l (!CI ByteString
    k,!ByteString
    v) = Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length (CI ByteString -> ByteString
    forall s. CI s -> s
    CI.original CI ByteString
    k) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    v Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 4
        !slen :: Int
    slen = ByteString -> Int
    S.length (ByteString -> Int) -> ByteString -> Int
    forall a b. (a -> b) -> a -> b
    $ Status -> ByteString
    H.statusMessage Status
    status

    httpVer11 :: ByteString
    httpVer11 :: ByteString
    httpVer11 = "HTTP/1.1 "

    httpVer10 :: ByteString
    httpVer10 :: ByteString
    httpVer10 = "HTTP/1.0 "

    {-# INLINE copyStatus #-}
    copyStatus :: Ptr Word8 -> H.HttpVersion -> H.Status -> IO (Ptr Word8)
    copyStatus :: Ptr Word8 -> HttpVersion -> Status -> IO (Ptr Word8)
    copyStatus !Ptr Word8
    ptr !HttpVersion
    httpversion !Status
    status = do
        Ptr Word8
    ptr1 <- Ptr Word8 -> ByteString -> IO (Ptr Word8)
    copy Ptr Word8
    ptr ByteString
    httpVer
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr1 0 (Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    r2)
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr1 1 (Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    r1)
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr1 2 (Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    r0)
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr1 3 Word8
    spc
        Ptr Word8
    ptr2 <- Ptr Word8 -> ByteString -> IO (Ptr Word8)
    copy (Ptr Word8
    ptr1 Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` 4) (Status -> ByteString
    H.statusMessage Status
    status)
        Ptr Word8 -> IO (Ptr Word8)
    copyCRLF Ptr Word8
    ptr2
      where
        httpVer :: ByteString
    httpVer
          | HttpVersion
    httpversion HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Int -> HttpVersion
    H.HttpVersion 1 1 = ByteString
    httpVer11
          | Bool
    otherwise = ByteString
    httpVer10
        (q0 :: Int
    q0,r0 :: Int
    r0) = Status -> Int
    H.statusCode Status
    status Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` 10
        (q1 :: Int
    q1,r1 :: Int
    r1) = Int
    q0 Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` 10
        r2 :: Int
    r2 = Int
    q1 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 10

    {-# INLINE copyHeaders #-}
    copyHeaders :: Ptr Word8 -> [H.Header] -> IO (Ptr Word8)
    copyHeaders :: Ptr Word8 -> ResponseHeaders -> IO (Ptr Word8)
    copyHeaders !Ptr Word8
    ptr [] = Ptr Word8 -> IO (Ptr Word8)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr Word8
    ptr
    copyHeaders !Ptr Word8
    ptr (h :: (CI ByteString, ByteString)
    h:hs :: ResponseHeaders
    hs) = do
        Ptr Word8
    ptr1 <- Ptr Word8 -> (CI ByteString, ByteString) -> IO (Ptr Word8)
    copyHeader Ptr Word8
    ptr (CI ByteString, ByteString)
    h
        Ptr Word8 -> ResponseHeaders -> IO (Ptr Word8)
    copyHeaders Ptr Word8
    ptr1 ResponseHeaders
    hs

    {-# INLINE copyHeader #-}
    copyHeader :: Ptr Word8 -> H.Header -> IO (Ptr Word8)
    copyHeader :: Ptr Word8 -> (CI ByteString, ByteString) -> IO (Ptr Word8)
    copyHeader !Ptr Word8
    ptr (k :: CI ByteString
    k,v :: ByteString
    v) = do
        Ptr Word8
    ptr1 <- Ptr Word8 -> ByteString -> IO (Ptr Word8)
    copy Ptr Word8
    ptr (CI ByteString -> ByteString
    forall s. CI s -> s
    CI.original CI ByteString
    k)
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr1 0 Word8
    colon
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr1 1 Word8
    spc
        Ptr Word8
    ptr2 <- Ptr Word8 -> ByteString -> IO (Ptr Word8)
    copy (Ptr Word8
    ptr1 Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` 2) ByteString
    v
        Ptr Word8 -> IO (Ptr Word8)
    copyCRLF Ptr Word8
    ptr2

    {-# INLINE copyCRLF #-}
    copyCRLF :: Ptr Word8 -> IO (Ptr Word8)
    copyCRLF :: Ptr Word8 -> IO (Ptr Word8)
    copyCRLF !Ptr Word8
    ptr = do
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr 0 Word8
    cr
        Ptr Word8 -> Int -> Word8 -> IO ()
    writeWord8OffPtr Ptr Word8
    ptr 1 Word8
    lf
        Ptr Word8 -> IO (Ptr Word8)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $! Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` 2

    zero :: Word8
    zero :: Word8
    zero = 48
    spc :: Word8
    spc :: Word8
    spc = 32
    colon :: Word8
    colon :: Word8
    colon = 58
    cr :: Word8
    cr :: Word8
    cr = 13
    lf :: Word8
    lf :: Word8
    lf = 10