module Network.HTTP.Lucu.Interaction
    ( Interaction(..)
    , InteractionState(..)
    , InteractionQueue
    , newInteractionQueue -- IO InteractionQueue
    , newInteraction      -- HostName -> Maybe Request -> IO Interaction
    )
    where

import           Control.Concurrent.STM
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.Sequence as S
import           Data.Sequence (Seq)
import           Network
import           Network.HTTP.Lucu.Request
import           Network.HTTP.Lucu.Response

data Interaction = Interaction {
      itrRemoteHost  :: HostName
    , itrRequest     :: Maybe Request
    , itrResponse    :: TVar (Maybe Response)

    , itrRequestHasBody    :: TVar Bool
    , itrRequestBodyLength :: TVar (Maybe Integer) -- chunked の場合は不明
    , itrRequestIsChunked  :: TVar Bool
    , itrReceivedBody      :: TVar ByteString -- Resource が受領した部分は削除される
    
    , itrExpectedContinue  :: TVar Bool

    , itrWillChunkBody    :: TVar Bool
    , itrWillDiscardBody  :: TVar Bool
    , itrWillClose        :: TVar Bool
    , itrBodyToSend       :: TVar ByteString

    , itrState :: TVar InteractionState

    , itrWroteContinue :: TVar Bool
    , itrWroteHeader   :: TVar Bool
    }

-- Resource の視點で見た時の状態。常に上から下へ行き、逆行しない。初期
-- 状態は ExaminingHeader (リクエストボディが有る時) または
-- DecidingHeader (無い時)。終了状態は常に Done
data InteractionState = ExaminingHeader
                      | GettingBody
                      | DecidingHeader
                      | DecidingBody
                      | Done
                        deriving (Show, Eq, Ord)

type InteractionQueue = TVar (Seq Interaction)


newInteractionQueue :: IO InteractionQueue
newInteractionQueue = newTVarIO S.empty


newInteraction :: HostName -> Maybe Request -> IO Interaction
newInteraction host req
    = do responce <- newTVarIO Nothing

         requestHasBody    <- newTVarIO False
         requestBodyLength <- newTVarIO Nothing
         requestIsChunked  <- newTVarIO False
         receivedBody      <- newTVarIO B.empty

         expectedContinue <- newTVarIO False

         willChunkBody   <- newTVarIO False
         willDiscardBody <- newTVarIO False
         willClose       <- newTVarIO False
         bodyToSend      <- newTVarIO B.empty

         state <- newTVarIO undefined

         wroteContinue <- newTVarIO False
         wroteHeader   <- newTVarIO False

         return $ Interaction {
                      itrRemoteHost = host
                    , itrRequest    = req
                    , itrResponse   = responce

                    , itrRequestHasBody    = requestHasBody
                    , itrRequestBodyLength = requestBodyLength
                    , itrRequestIsChunked  = requestIsChunked
                    , itrReceivedBody      = receivedBody

                    , itrExpectedContinue = expectedContinue

                    , itrWillChunkBody    = willChunkBody
                    , itrWillDiscardBody  = willDiscardBody
                    , itrWillClose        = willClose
                    , itrBodyToSend       = bodyToSend
                    
                    , itrState = state
                    
                    , itrWroteContinue = wroteContinue
                    , itrWroteHeader   = wroteHeader
                    }