{-# LANGUAGE FlexibleContexts #-} -- | -- Module : Network.TLS.Receiving13 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- the Receiving module contains calls related to unmarshalling packets according -- to the TLS state -- module Network.TLS.Receiving13 ( processPacket13 ) where import Network.TLS.Context.Internal import Network.TLS.ErrT import Network.TLS.Imports import Network.TLS.Packet import Network.TLS.Packet13 import Network.TLS.Record.Types import Network.TLS.State import Network.TLS.Struct import Network.TLS.Struct13 import Network.TLS.Util import Network.TLS.Wire import Control.Monad.State processPacket13 :: Context -> Record Plaintext -> IO (Either TLSError Packet13) processPacket13 _ (Record ProtocolType_ChangeCipherSpec _ _) = return $ Right ChangeCipherSpec13 processPacket13 _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData13 $ fragmentGetBytes fragment processPacket13 _ (Record ProtocolType_Alert _ fragment) = return (Alert13 `fmapEither` decodeAlerts (fragmentGetBytes fragment)) processPacket13 ctx (Record ProtocolType_Handshake _ fragment) = usingState ctx $ do mCont <- gets stHandshakeRecordCont13 modify (\st -> st { stHandshakeRecordCont13 = Nothing }) hss <- parseMany mCont (fragmentGetBytes fragment) return $ Handshake13 hss where parseMany mCont bs = case fromMaybe decodeHandshakeRecord13 mCont bs of GotError err -> throwError err GotPartial cont -> modify (\st -> st { stHandshakeRecordCont13 = Just cont }) >> return [] GotSuccess (ty,content) -> either throwError (return . (:[])) $ decodeHandshake13 ty content GotSuccessRemaining (ty,content) left -> case decodeHandshake13 ty content of Left err -> throwError err Right hh -> (hh:) <$> parseMany Nothing left processPacket13 _ (Record ProtocolType_DeprecatedHandshake _ _) = return (Left $ Error_Packet "deprecated handshake packet 1.3")