{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.TLS.Packet13 (
    encodeHandshake13,
    decodeHandshakeRecord13,
    decodeHandshake13,
    decodeHandshakes13,
    encodeCertificate13,
) where

import Codec.Compression.Zlib
import qualified Control.Exception as E
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.X509 (
    CertificateChain,
    CertificateChainRaw (..),
    decodeCertificateChain,
    encodeCertificateChain,
 )
import System.IO.Unsafe

import Network.TLS.ErrT
import Network.TLS.Imports
import Network.TLS.Packet
import Network.TLS.Struct
import Network.TLS.Struct13
import Network.TLS.Types
import Network.TLS.Wire

----------------------------------------------------------------

encodeHandshake13 :: Handshake13 -> ByteString
encodeHandshake13 :: Handshake13 -> ByteString
encodeHandshake13 Handshake13
hdsk = ByteString
pkt
  where
    tp :: HandshakeType
tp = Handshake13 -> HandshakeType
typeOfHandshake13 Handshake13
hdsk
    content :: ByteString
content = Handshake13 -> ByteString
encodeHandshake13' Handshake13
hdsk
    len :: Int
len = ByteString -> Int
B.length ByteString
content
    header :: ByteString
header = HandshakeType -> Int -> ByteString
encodeHandshakeHeader13 HandshakeType
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 [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' (ServerHello13 SH{[ExtensionRaw]
Word8
Version
CipherId
Session
ServerRandom
shVersion :: Version
shRandom :: ServerRandom
shSession :: Session
shCipher :: CipherId
shComp :: Word8
shExtensions :: [ExtensionRaw]
shVersion :: ServerHello -> Version
shRandom :: ServerHello -> ServerRandom
shSession :: ServerHello -> Session
shCipher :: ServerHello -> CipherId
shComp :: ServerHello -> Word8
shExtensions :: ServerHello -> [ExtensionRaw]
..}) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Version -> Put
putBinaryVersion Version
shVersion
    ServerRandom -> Put
putServerRandom32 ServerRandom
shRandom
    Session -> Put
putSession Session
shSession
    Word16 -> Put
putWord16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ CipherId -> Word16
fromCipherId CipherId
shCipher
    Putter Word8
putWord8 Word8
shComp
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
shExtensions
encodeHandshake13'
    ( NewSessionTicket13
            Second
life
            Second
ageadd
            (TicketNonce ByteString
nonce)
            (SessionIDorTicket_ ByteString
label)
            [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' Handshake13
EndOfEarlyData13 = ByteString
""
encodeHandshake13' (EncryptedExtensions13 [ExtensionRaw]
exts) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
encodeHandshake13' (Certificate13 ByteString
reqctx (CertificateChain_ CertificateChain
cc) [[ExtensionRaw]]
ess) = ByteString -> CertificateChain -> [[ExtensionRaw]] -> ByteString
encodeCertificate13 ByteString
reqctx CertificateChain
cc [[ExtensionRaw]]
ess
encodeHandshake13' (CertRequest13 ByteString
reqctx [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' (CertVerify13 (DigitallySigned HashAndSignatureAlgorithm
hs ByteString
sig)) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm HashAndSignatureAlgorithm
hs
    ByteString -> Put
putOpaque16 ByteString
sig
encodeHandshake13' (Finished13 (VerifyData ByteString
dat)) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
putBytes ByteString
dat
encodeHandshake13' (KeyUpdate13 KeyUpdate
UpdateNotRequested) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Word8
0
encodeHandshake13' (KeyUpdate13 KeyUpdate
UpdateRequested) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Word8
putWord8 Word8
1
encodeHandshake13' (CompressedCertificate13 ByteString
reqctx (CertificateChain_ CertificateChain
cc) [[ExtensionRaw]]
ess) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Word16 -> Put
putWord16 Word16
1 -- zlib: fixme
    let bs :: ByteString
bs = ByteString -> CertificateChain -> [[ExtensionRaw]] -> ByteString
encodeCertificate13 ByteString
reqctx CertificateChain
cc [[ExtensionRaw]]
ess
    Int -> Put
