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