{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Network.TLS.Receiving13
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- 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 :: Context -> Record Plaintext -> IO (Either TLSError Packet13)
processPacket13 _ (Record ProtocolType_ChangeCipherSpec _ _) = Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError Packet13 -> IO (Either TLSError Packet13))
-> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ Packet13 -> Either TLSError Packet13
forall a b. b -> Either a b
Right Packet13
ChangeCipherSpec13
processPacket13 _ (Record ProtocolType_AppData _ fragment :: Fragment Plaintext
fragment) = Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TLSError Packet13 -> IO (Either TLSError Packet13))
-> Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ Packet13 -> Either TLSError Packet13
forall a b. b -> Either a b
Right (Packet13 -> Either TLSError Packet13)
-> Packet13 -> Either TLSError Packet13
forall a b. (a -> b) -> a -> b
$ ByteString -> Packet13
AppData13 (ByteString -> Packet13) -> ByteString -> Packet13
forall a b. (a -> b) -> a -> b
$ Fragment Plaintext -> ByteString
forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Plaintext
fragment
processPacket13 _ (Record ProtocolType_Alert _ fragment :: Fragment Plaintext
fragment) = Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(AlertLevel, AlertDescription)] -> Packet13
Alert13 ([(AlertLevel, AlertDescription)] -> Packet13)
-> Either TLSError [(AlertLevel, AlertDescription)]
-> Either TLSError Packet13
forall a b l. (a -> b) -> Either l a -> Either l b
`fmapEither` ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts (Fragment Plaintext -> ByteString
forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Plaintext
fragment))
processPacket13 ctx :: Context
ctx (Record ProtocolType_Handshake _ fragment :: Fragment Plaintext
fragment) = Context -> TLSSt Packet13 -> IO (Either TLSError Packet13)
forall a. Context -> TLSSt a -> IO (Either TLSError a)
usingState Context
ctx (TLSSt Packet13 -> IO (Either TLSError Packet13))
-> TLSSt Packet13 -> IO (Either TLSError Packet13)
forall a b. (a -> b) -> a -> b
$ do
    Maybe (GetContinuation (HandshakeType13, ByteString))
mCont <- (TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString)))
-> TLSSt (Maybe (GetContinuation (HandshakeType13, ByteString)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString))
stHandshakeRecordCont13
    (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: TLSState
st -> TLSState
st { stHandshakeRecordCont13 :: Maybe (GetContinuation (HandshakeType13, ByteString))
stHandshakeRecordCont13 = Maybe (GetContinuation (HandshakeType13, ByteString))
forall a. Maybe a
Nothing })
    [Handshake13]
hss <- Maybe (GetContinuation (HandshakeType13, ByteString))
-> ByteString -> TLSSt [Handshake13]
forall (m :: * -> *).
(MonadError TLSError m, MonadState TLSState m) =>
Maybe (GetContinuation (HandshakeType13, ByteString))
-> ByteString -> m [Handshake13]
parseMany Maybe (GetContinuation (HandshakeType13, ByteString))
mCont (Fragment Plaintext -> ByteString
forall a. Fragment a -> ByteString
fragmentGetBytes Fragment Plaintext
fragment)
    Packet13 -> TLSSt Packet13
forall (m :: * -> *) a. Monad m => a -> m a
return (Packet13 -> TLSSt Packet13) -> Packet13 -> TLSSt Packet13
forall a b. (a -> b) -> a -> b
$ [Handshake13] -> Packet13
Handshake13 [Handshake13]
hss
  where parseMany :: Maybe (GetContinuation (HandshakeType13, ByteString))
-> ByteString -> m [Handshake13]
parseMany mCont :: Maybe (GetContinuation (HandshakeType13, ByteString))
mCont bs :: ByteString
bs =
            case GetContinuation (HandshakeType13, ByteString)
-> Maybe (GetContinuation (HandshakeType13, ByteString))
-> GetContinuation (HandshakeType13, ByteString)
forall a. a -> Maybe a -> a
fromMaybe GetContinuation (HandshakeType13, ByteString)
decodeHandshakeRecord13 Maybe (GetContinuation (HandshakeType13, ByteString))
mCont ByteString
bs of
                GotError err :: TLSError
err                -> TLSError -> m [Handshake13]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
err
                GotPartial cont :: GetContinuation (HandshakeType13, ByteString)
cont             -> (TLSState -> TLSState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: TLSState
st -> TLSState
st { stHandshakeRecordCont13 :: Maybe (GetContinuation (HandshakeType13, ByteString))
stHandshakeRecordCont13 = GetContinuation (HandshakeType13, ByteString)
-> Maybe (GetContinuation (HandshakeType13, ByteString))
forall a. a -> Maybe a
Just GetContinuation (HandshakeType13, ByteString)
cont }) m () -> m [Handshake13] -> m [Handshake13]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Handshake13] -> m [Handshake13]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                GotSuccess (ty :: HandshakeType13
ty,content :: ByteString
content)     ->
                    (TLSError -> m [Handshake13])
-> (Handshake13 -> m [Handshake13])
-> Either TLSError Handshake13
-> m [Handshake13]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TLSError -> m [Handshake13]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Handshake13] -> m [Handshake13]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Handshake13] -> m [Handshake13])
-> (Handshake13 -> [Handshake13]) -> Handshake13 -> m [Handshake13]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handshake13 -> [Handshake13] -> [Handshake13]
forall a. a -> [a] -> [a]
:[])) (Either TLSError Handshake13 -> m [Handshake13])
-> Either TLSError Handshake13 -> m [Handshake13]
forall a b. (a -> b) -> a -> b
$ HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType13
ty ByteString
content
                GotSuccessRemaining (ty :: HandshakeType13
ty,content :: ByteString
content) left :: ByteString
left ->
                    case HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType13
ty ByteString
content of
                        Left err :: TLSError
err -> TLSError -> m [Handshake13]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
err
                        Right hh :: Handshake13
hh -> (Handshake13
hhHandshake13 -> [Handshake13] -> [Handshake13]
forall a. a -> [a] -> [a]
:) ([Handshake13] -> [Handshake13])
-> m [Handshake13] -> m [Handshake13]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GetContinuation (HandshakeType13, ByteString))
-> ByteString -> m [Handshake13]
parseMany Maybe (GetContinuation (HandshakeType13, ByteString))
forall a. Maybe a
Nothing ByteString
left
processPacket13 _ (Record ProtocolType_DeprecatedHandshake _ _) =
    Either TLSError Packet13 -> IO (Either TLSError Packet13)
forall (m :: * -> *) a. Monad m => a -> m a
return (TLSError -> Either TLSError Packet13
forall a b. a -> Either a b
Left (TLSError -> Either TLSError Packet13)
-> TLSError -> Either TLSError Packet13
forall a b. (a -> b) -> a -> b
$ String -> TLSError
Error_Packet "deprecated handshake packet 1.3")