putWord24 (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs
    ByteString -> Put
putOpaque24 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
compress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
bs

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

encodeCertificate13
    :: CertReqContext -> CertificateChain -> [[ExtensionRaw]] -> ByteString
encodeCertificate13 :: ByteString -> CertificateChain -> [[ExtensionRaw]] -> ByteString
encodeCertificate13 ByteString
reqctx CertificateChain
cc [[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 [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

----------------------------------------------------------------

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

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

{- FOURMOLU_DISABLE -}
decodeHandshake13
    :: HandshakeType -> ByteString -> Either TLSError Handshake13
decodeHandshake13 :: HandshakeType -> ByteString -> Either TLSError Handshake13
decodeHandshake13 HandshakeType
ty = [Char]
-> Get Handshake13 -> ByteString -> Either TLSError Handshake13
forall a. [Char] -> Get a -> ByteString -> Either TLSError a
runGetErr ([Char]
"handshake[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HandshakeType -> [Char]
forall a. Show a => a -> [Char]
show HandshakeType
ty [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]") (Get Handshake13 -> ByteString -> Either TLSError Handshake13)
-> Get Handshake13 -> ByteString -> Either TLSError Handshake13
forall a b. (a -> b) -> a -> b
$ case HandshakeType
ty of
    HandshakeType
HandshakeType_ServerHello           -> Get Handshake13
decodeServerHello13
    HandshakeType
HandshakeType_NewSessionTicket      -> Get Handshake13
decodeNewSessionTicket13
    HandshakeType
HandshakeType_EndOfEarlyData        -> Handshake13 -> Get Handshake13
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Handshake13
EndOfEarlyData13
    HandshakeType
HandshakeType_EncryptedExtensions   -> Get Handshake13
decodeEncryptedExtensions13
    HandshakeType
HandshakeType_Certificate           -> Get Handshake13
decodeCertificate13
    HandshakeType
HandshakeType_CertRequest           -> Get Handshake13
decodeCertRequest13
    HandshakeType
HandshakeType_CertVerify            -> Get Handshake13
decodeCertVerify13
    HandshakeType
HandshakeType_Finished              -> Get Handshake13
decodeFinished13
    HandshakeType
HandshakeType_KeyUpdate             -> Get Handshake13
decodeKeyUpdate13
    HandshakeType
HandshakeType_CompressedCertificate -> Get Handshake13
decodeCompressedCertificate13
    (HandshakeType Word8
x) -> [Char] -> Get Handshake13
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Handshake13) -> [Char] -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported HandshakeType " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x
{- FOURMOLU_ENABLE -}

decodeServerHello13 :: Get Handshake13
decodeServerHello13 :: Get Handshake13
decodeServerHello13 = do
    Version
ver <- Get Version
getBinaryVersion
    ServerRandom
random <- Get ServerRandom
getServerRandom32
    Session
session <- Get Session
getSession
    CipherId
cipherid <- Word16 -> CipherId
CipherId (Word16 -> CipherId) -> Get Word16 -> Get CipherId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    Word8
comp <- Get Word8
getWord8
    [ExtensionRaw]
exts <- Get Word16
getWord16 Get Word16 -> (Word16 -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions (Int -> Get [ExtensionRaw])
-> (Word16 -> Int) -> Word16 -> Get [ExtensionRaw]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Handshake13 -> Get Handshake13
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Get Handshake13) -> Handshake13 -> Get Handshake13
forall a b. (a -> b) -> a -> b
$
        ServerHello -> Handshake13
ServerHello13 (ServerHello -> Handshake13) -> ServerHello -> Handshake13
forall a b. (a -> b) -> a -> b
$
            SH
                { shVersion :: Version
shVersion = Version
ver
                , shRandom :: ServerRandom
shRandom = ServerRandom
random
                , shSession :: Session
shSession = Session
session
                , shCipher :: CipherId
shCipher = CipherId
cipherid
                , shComp :: Word8
shComp = Word8
comp
                , shExtensions :: [ExtensionRaw]
shExtensions = [ExtensionRaw]
exts
                }

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

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 <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        Int -> Get [ExtensionRaw]
getExtensions Int
len

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
    ([ByteString]
certRaws, [[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 (Int
i, [Char]
s) -> [Char] -> Get Handshake13
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"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] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
        Right CertificateChain
cc -> Handshake13 -> Get Handshake13
forall a. a -> Get a
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 -> CertificateChain_
CertificateChain_ 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 <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
        [ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
        (Int, (ByteString, [ExtensionRaw]))
-> Get (Int, (ByteString, [ExtensionRaw]))
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len, (ByteString
cert, [ExtensionRaw]
exts))

decodeCertRequest13 :: Get Handshake13
decodeCertRequest13 :: Get Handshake13
decodeCertRequest13 = do
    ByteString
reqctx <- Get ByteString
getOpaque8
    Int
len <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
    [ExtensionRaw]
exts <- Int -> Get [ExtensionRaw]
getExtensions Int
len
    Handshake13 -> Get Handshake13
forall a. a -> Get a
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

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

decodeFinished13 :: Get Handshake13
decodeFinished13 :: Get Handshake13
decodeFinished13 = VerifyData -> Handshake13
Finished13 (VerifyData -> Handshake13)
-> (ByteString -> VerifyData) -> ByteString -> Handshake13
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> VerifyData
VerifyData (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 a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
getBytes)

decodeKeyUpdate13 :: Get Handshake13
decodeKeyUpdate13 :: Get Handshake13
decodeKeyUpdate13 = do
    Word8
ru <- Get Word8
getWord8
    case Word8
ru of
        Word8
0 -> Handshake13 -> Get Handshake13
forall a. a -> Get a
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
        Word8
1 -> Handshake13 -> Get Handshake13
forall a. a -> Get a
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
        Word8
x -> [Char] -> Get Handshake13
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Handshake13) -> [Char] -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown request_update: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x

decodeCompressedCertificate13 :: Get Handshake13
decodeCompressedCertificate13 :: Get Handshake13
decodeCompressedCertificate13 = do
    Word16
algo <- Get Word16
getWord16
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
algo Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
1) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"comp algo is not supported" -- fixme
    Int
len <- Get Int
getWord24
    ByteString
bs <- Get ByteString
getOpaque24
    if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
""
        then [Char] -> Get Handshake13
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"empty compressed certificate"
        else case ByteString -> Either DecompressError ByteString
decompressIt ByteString
bs of
            Left DecompressError
e -> [Char] -> Get Handshake13
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (DecompressError -> [Char]
forall a. Show a => a -> [Char]
show DecompressError
e)
            Right ByteString
bs' -> do
                Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
bs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Get ()
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"plain length is wrong"
                case Get Handshake13 -> ByteString -> Maybe Handshake13
forall a. Get a -> ByteString -> Maybe a
runGetMaybe Get Handshake13
decodeCertificate13 ByteString
bs' of
                    Just (Certificate13 ByteString
reqctx CertificateChain_
certs [[ExtensionRaw]]
ess) -> Handshake13 -> Get Handshake13
forall a. a -> Get a
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
CompressedCertificate13 ByteString
reqctx CertificateChain_
certs [[ExtensionRaw]]
ess
                    --                    _ -> fail "compressed certificate cannot be parsed"
                    Maybe Handshake13
_ -> [Char] -> Get Handshake13
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get Handshake13) -> [Char] -> Get Handshake13
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid compressed certificate: len = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len

decompressIt :: ByteString -> Either DecompressError ByteString
decompressIt :: ByteString -> Either DecompressError ByteString
decompressIt ByteString
inp = IO (Either DecompressError ByteString)
-> Either DecompressError ByteString
forall a. IO a -> a
unsafePerformIO (IO (Either DecompressError ByteString)
 -> Either DecompressError ByteString)
-> IO (Either DecompressError ByteString)
-> Either DecompressError ByteString
forall a b. (a -> b) -> a -> b
$ (DecompressError -> IO (Either DecompressError ByteString))
-> IO (Either DecompressError ByteString)
-> IO (Either DecompressError ByteString)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle DecompressError -> IO (Either DecompressError ByteString)
forall {m :: * -> *} {b}.
Monad m =>
DecompressError -> m (Either DecompressError b)
handler (IO (Either DecompressError ByteString)
 -> IO (Either DecompressError ByteString))
-> IO (Either DecompressError ByteString)
-> IO (Either DecompressError ByteString)
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Either DecompressError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either DecompressError ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either DecompressError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> Either DecompressError ByteString)
-> IO ByteString -> IO (Either DecompressError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO ByteString
forall a. a -> IO a
E.evaluate (ByteString -> ByteString
decompress (ByteString -> ByteString
BL.fromStrict ByteString
inp))
  where
    handler :: DecompressError -> m (Either DecompressError b)
handler DecompressError
e = Either DecompressError b -> m (Either DecompressError b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DecompressError b -> m (Either DecompressError b))
-> Either DecompressError b -> m (Either DecompressError b)
forall a b. (a -> b) -> a -> b
$ DecompressError -> Either DecompressError b
forall a b. a -> Either a b
Left (DecompressError
e :: DecompressError)