gdritter repos shelob / master shelob / src / Network / Shelob / Response.hs
master

Tree @master (Download .tar.gz)

Response.hs @masterraw · history · blame

module Network.Shelob.Response where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

import           Network.Shelob.Types

pCode :: BS.ByteString -> (Int, Int, Int)
pCode ln
  | Just (a, as) <- BS.uncons ln
  , Just (b, bs) <- BS.uncons as
  , Just (c, "") <- BS.uncons bs
  = ( fromIntegral (a - 48)
    , fromIntegral (b - 48)
    , fromIntegral (c - 48)
    )
  | otherwise = error "???"

readResponse :: Connection -> Request -> IO (Either HTTPError Response)
readResponse conn req = do
  ln <- connReadLine conn
  case BS.split 32 ln of
    (_version:code:_reason) -> do
      let c = pCode code
      headers <- readHeaders conn
      case requestMethod req of
        MHead -> return (Right (Response headers c Nothing))
        _ -> do
          body    <- readBody conn headers
          return (Right (Response headers c (Just body)))
    _ -> return (Left HTTPError)

readHeaders :: Connection -> IO [Header]
readHeaders conn = do
  ln <- connReadLine conn
  let Just (ln', 13) = BS.unsnoc ln
  if BS.null ln'
    then return []
    else do
      let (key:vals) = BS.split 58 ln'
      let val = BS.intercalate ":" vals
      rs <- readHeaders conn
      return (toHeader key (BS.tail val) : rs)

toHeader :: BS.ByteString -> BS.ByteString -> Header
toHeader "Content-Length" v = HContentLength (read (BS8.unpack v))
toHeader k v = Header k v

readBody :: Connection -> [Header] -> IO BS.ByteString
readBody conn hs
  = case [ ln | HContentLength ln <- hs ]
    of
      [ len ] -> do
        print len
        connRead conn len
      _       -> return ""