{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Network.TLS.Packet13
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Packet13
       ( encodeHandshake13
       , getHandshakeType13
       , decodeHandshakeRecord13
       , decodeHandshake13
       , decodeHandshakes13
       ) where

import qualified Data.ByteString as B
import Network.TLS.Struct
import Network.TLS.Struct13
import Network.TLS.Packet
import Network.TLS.Wire
import Network.TLS.Imports
import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)
import Network.TLS.ErrT

encodeHandshake13 :: Handshake13 -> ByteString
encodeHandshake13 :: Handshake13 -> ByteString
encodeHandshake13 hdsk :: Handshake13
hdsk = ByteString
pkt
  where
    !tp :: HandshakeType13
tp = Handshake13 -> HandshakeType13
typeOfHandshake13 Handshake13
hdsk
    !content :: ByteString
content = Handshake13 -> ByteString
encodeHandshake13' Handshake13
hdsk
    !len :: Int
len = ByteString -> Int
B.length ByteString
content
    !header :: ByteString
header = HandshakeType13 -> Int -> ByteString
encodeHandshakeHeader13 HandshakeType13
tp Int
len
    !pkt :: ByteString
pkt = [ByteString] -> ByteString
B.concat [ByteString
header, ByteString
content]

-- TLS 1.3 does not use "select (extensions_present)".
putExtensions :: [ExtensionRaw] -> Put
putExtensions :: [ExtensionRaw] -> Put
putExtensions es :: [ExtensionRaw]
es = ByteString -> Put
putOpaque16 (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (ExtensionRaw -> Put) -> [ExtensionRaw] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExtensionRaw -> Put
putExtension [ExtensionRaw]
es)

