    {-# LANGUAGE OverloadedStrings #-}

    module Network.HTTP.Semantics.Status (
        getStatus,
        setStatus,
    ) where

    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as C8
    import Data.ByteString.Internal (unsafeCreate)
    import Data.Word (Word8)
    import Foreign.Ptr (plusPtr)
    import Foreign.Storable (poke)
    import qualified Network.HTTP.Types as H

    import Network.HTTP.Semantics

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

    getStatus :: TokenHeaderTable -> Maybe H.Status
    getStatus :: TokenHeaderTable -> Maybe Status
    getStatus (TokenHeaderList
    _, ValueTable
    vt) = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenStatus ValueTable
    vt Maybe ByteString -> (ByteString -> Maybe Status) -> Maybe Status
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Maybe Status
    toStatus

    setStatus :: H.Status -> H.ResponseHeaders -> H.ResponseHeaders
    setStatus :: Status -> ResponseHeaders -> ResponseHeaders
    setStatus Status
    st ResponseHeaders
    hdr = (HeaderName
    ":status", Status -> ByteString
    fromStatus Status
    st) Header -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders
    hdr

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

    fromStatus :: H.Status -> ByteString
    fromStatus :: Status -> ByteString
    fromStatus Status
    status = Int -> (Ptr Word8 -> IO ()) -> ByteString
    unsafeCreate Int
    3 ((Ptr Word8 -> IO ()) -> ByteString)
    -> (Ptr Word8 -> IO ()) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p -> do
        Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    p (Int -> Word8
    toW8 Int
    r2)
        Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8
    p Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    1) (Int -> Word8
    toW8 Int
    r1)
        Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8
    p Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    2) (Int -> Word8
    toW8 Int
    r0)
      where
        toW8 :: Int -> Word8
        toW8 :: Int -> Word8
    toW8 Int
    n = Word8
    48 Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n
        s :: Int
    s = Status -> Int
    H.statusCode Status
    status
        (Int
    q0, Int
    r0) = Int
    s Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    10
        (Int
    q1, Int
    r1) = Int
    q0 Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    10
        r2 :: Int
    r2 = Int
    q1 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    10

    toStatus :: ByteString -> Maybe H.Status
    toStatus :: ByteString -> Maybe Status
    toStatus ByteString
    bs = case ByteString -> Maybe (Int, ByteString)
    C8.readInt ByteString
    bs of
        Maybe (Int, ByteString)
    Nothing -> Maybe Status
    forall a. Maybe a
    Nothing
        Just (Int
    code, ByteString
    _) -> Status -> Maybe Status
    forall a. a -> Maybe a
    Just (Status -> Maybe Status) -> Status -> Maybe Status
    forall a b. (a -> b) -> a -> b
    $ Int -> Status
    forall a. Enum a => Int -> a
    toEnum Int
    code