{-# 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