1-- | 2-- Module : Network.TLS.Receiving 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- the Receiving module contains calls related to unmarshalling packets according 9-- to the TLS state 10-- 11{-# LANGUAGE FlexibleContexts #-} 12 13module Network.TLS.Receiving 14 ( processPacket 15 , processPacket13 16 ) where 17 18import Network.TLS.Cipher 19import Network.TLS.Context.Internal 20import Network.TLS.ErrT 21import Network.TLS.Handshake.State 22import Network.TLS.Imports 23import Network.TLS.Packet 24import Network.TLS.Packet13 25import Network.TLS.Record 26import Network.TLS.State 27import Network.TLS.Struct 28import Network.TLS.Struct13 29import Network.TLS.Util 30import Network.TLS.Wire 31 32import Control.Concurrent.MVar 33import Control.Monad.State.Strict 34 35processPacket :: Context -> Record Plaintext -> IO (Either TLSError Packet) 36 37processPacket _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData $ fragmentGetBytes fragment 38 39processPacket _ (Record ProtocolType_Alert _ fragment) = return (Alert `fmapEither` decodeAlerts (fragmentGetBytes fragment)) 40 41processPacket ctx (Record ProtocolType_ChangeCipherSpec _ fragment) = 42 case decodeChangeCipherSpec $ fragmentGetBytes fragment of 43 Left err -> return $ Left err 44 Right _ -> do switchRxEncryption ctx 45 return $ Right ChangeCipherSpec 46 47processPacket ctx (Record ProtocolType_Handshake ver fragment) = do 48 keyxchg <- getHState ctx >>= \hs -> return (hs >>= hstPendingCipher >>= Just . cipherKeyExchange) 49 usingState ctx $ do 50 let currentParams = CurrentParams 51 { cParamsVersion = ver 52 , cParamsKeyXchgType = keyxchg 53 } 54 -- get back the optional continuation, and parse as many handshake record as possible. 55 mCont <- gets stHandshakeRecordCont 56 modify (\st -> st { stHandshakeRecordCont = Nothing }) 57 hss <- parseMany currentParams mCont (fragmentGetBytes fragment) 58 return $ Handshake hss 59 where parseMany currentParams mCont bs = 60 case fromMaybe decodeHandshakeRecord mCont bs of 61 GotError err -> throwError err 62 GotPartial cont -> modify (\st -> st { stHandshakeRecordCont = Just cont }) >> return [] 63 GotSuccess (ty,content) -> 64 either throwError (return . (:[])) $ decodeHandshake currentParams ty content 65 GotSuccessRemaining (ty,content) left -> 66 case decodeHandshake currentParams ty content of 67 Left err -> throwError err 68 Right hh -> (hh:) <$> parseMany currentParams Nothing left 69 70processPacket _ (Record ProtocolType_DeprecatedHandshake _ fragment) = 71 case decodeDeprecatedHandshake $ fragmentGetBytes fragment of 72 Left err -> return $ Left err 73 Right hs -> return $ Right $ Handshake [hs] 74 75switchRxEncryption :: Context -> IO () 76switchRxEncryption ctx = 77 usingHState ctx (gets hstPendingRxState) >>= \rx -> 78 liftIO $ modifyMVar_ (ctxRxState ctx) (\_ -> return $ fromJust "rx-state" rx) 79 80---------------------------------------------------------------- 81 82processPacket13 :: Context -> Record Plaintext -> IO (Either TLSError Packet13) 83processPacket13 _ (Record ProtocolType_ChangeCipherSpec _ _) = return $ Right ChangeCipherSpec13 84processPacket13 _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData13 $ fragmentGetBytes fragment 85processPacket13 _ (Record ProtocolType_Alert _ fragment) = return (Alert13 `fmapEither` decodeAlerts (fragmentGetBytes fragment)) 86processPacket13 ctx (Record ProtocolType_Handshake _ fragment) = usingState ctx $ do 87 mCont <- gets stHandshakeRecordCont13 88 modify (\st -> st { stHandshakeRecordCont13 = Nothing }) 89 hss <- parseMany mCont (fragmentGetBytes fragment) 90 return $ Handshake13 hss 91 where parseMany mCont bs = 92 case fromMaybe decodeHandshakeRecord13 mCont bs of 93 GotError err -> throwError err 94 GotPartial cont -> modify (\st -> st { stHandshakeRecordCont13 = Just cont }) >> return [] 95 GotSuccess (ty,content) -> 96 either throwError (return . (:[])) $ decodeHandshake13 ty content 97 GotSuccessRemaining (ty,content) left -> 98 case decodeHandshake13 ty content of 99 Left err -> throwError err 100 Right hh -> (hh:) <$> parseMany Nothing left 101processPacket13 _ (Record ProtocolType_DeprecatedHandshake _ _) = 102 return (Left $ Error_Packet "deprecated handshake packet 1.3") 103