encodeHandshake13' :: Handshake13 -> ByteString
encodeHandshake13' :: Handshake13 -> ByteString
encodeHandshake13' (ClientHello13 version :: Version
version random :: ClientRandom
random session :: Session
session cipherIDs :: [CipherID]
cipherIDs exts :: [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Version -> Put
putBinaryVersion Version
version
    ClientRandom -> Put
putClientRandom32 ClientRandom
random
    Session -> Put
putSession Session
session
    [CipherID] -> Put
putWords16 [CipherID]
cipherIDs
    [Word8] -> Put
putWords8 [0]
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (ServerHello13 random :: ServerRandom
random session :: Session
session cipherId :: CipherID
cipherId exts :: [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Version -> Put
putBinaryVersion Version
TLS12
    ServerRandom -> Put
putServerRandom32 ServerRandom
random
    Session -> Put
putSession Session
session
    CipherID -> Put
putWord16 CipherID
cipherId
    Putter Word8
putWord8 0 -- compressionID nullCompression
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (EncryptedExtensions13 exts :: [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (CertRequest13 reqctx :: ByteString
reqctx exts :: [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Put
putOpaque8 ByteString
reqctx
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (Certificate13 reqctx :: ByteString
reqctx cc :: CertificateChain
cc ess :: [[ExtensionRaw]]
ess) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Put
putOpaque8 ByteString
reqctx
    ByteString -> Put
putOpaque24 (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, [ExtensionRaw]) -> Put)
-> [(ByteString, [ExtensionRaw])] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString, [ExtensionRaw]) -> Put
putCert ([(ByteString, [ExtensionRaw])] -> Put)
-> [(ByteString, [ExtensionRaw])] -> Put
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [[ExtensionRaw]] -> [(ByteString, [ExtensionRaw])]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString]
certs [[ExtensionRaw]]
ess)
  where
    CertificateChainRaw certs :: [ByteString]
certs = CertificateChain -> CertificateChainRaw
encodeCertificateChain CertificateChain
cc
    putCert :: (ByteString, [ExtensionRaw]) -> Put
putCert (certRaw :: ByteString
certRaw,exts :: [ExtensionRaw]
exts) = do
        ByteString -> Put
putOpaque24 ByteString
certRaw
        [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (CertVerify13 hs :: HashAndSignatureAlgorithm
hs signature :: ByteString
signature) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm HashAndSignatureAlgorithm
hs
    ByteString -> Put
putOpaque16 ByteString
signature
encodeHandshake13' (Finished13 dat :: ByteString
dat) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
dat
encodeHandshake13' (NewSessionTicket13 life :: Second
life ageadd :: Second
ageadd nonce :: ByteString
nonce label :: ByteString
label exts :: [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Second -> Put
putWord32 Second
life
    Second -> Put
putWord32 Second
ageadd
    ByteString -> Put
putOpaque8 ByteString
nonce
    ByteString -> Put
putOpaque16 ByteString
label
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' EndOfEarlyData13 = ""
encodeHandshake13' (KeyUpdate13 UpdateNotRequested) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 0
encodeHandshake13' (KeyUpdate13 UpdateRequested)    = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 1

encodeHandshakeHeader13 :: HandshakeType13 -> Int -> ByteString
encodeHandshakeHeader13 :: HandshakeType13 -> Int -> ByteString
encodeHandshakeHeader13 ty :: HandshakeType13
ty len :: Int
len = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Putter Word8
putWord8 (HandshakeType13 -> Word8
forall a. TypeValuable a => a -> Word8
valOfType HandshakeType13
ty)
    Int -> Put
putWord24 Int
len

decodeHandshakes13 :: MonadError TLSError m => ByteString -> m [Handshake13]
decodeHandshakes13 :: ByteString -> m [Handshake13]
decodeHandshakes13 bs :: ByteString
bs = case ByteString -> GetResult (HandshakeType13, ByteString)
decodeHandshakeRecord13 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 :: ByteString -> GetResult (HandshakeType13, ByteString)
_cont            -> [Char] -> m [Handshake13]
forall a. HasCallStack => [Char] -> a
error "decodeHandshakes13"
  GotSuccess (ty :: HandshakeType13
ty,content :: ByteString
content)     -> case HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType13
ty ByteString
content of
    Left  e :: TLSError
e -> TLSError -> m [Handshake13]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
e
    Right h :: Handshake13
h -> [Handshake13] -> m [Handshake13]
forall (m :: * -> *) a. Monad m => a -> m a
return [Handshake13
h]
  GotSuccessRemaining (ty :: HandshakeType13
ty,content :: ByteString
content) left :: ByteString
left -> case HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType13
ty ByteString
content of
    Left  e :: TLSError
e -> TLSError -> m [Handshake13]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
e
    Right h :: Handshake13
h -> (Handshake13
hHandshake13 -> [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
<$> ByteString -> m [Handshake13]
forall (m :: * -> *).
MonadError TLSError m =>
ByteString -> m [Handshake13]
decodeHandshakes13 ByteString
left

{- decode and encode HANDSHAKE -}
getHandshakeType13 :: Get HandshakeType13
getHandshakeType13 :: Get HandshakeType13
getHandshakeType13 = do
    Word8
ty <- Get Word8
getWord8
    case Word8 -> Maybe HandshakeType13
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Nothing -> [Char] -> Get HandshakeType13
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ("invalid handshake type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
ty)
        Just t :: HandshakeType13
t  -> HandshakeType13 -> Get HandshakeType13
forall (m :: * -> *) a. Monad m => a -> m a
return HandshakeType13
t

decodeHandshakeRecord13 :: ByteString -> GetResult (HandshakeType13, ByteString)
decodeHandshakeRecord13 :: ByteString -> GetResult (HandshakeType13, ByteString)
decodeHandshakeRecord13 = [Char]
-> Get (HandshakeType13, ByteString)
-> ByteString
-> GetResult (HandshakeType13, ByteString)
forall a. [Char] -> Get a -> ByteString -> GetResult a
runGet "handshake-record" (Get (HandshakeType13, ByteString)
 -> ByteString -> GetResult (HandshakeType13, ByteString))
-> Get (HandshakeType13, ByteString)
-> ByteString
-> GetResult (HandshakeType13, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    HandshakeType13
ty      <- Get HandshakeType13
getHandshakeType13
    ByteString
content <- Get ByteString
getOpaque24
    (HandshakeType13, ByteString) -> Get (HandshakeType13, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (HandshakeType13
ty, ByteString
content)

decodeHandshake13 :: HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 :: HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 ty :: HandshakeType13
ty = [Char]
-> Get Handshake13 -> ByteString -> Either TLSError Handshake13
forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr ("handshake[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HandshakeType13 -> [Char]
forall a. Show a => a -> [Char]
show HandshakeType13
ty [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "]") (Get Handshake13 -> ByteString -> Either TLSError Handshake13)
-> Get Handshake13 -> ByteString -> Either TLSError Handshake13
forall a b. (a -> b) -> a -> b
$ case HandshakeType13
ty of
    HandshakeType_ClientHello13         -> Get Handshake13
decodeClientHello13
    HandshakeType_ServerHello13         -> Get Handshake13
decodeServerHello13
    HandshakeType_Finished13            -> Get Handshake13
decodeFinished13
    HandshakeType_EncryptedExtensions13 -> Get Handshake13
decodeEncryptedExtensions13
    HandshakeType_CertRequest13         -> Get Handshake13
decodeCertRequest13
    HandshakeType_Certificate13         -> Get Handshake13
decodeCertificate13
    HandshakeType_CertVerify13          -> Get Handshake13
decodeCertVerify13
    HandshakeType_NewSessionTicket13    -> Get Handshake13
decodeNewSessionTicket13
    HandshakeType_EndOfEarlyData13      -> Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return Handshake13
EndOfEarlyData13
    HandshakeType_KeyUpdate13           -> Get Handshake13
decodeKeyUpdate13

decodeClientHello13 :: Get Handshake13
decodeClientHello13 :: Get Handshake13
decodeClientHello13 = do
    Just ver :: Version
ver <- Get (Maybe Version)
getBinaryVersion
    ClientRandom
random   <- Get ClientRandom
getClientRandom32
    Session
session  <- Get Session
getSession
    [CipherID]
ciphers  <- Get [CipherID]
getWords16
    [Word8]
_comp    <- Get [Word8]
getWords8
    [ExtensionRaw]
exts     <- CipherID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CipherID -> Int) -> Get CipherID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherID
getWord16 Get Int -> (Int -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
    Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ Version
-> ClientRandom
-> Session
-> [CipherID]
-> [ExtensionRaw]
-> Handshake13
ClientHello13 Version
ver ClientRandom
random Session
session [CipherID]
ciphers [ExtensionRaw]
exts

decodeServerHello13 :: Get Handshake13
decodeServerHello13 :: Get Handshake13
decodeServerHello13 = do
    Just _ver :: Version
_ver <- Get (Maybe Version)
getBinaryVersion
    ServerRandom
random    <- Get ServerRandom
getServerRandom32
    Session
session   <- Get Session
getSession
    CipherID
cipherid  <- Get CipherID
getWord16
    Word8
_comp     <- Get Word8
getWord8
    [ExtensionRaw]
exts      <- CipherID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CipherID -> Int) -> Get CipherID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherID
getWord16 Get Int -> (Int -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
    Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ ServerRandom
-> Session -> CipherID -> [ExtensionRaw] -> Handshake13
ServerHello13 ServerRandom
random Session
session CipherID
cipherid [ExtensionRaw]
exts

decodeFinished13 :: Get Handshake13
decodeFinished13 :: Get Handshake13
decodeFinished13 = ByteString -> Handshake13
Finished13 (ByteString -> Handshake13) -> Get ByteString -> Get Handshake13
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining Get Int -> (Int -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)

decodeEncryptedExtensions13 :: Get Handshake13
decodeEncryptedExtensions13 :: Get Handshake13
decodeEncryptedExtensions13 = [ExtensionRaw] -> Handshake13
EncryptedExtensions13 ([ExtensionRaw] -> Handshake13)
-> Get [ExtensionRaw] -> Get Handshake13
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    Int
len <- CipherID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CipherID -> Int) -> Get CipherID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherID
getWord16
    Int -> Get [ExtensionRaw]
getExtensions Int
len

decodeCertRequest13 :: Get Handshake13
decodeCertRequest13 :: Get Handshake13
decodeCertRequest13 = do
    ByteString
reqctx <- Get ByteString
getOpaque8
    Int
len <- CipherID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CipherID -> Int) -> Get CipherID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherID
getWord16
    [ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
    Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ ByteString -> [ExtensionRaw] -> Handshake13
CertRequest13 ByteString
reqctx [ExtensionRaw]
exts

decodeCertificate13 :: Get Handshake13
decodeCertificate13 :: Get Handshake13
decodeCertificate13 = do
    ByteString
reqctx <- Get ByteString
getOpaque8
    Int
len <- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Get Int -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getWord24
    (certRaws :: [ByteString]
certRaws, ess :: [[ExtensionRaw]]
ess) <- [(ByteString, [ExtensionRaw])] -> ([ByteString], [[ExtensionRaw]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ByteString, [ExtensionRaw])]
 -> ([ByteString], [[ExtensionRaw]]))
-> Get [(ByteString, [ExtensionRaw])]
-> Get ([ByteString], [[ExtensionRaw]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Get (Int, (ByteString, [ExtensionRaw]))
-> Get [(ByteString, [ExtensionRaw])]
forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, (ByteString, [ExtensionRaw]))
getCert
    case CertificateChainRaw -> Either (Int, [Char]) CertificateChain
decodeCertificateChain (CertificateChainRaw -> Either (Int, [Char]) CertificateChain)
-> CertificateChainRaw -> Either (Int, [Char]) CertificateChain
forall a b. (a -> b) -> a -> b
$ [ByteString] -> CertificateChainRaw
CertificateChainRaw [ByteString]
certRaws of
        Left (i :: Int
i, s :: [Char]
s) -> [Char] -> Get Handshake13
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ("error certificate parsing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
        Right cc :: CertificateChain
cc    -> Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ ByteString -> CertificateChain -> [[ExtensionRaw]] -> Handshake13
Certificate13 ByteString
reqctx CertificateChain
cc [[ExtensionRaw]]
ess
  where
    getCert :: Get (Int, (ByteString, [ExtensionRaw]))
getCert = do
        Int
l <- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Get Int -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getWord24
        ByteString
cert <- Int -> Get ByteString
getBytes Int
l
        Int
len <- CipherID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CipherID -> Int) -> Get CipherID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherID
getWord16
        [ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
        (Int, (ByteString, [ExtensionRaw]))
-> Get (Int, (ByteString, [ExtensionRaw]))
forall (m :: * -> *) a. Monad m => a -> m a
return (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len, (ByteString
cert, [ExtensionRaw]
exts))

decodeCertVerify13 :: Get Handshake13
decodeCertVerify13 :: Get Handshake13
decodeCertVerify13 = HashAndSignatureAlgorithm -> ByteString -> Handshake13
CertVerify13 (HashAndSignatureAlgorithm -> ByteString -> Handshake13)
-> Get HashAndSignatureAlgorithm -> Get (ByteString -> Handshake13)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get (ByteString -> Handshake13)
-> Get ByteString -> Get Handshake13
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getOpaque16

decodeNewSessionTicket13 :: Get Handshake13
decodeNewSessionTicket13 :: Get Handshake13
decodeNewSessionTicket13 = do
    Second
life   <- Get Second
getWord32
    Second
ageadd <- Get Second
getWord32
    ByteString
nonce  <- Get ByteString
getOpaque8
    ByteString
label  <- Get ByteString
getOpaque16
    Int
len    <- CipherID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CipherID -> Int) -> Get CipherID -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get CipherID
getWord16
    [ExtensionRaw]
exts   <- Int -> Get [ExtensionRaw]
getExtensions Int
len
    Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ Second
-> Second
-> ByteString
-> ByteString
-> [ExtensionRaw]
-> Handshake13
NewSessionTicket13 Second
life Second
ageadd ByteString
nonce ByteString
label [ExtensionRaw]
exts

decodeKeyUpdate13 :: Get Handshake13
decodeKeyUpdate13 :: Get Handshake13
decodeKeyUpdate13 = do
    Word8
ru <- Get Word8
getWord8
    case Word8
ru of
        0 -> Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ KeyUpdate -> Handshake13
KeyUpdate13 KeyUpdate
UpdateNotRequested
        1 -> Handshake13 -> Get Handshake13
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ KeyUpdate -> Handshake13
KeyUpdate13 KeyUpdate
UpdateRequested
        x :: Word8
x -> [Char] -> Get Handshake13
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Handshake13) -> [Char] -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ "Unknown request_update: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x