TCPStateTransitions.hs

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE LambdaCase #-}
module Network.TCP where
import Data.Set (Set)

data PacketFlag = NS | CWR | ECE | URG | ACK | PSH | RST | SYN | FIN
  deriving (Eq, Show, Ord)

type Packet = Set PacketFlag

data State 
  = Closed
  | Listen
  | SynSent
  | SynReceived
  | Established
  | CloseWait
  | LastAck
  | FinWait1
  | FinWait2
  | Closing
  | TimeWait

activeOpen :: State -> Maybe (State, Packet)
activeOpen = \case
  Closed -> Just (SynSent, [SYN])
  _ -> Nothing
  
passiveOpen :: State -> Maybe State
passiveOpen = \case
  Closed -> Just Listen
  _ -> Nothing

respond :: Packet -> State -> (State, Maybe Packet)
respond packet = \case
  Listen      | packet == [SYN]      -> (SynReceived, Just [SYN, ACK])
  
  SynSent     | packet == [SYN, ACK] -> (Established, Just [ACK]     )
              | packet == [SYN]      -> (SynReceived, Just [SYN, ACK])
              
  SynReceived | packet == [ACK]      -> (Established, Nothing        ) 
              | packet == [RST]      -> (Listen     , Nothing        )
              
  Established | packet == [FIN]      -> (CloseWait  , Just [ACK]     )

  LastAck     | packet == [ACK]      -> (Closed     , Nothing        )
  
  FinWait1    | packet == [FIN]      -> (Closing    , Just [ACK]     )
              | packet == [ACK]      -> (FinWait2   , Nothing        )
  
  FinWait2    | packet == [FIN]      -> (TimeWait   , Just [ACK]     )
  
  Closing     | packet == [ACK]      -> (TimeWait   , Nothing        )
  
  x                                  -> (x          , Nothing        )

timeout :: State -> (State, Maybe Packet)
timeout = \case
  SynReceived -> (Closed, Just [RST])
  SynSent     -> (Closed, Nothing   )
  TimeWait    -> (Closed, Nothing   )
  x           -> (x     , Nothing   )

closeApp :: State -> (State, Maybe Packet)
closeApp = \case
  SynReceived -> (FinWait1, Just [FIN])
  SynSent     -> (Closed  , Nothing   )
  Established -> (FinWait1, Just [FIN])
  CloseWait   -> (LastAck , Just [FIN])