{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP2.Arch.Status (
    getStatus
  , setStatus
  ) where

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

import Imports
import Network.HPACK
import Network.HPACK.Token

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

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

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

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

fromStatus :: H.Status -> ByteString
fromStatus :: Status -> HeaderValue
fromStatus Status
status = Int -> (Ptr Word8 -> IO ()) -> HeaderValue
unsafeCreate Int
3 ((Ptr Word8 -> IO ()) -> HeaderValue)
-> (Ptr Word8 -> IO ()) -> HeaderValue
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 :: HeaderValue -> Maybe Status
toStatus HeaderValue
bs = case HeaderValue -> Maybe (Int, HeaderValue)
C8.readInt HeaderValue
bs of
  Maybe (Int, HeaderValue)
Nothing       -> Maybe Status
forall a. Maybe a
Nothing
  Just (Int
code,HeaderValue
_) -> Status -> Maybe Status
forall a. a -> Maybe a
Just (Status -> Maybe Status) -> Status -> Maybe Status
forall a b. (a -> b) -> a -> b
$ Int -> HeaderValue -> Status
H.mkStatus Int
code HeaderValue
"fixme"