{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
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 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]
putExtensions :: [ExtensionRaw] -> Put
putExtensions :: [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
es = ByteString -> Put
putOpaque16 (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ 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 ClientRandom
random Session
session [Word16]
cipherIDs [ExtensionRaw]
exts) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
Version -> Put
putBinaryVersion Version
version
ClientRandom -> Put
putClientRandom32 ClientRandom
random
Session -> Put
putSession Session
session
[Word16] -> Put
putWords16 [Word16]
cipherIDs
[Word8] -> Put
putWords8 [Word8
0]
[ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (ServerHello13 ServerRandom
random Session
session Word16
cipherId [ExtensionRaw]
exts) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
Version -> Put
putBinaryVersion Version
TLS12
ServerRandom -> Put
putServerRandom32 ServerRandom
random
Session -> Put
putSession Session
session
Word16 -> Put
putWord16 Word16
cipherId
Putter Word8
putWord8 Word8
0
[ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (EncryptedExtensions13 [ExtensionRaw]
exts) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (CertRequest13 ByteString
reqctx [ExtensionRaw]
exts) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
ByteString -> Put
putOpaque8 ByteString
reqctx
[ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (Certificate13 ByteString
reqctx CertificateChain
cc [[ExtensionRaw]]
ess) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
ByteString -> Put
putOpaque8 ByteString
reqctx
ByteString -> Put
putOpaque24 (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString, [ExtensionRaw]) -> Put
putCert forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString]
certs [[ExtensionRaw]]
ess)
where
CertificateChainRaw [ByteString]
certs = CertificateChain -> CertificateChainRaw
encodeCertificateChain CertificateChain
cc
putCert :: (ByteString, [ExtensionRaw]) -> Put
putCert (ByteString
certRaw,[ExtensionRaw]
exts) = do
ByteString -> Put
putOpaque24 ByteString
certRaw
[ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (CertVerify13 HashAndSignatureAlgorithm
hs ByteString
signature) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm HashAndSignatureAlgorithm
hs
ByteString -> Put
putOpaque16 ByteString
signature
encodeHandshake13' (Finished13 ByteString
dat) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
dat
encodeHandshake13' (NewSessionTicket13 Second
life Second
ageadd ByteString
nonce ByteString
label [ExtensionRaw]
exts) = Put -> ByteString
runPut 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' Handshake13
EndOfEarlyData13 = ByteString
""
encodeHandshake13' (KeyUpdate13 KeyUpdate
UpdateNotRequested) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Word8
0
encodeHandshake13' (KeyUpdate13 KeyUpdate
UpdateRequested) = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Word8
1
encodeHandshakeHeader13 :: HandshakeType13 -> Int -> ByteString
encodeHandshakeHeader13 :: HandshakeType13 -> Int -> ByteString
encodeHandshakeHeader13 HandshakeType13
ty Int
len = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ do
Putter Word8
putWord8 (forall a. TypeValuable a => a -> Word8
valOfType HandshakeType13
ty)
Int -> Put
putWord24 Int
len
decodeHandshakes13 :: MonadError TLSError m => ByteString -> m [Handshake13]
decodeHandshakes13 :: forall (m :: * -> *).
MonadError TLSError m =>
ByteString -> m [Handshake13]
decodeHandshakes13 ByteString
bs = case ByteString -> GetResult (HandshakeType13, ByteString)
decodeHandshakeRecord13 ByteString
bs of
GotError TLSError
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
err
GotPartial ByteString -> GetResult (HandshakeType13, ByteString)
_cont -> forall a. HasCallStack => [Char] -> a
error [Char]
"decodeHandshakes13"
GotSuccess (HandshakeType13
ty,ByteString
content) -> case HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType13
ty ByteString
content of
Left TLSError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
e
Right Handshake13
h -> forall (m :: * -> *) a. Monad m => a -> m a
return [Handshake13
h]
GotSuccessRemaining (HandshakeType13
ty,ByteString
content) ByteString
left -> case HandshakeType13 -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType13
ty ByteString
content of
Left TLSError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TLSError
e
Right Handshake13
h -> (Handshake13
hforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadError TLSError m =>
ByteString -> m [Handshake13]
decodeHandshakes13 ByteString
left
getHandshakeType13 :: Get HandshakeType13
getHandshakeType13 :: Get HandshakeType13
getHandshakeType13 = do
Word8
ty <- Get Word8
getWord8
case forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
Maybe HandshakeType13
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid handshake type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
ty)
Just HandshakeType13
t -> forall (m :: * -> *) a. Monad m => a -> m a
return HandshakeType13
t
decodeHandshakeRecord13 :: ByteString -> GetResult (HandshakeType13, ByteString)
decodeHandshakeRecord13 :: ByteString -> GetResult (HandshakeType13, ByteString)
decodeHandshakeRecord13 = forall a. [Char] -> Get a -> ByteString -> GetResult a
runGet [Char]
"handshake-record" forall a b. (a -> b) -> a -> b
$ do
HandshakeType13
ty <- Get HandshakeType13
getHandshakeType13
ByteString
content <- Get ByteString
getOpaque24
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 HandshakeType13
ty = forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr ([Char]
"handshake[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show HandshakeType13
ty forall a. [a] -> [a] -> [a]
++ [Char]
"]") forall a b. (a -> b) -> a -> b
$ case HandshakeType13
ty of
HandshakeType13
HandshakeType_ClientHello13 -> Get Handshake13
decodeClientHello13
HandshakeType13
HandshakeType_ServerHello13 -> Get Handshake13
decodeServerHello13
HandshakeType13
HandshakeType_Finished13 -> Get Handshake13
decodeFinished13
HandshakeType13
HandshakeType_EncryptedExtensions13 -> Get Handshake13
decodeEncryptedExtensions13
HandshakeType13
HandshakeType_CertRequest13 -> Get Handshake13
decodeCertRequest13
HandshakeType13
HandshakeType_Certificate13 -> Get Handshake13
decodeCertificate13
HandshakeType13
HandshakeType_CertVerify13 -> Get Handshake13
decodeCertVerify13
HandshakeType13
HandshakeType_NewSessionTicket13 -> Get Handshake13
decodeNewSessionTicket13
HandshakeType13
HandshakeType_EndOfEarlyData13 -> forall (m :: * -> *) a. Monad m => a -> m a
return Handshake13
EndOfEarlyData13
HandshakeType13
HandshakeType_KeyUpdate13 -> Get Handshake13
decodeKeyUpdate13
decodeClientHello13 :: Get Handshake13
decodeClientHello13 :: Get Handshake13
decodeClientHello13 = do
Just Version
ver <- Get (Maybe Version)
getBinaryVersion
ClientRandom
random <- Get ClientRandom
getClientRandom32
Session
session <- Get Session
getSession
[Word16]
ciphers <- Get [Word16]
getWords16
[Word8]
_comp <- Get [Word8]
getWords8
[ExtensionRaw]
exts <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Version
-> ClientRandom
-> Session
-> [Word16]
-> [ExtensionRaw]
-> Handshake13
ClientHello13 Version
ver ClientRandom
random Session
session [Word16]
ciphers [ExtensionRaw]
exts
decodeServerHello13 :: Get Handshake13
decodeServerHello13 :: Get Handshake13
decodeServerHello13 = do
Just Version
_ver <- Get (Maybe Version)
getBinaryVersion
ServerRandom
random <- Get ServerRandom
getServerRandom32
Session
session <- Get Session
getSession
Word16
cipherid <- Get Word16
getWord16
Word8
_comp <- Get Word8
getWord8
[ExtensionRaw]
exts <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ServerRandom -> Session -> Word16 -> [ExtensionRaw] -> Handshake13
ServerHello13 ServerRandom
random Session
session Word16
cipherid [ExtensionRaw]
exts
decodeFinished13 :: Get Handshake13
decodeFinished13 :: Get Handshake13
decodeFinished13 = ByteString -> Handshake13
Finished13 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
remaining 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
Int -> Get [ExtensionRaw]
getExtensions Int
len
decodeCertRequest13 :: Get Handshake13
decodeCertRequest13 :: Get Handshake13
decodeCertRequest13 = do
ByteString
reqctx <- Get ByteString
getOpaque8
Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
[ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getWord24
([ByteString]
certRaws, [[ExtensionRaw]]
ess) <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Get (Int, a) -> Get [a]
getList Int
len Get (Int, (ByteString, [ExtensionRaw]))
getCert
case CertificateChainRaw -> Either (Int, [Char]) CertificateChain
decodeCertificateChain forall a b. (a -> b) -> a -> b
$ [ByteString] -> CertificateChainRaw
CertificateChainRaw [ByteString]
certRaws of
Left (Int
i, [Char]
s) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"error certificate parsing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ [Char]
s)
Right CertificateChain
cc -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
[ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
3 forall a. Num a => a -> a -> a
+ Int
l forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
len, (ByteString
cert, [ExtensionRaw]
exts))
decodeCertVerify13 :: Get Handshake13
decodeCertVerify13 :: Get Handshake13
decodeCertVerify13 = HashAndSignatureAlgorithm -> ByteString -> Handshake13
CertVerify13 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
[ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
forall (m :: * -> *) a. Monad m => a -> m a
return 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
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ KeyUpdate -> Handshake13
KeyUpdate13 KeyUpdate
UpdateNotRequested
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ KeyUpdate -> Handshake13
KeyUpdate13 KeyUpdate
UpdateRequested
Word8
x -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown request_update: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
x