{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Network.TLS.Packet
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- the Packet module contains everything necessary to serialize and deserialize things
-- with only explicit parameters, no TLS state is involved here.
--
module Network.TLS.Packet
    (
    -- * params for encoding and decoding
      CurrentParams(..)
    -- * marshall functions for header messages
    , decodeHeader
    , decodeDeprecatedHeaderLength
    , decodeDeprecatedHeader
    , encodeHeader
    , encodeHeaderNoVer -- use for SSL3

    -- * marshall functions for alert messages
    , decodeAlert
    , decodeAlerts
    , encodeAlerts

    -- * marshall functions for handshake messages
    , decodeHandshakeRecord
    , decodeHandshake
    , decodeDeprecatedHandshake
    , encodeHandshake
    , encodeHandshakeHeader
    , encodeHandshakeContent

    -- * marshall functions for change cipher spec message
    , decodeChangeCipherSpec
    , encodeChangeCipherSpec

    , decodePreMasterSecret
    , encodePreMasterSecret
    , encodeSignedDHParams
    , encodeSignedECDHParams

    , decodeReallyServerKeyXchgAlgorithmData

    -- * generate things for packet content
    , generateMasterSecret
    , generateExtendedMasterSec
    , generateKeyBlock
    , generateClientFinished
    , generateServerFinished

    , generateCertificateVerify_SSL
    , generateCertificateVerify_SSL_DSS

    -- * for extensions parsing
    , getSignatureHashAlgorithm
    , putSignatureHashAlgorithm
    , getBinaryVersion
    , putBinaryVersion
    , getClientRandom32
    , putClientRandom32
    , getServerRandom32
    , putServerRandom32
    , getExtensions
    , putExtension
    , getSession
    , putSession
    , putDNames
    , getDNames
    ) where

import Network.TLS.Imports
import Network.TLS.Struct
import Network.TLS.Wire
import Network.TLS.Cap
import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)
import Network.TLS.Crypto
import Network.TLS.MAC
import Network.TLS.Cipher (CipherKeyExchangeType(..), Cipher(..))
import Network.TLS.Util.ASN1
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import           Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as B (convert)

data CurrentParams = CurrentParams
    { CurrentParams -> Version
cParamsVersion     :: Version                     -- ^ current protocol version
    , CurrentParams -> Maybe CipherKeyExchangeType
cParamsKeyXchgType :: Maybe CipherKeyExchangeType -- ^ current key exchange type
    } deriving (Int -> CurrentParams -> ShowS
[CurrentParams] -> ShowS
CurrentParams -> String
(Int -> CurrentParams -> ShowS)
-> (CurrentParams -> String)
-> ([CurrentParams] -> ShowS)
-> Show CurrentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentParams] -> ShowS
$cshowList :: [CurrentParams] -> ShowS
show :: CurrentParams -> String
$cshow :: CurrentParams -> String
showsPrec :: Int -> CurrentParams -> ShowS
$cshowsPrec :: Int -> CurrentParams -> ShowS
Show,CurrentParams -> CurrentParams -> Bool
(CurrentParams -> CurrentParams -> Bool)
-> (CurrentParams -> CurrentParams -> Bool) -> Eq CurrentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentParams -> CurrentParams -> Bool
$c/= :: CurrentParams -> CurrentParams -> Bool
== :: CurrentParams -> CurrentParams -> Bool
$c== :: CurrentParams -> CurrentParams -> Bool
Eq)

{- marshall helpers -}
getVersion :: Get Version
getVersion :: Get Version
getVersion = do
    Word8
major <- Get Word8
getWord8
    Word8
minor <- Get Word8
getWord8
    case (Word8, Word8) -> Maybe Version
verOfNum (Word8
major, Word8
minor) of
        Nothing -> String -> Get Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("invalid version : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
major String -> ShowS
forall a. [a] -> [a] -> [a]
++ "," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
minor)
        Just v :: Version
v  -> Version -> Get Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v

getBinaryVersion :: Get (Maybe Version)
getBinaryVersion :: Get (Maybe Version)
getBinaryVersion = do
    Word8
major <- Get Word8
getWord8
    Word8
minor <- Get Word8
getWord8
    Maybe Version -> Get (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> Get (Maybe Version))
-> Maybe Version -> Get (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (Word8, Word8) -> Maybe Version
verOfNum (Word8
major, Word8
minor)

putBinaryVersion :: Version -> Put
putBinaryVersion :: Version -> Put
putBinaryVersion ver :: Version
ver = Putter Word8
putWord8 Word8
major Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
minor
  where (major :: Word8
major, minor :: Word8
minor) = Version -> (Word8, Word8)
numericalVer Version
ver

getHeaderType :: Get ProtocolType
getHeaderType :: Get ProtocolType
getHeaderType = do
    Word8
ty <- Get Word8
getWord8
    case Word8 -> Maybe ProtocolType
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Nothing -> String -> Get ProtocolType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("invalid header type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ty)
        Just t :: ProtocolType
t  -> ProtocolType -> Get ProtocolType
forall (m :: * -> *) a. Monad m => a -> m a
return ProtocolType
t

putHeaderType :: ProtocolType -> Put
putHeaderType :: ProtocolType -> Put
putHeaderType = Putter Word8
putWord8 Putter Word8 -> (ProtocolType -> Word8) -> ProtocolType -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolType -> Word8
forall a. TypeValuable a => a -> Word8
valOfType

getHandshakeType :: Get HandshakeType
getHandshakeType :: Get HandshakeType
getHandshakeType = do
    Word8
ty <- Get Word8
getWord8
    case Word8 -> Maybe HandshakeType
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ty of
        Nothing -> String -> Get HandshakeType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("invalid handshake type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ty)
        Just t :: HandshakeType
t  -> HandshakeType -> Get HandshakeType
forall (m :: * -> *) a. Monad m => a -> m a
return HandshakeType
t

{-
 - decode and encode headers
 -}
decodeHeader :: ByteString -> Either TLSError Header
decodeHeader :: ByteString -> Either TLSError Header
decodeHeader = String -> Get Header -> ByteString -> Either TLSError Header
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "header" (Get Header -> ByteString -> Either TLSError Header)
-> Get Header -> ByteString -> Either TLSError Header
forall a b. (a -> b) -> a -> b
$ ProtocolType -> Version -> Word16 -> Header
Header (ProtocolType -> Version -> Word16 -> Header)
-> Get ProtocolType -> Get (Version -> Word16 -> Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProtocolType
getHeaderType Get (Version -> Word16 -> Header)
-> Get Version -> Get (Word16 -> Header)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Version
getVersion Get (Word16 -> Header) -> Get Word16 -> Get Header
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16

decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
decodeDeprecatedHeaderLength = String -> Get Word16 -> ByteString -> Either TLSError Word16
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "deprecatedheaderlength" (Get Word16 -> ByteString -> Either TLSError Word16)
-> Get Word16 -> ByteString -> Either TLSError Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
subtract 0x8000 (Word16 -> Word16) -> Get Word16 -> Get Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16

decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
decodeDeprecatedHeader size :: Word16
size =
    String -> Get Header -> ByteString -> Either TLSError Header
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "deprecatedheader" (Get Header -> ByteString -> Either TLSError Header)
-> Get Header -> ByteString -> Either TLSError Header
forall a b. (a -> b) -> a -> b
$ do
        Word8
1 <- Get Word8
getWord8
        Version
version <- Get Version
getVersion
        Header -> Get Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ ProtocolType -> Version -> Word16 -> Header
Header ProtocolType
ProtocolType_DeprecatedHandshake Version
version Word16
size

encodeHeader :: Header -> ByteString
encodeHeader :: Header -> ByteString
encodeHeader (Header pt :: ProtocolType
pt ver :: Version
ver len :: Word16
len) = Put -> ByteString
runPut (ProtocolType -> Put
putHeaderType ProtocolType
pt Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version -> Put
putBinaryVersion Version
ver Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16 Word16
len)
        {- FIXME check len <= 2^14 -}

encodeHeaderNoVer :: Header -> ByteString
encodeHeaderNoVer :: Header -> ByteString
encodeHeaderNoVer (Header pt :: ProtocolType
pt _ len :: Word16
len) = Put -> ByteString
runPut (ProtocolType -> Put
putHeaderType ProtocolType
pt Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16 Word16
len)
        {- FIXME check len <= 2^14 -}

{-
 - decode and encode ALERT
 -}
decodeAlert :: Get (AlertLevel, AlertDescription)
decodeAlert :: Get (AlertLevel, AlertDescription)
decodeAlert = do
    Word8
al <- Get Word8
getWord8
    Word8
ad <- Get Word8
getWord8
    case (Word8 -> Maybe AlertLevel
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
al, Word8 -> Maybe AlertDescription
forall a. TypeValuable a => Word8 -> Maybe a
valToType Word8
ad) of
        (Just a :: AlertLevel
a, Just d :: AlertDescription
d) -> (AlertLevel, AlertDescription)
-> Get (AlertLevel, AlertDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlertLevel
a, AlertDescription
d)
        (Nothing, _)     -> String -> Get (AlertLevel, AlertDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "cannot decode alert level"
        (_, Nothing)     -> String -> Get (AlertLevel, AlertDescription)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "cannot decode alert description"

decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
decodeAlerts = String
-> Get [(AlertLevel, AlertDescription)]
-> ByteString
-> Either TLSError [(AlertLevel, AlertDescription)]
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "alerts" Get [(AlertLevel, AlertDescription)]
loop
  where loop :: Get [(AlertLevel, AlertDescription)]
loop = do
            Int
r <- Get Int
remaining
            if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                then [(AlertLevel, AlertDescription)]
-> Get [(AlertLevel, AlertDescription)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                else (:) ((AlertLevel, AlertDescription)
 -> [(AlertLevel, AlertDescription)]
 -> [(AlertLevel, AlertDescription)])
-> Get (AlertLevel, AlertDescription)
-> Get
     ([(AlertLevel, AlertDescription)]
      -> [(AlertLevel, AlertDescription)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (AlertLevel, AlertDescription)
decodeAlert Get
  ([(AlertLevel, AlertDescription)]
   -> [(AlertLevel, AlertDescription)])
-> Get [(AlertLevel, AlertDescription)]
-> Get [(AlertLevel, AlertDescription)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [(AlertLevel, AlertDescription)]
loop

encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
encodeAlerts l :: [(AlertLevel, AlertDescription)]
l = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ((AlertLevel, AlertDescription) -> Put)
-> [(AlertLevel, AlertDescription)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AlertLevel, AlertDescription) -> Put
forall a a. (TypeValuable a, TypeValuable a) => (a, a) -> Put
encodeAlert [(AlertLevel, AlertDescription)]
l
  where encodeAlert :: (a, a) -> Put
encodeAlert (al :: a
al, ad :: a
ad) = Putter Word8
putWord8 (a -> Word8
forall a. TypeValuable a => a -> Word8
valOfType a
al) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (a -> Word8
forall a. TypeValuable a => a -> Word8
valOfType a
ad)

{- decode and encode HANDSHAKE -}
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
decodeHandshakeRecord = String
-> Get (HandshakeType, ByteString)
-> ByteString
-> GetResult (HandshakeType, ByteString)
forall a. String -> Get a -> ByteString -> GetResult a
runGet "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 (m :: * -> *) a. Monad m => a -> m a
return (HandshakeType
ty, ByteString
content)

decodeHandshake :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake
decodeHandshake :: CurrentParams
-> HandshakeType -> ByteString -> Either TLSError Handshake
decodeHandshake cp :: CurrentParams
cp ty :: HandshakeType
ty = String -> Get Handshake -> ByteString -> Either TLSError Handshake
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr ("handshake[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ HandshakeType -> String
forall a. Show a => a -> String
show HandshakeType
ty String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]") (Get Handshake -> ByteString -> Either TLSError Handshake)
-> Get Handshake -> ByteString -> Either TLSError Handshake
forall a b. (a -> b) -> a -> b
$ case HandshakeType
ty of
    HandshakeType_HelloRequest    -> Get Handshake
decodeHelloRequest
    HandshakeType_ClientHello     -> Get Handshake
decodeClientHello
    HandshakeType_ServerHello     -> Get Handshake
decodeServerHello
    HandshakeType_Certificate     -> Get Handshake
decodeCertificates
    HandshakeType_ServerKeyXchg   -> CurrentParams -> Get Handshake
decodeServerKeyXchg CurrentParams
cp
    HandshakeType_CertRequest     -> CurrentParams -> Get Handshake
decodeCertRequest CurrentParams
cp
    HandshakeType_ServerHelloDone -> Get Handshake
decodeServerHelloDone
    HandshakeType_CertVerify      -> CurrentParams -> Get Handshake
decodeCertVerify CurrentParams
cp
    HandshakeType_ClientKeyXchg   -> CurrentParams -> Get Handshake
decodeClientKeyXchg CurrentParams
cp
    HandshakeType_Finished        -> Get Handshake
decodeFinished

decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
decodeDeprecatedHandshake b :: ByteString
b = String -> Get Handshake -> ByteString -> Either TLSError Handshake
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "deprecatedhandshake" Get Handshake
getDeprecated ByteString
b
  where getDeprecated :: Get Handshake
getDeprecated = do
            Word8
1 <- Get Word8
getWord8
            Version
ver <- Get Version
getVersion
            Int
cipherSpecLen <- Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            Int
sessionIdLen <- Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            Int
challengeLen <- Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16
            [Word16]
ciphers <- Int -> Get [Word16]
forall t a. (Ord t, Num t, Enum a) => t -> Get [a]
getCipherSpec Int
cipherSpecLen
            Session
session <- Int -> Get Session
getSessionId Int
sessionIdLen
            ClientRandom
random <- Int -> Get ClientRandom
getChallenge Int
challengeLen
            let compressions :: [Word8]
compressions = [0]
            Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ Version
-> ClientRandom
-> Session
-> [Word16]
-> [Word8]
-> [ExtensionRaw]
-> Maybe ByteString
-> Handshake
ClientHello Version
ver ClientRandom
random Session
session [Word16]
ciphers [Word8]
compressions [] (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b)
        getCipherSpec :: t -> Get [a]
getCipherSpec len :: t
len | t
len t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        getCipherSpec len :: t
len = do
            [c0 :: Int
c0,c1 :: Int
c1,c2 :: Int
c2] <- (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a. Enum a => a -> Int
fromEnum ([Word8] -> [Int]) -> Get [Word8] -> Get [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM 3 Get Word8
getWord8
            ([ Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 0x100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2 | Int
c0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 ] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> Get [a] -> Get [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Get [a]
getCipherSpec (t
len t -> t -> t
forall a. Num a => a -> a -> a
- 3)
        getSessionId :: Int -> Get Session
getSessionId 0 = Session -> Get Session
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> Get Session) -> Session -> Get Session
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
        getSessionId len :: Int
len = Maybe ByteString -> Session
Session (Maybe ByteString -> Session)
-> (ByteString -> Maybe ByteString) -> ByteString -> Session
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Session) -> Get ByteString -> Get Session
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
len
        getChallenge :: Int -> Get ClientRandom
getChallenge len :: Int
len | 32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = Int -> Get ByteString
getBytes (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- 32) Get ByteString -> Get ClientRandom -> Get ClientRandom
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Get ClientRandom
getChallenge 32
        getChallenge len :: Int
len = ByteString -> ClientRandom
ClientRandom (ByteString -> ClientRandom)
-> (ByteString -> ByteString) -> ByteString -> ClientRandom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
B.append (Int -> Word8 -> ByteString
B.replicate (32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) 0) (ByteString -> ClientRandom) -> Get ByteString -> Get ClientRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
len

decodeHelloRequest :: Get Handshake
decodeHelloRequest :: Get Handshake
decodeHelloRequest = Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return Handshake
HelloRequest

decodeClientHello :: Get Handshake
decodeClientHello :: Get Handshake
decodeClientHello = do
    Version
ver          <- Get Version
getVersion
    ClientRandom
random       <- Get ClientRandom
getClientRandom32
    Session
session      <- Get Session
getSession
    [Word16]
ciphers      <- Get [Word16]
getWords16
    [Word8]
compressions <- Get [Word8]
getWords8
    Int
r            <- Get Int
remaining
    [ExtensionRaw]
exts <- if Version -> Bool
hasHelloExtensions Version
ver Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
            then 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 Get Int -> (Int -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
            else [ExtensionRaw] -> Get [ExtensionRaw]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ Version
-> ClientRandom
-> Session
-> [Word16]
-> [Word8]
-> [ExtensionRaw]
-> Maybe ByteString
-> Handshake
ClientHello Version
ver ClientRandom
random Session
session [Word16]
ciphers [Word8]
compressions [ExtensionRaw]
exts Maybe ByteString
forall a. Maybe a
Nothing

decodeServerHello :: Get Handshake
decodeServerHello :: Get Handshake
decodeServerHello = do
    Version
ver           <- Get Version
getVersion
    ServerRandom
random        <- Get ServerRandom
getServerRandom32
    Session
session       <- Get Session
getSession
    Word16
cipherid      <- Get Word16
getWord16
    Word8
compressionid <- Get Word8
getWord8
    Int
r             <- Get Int
remaining
    [ExtensionRaw]
exts <- if Version -> Bool
hasHelloExtensions Version
ver Bool -> Bool -> Bool
&& Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
            then 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 Get Int -> (Int -> Get [ExtensionRaw]) -> Get [ExtensionRaw]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [ExtensionRaw]
getExtensions
            else [ExtensionRaw] -> Get [ExtensionRaw]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ Version
-> ServerRandom
-> Session
-> Word16
-> Word8
-> [ExtensionRaw]
-> Handshake
ServerHello Version
ver ServerRandom
random Session
session Word16
cipherid Word8
compressionid [ExtensionRaw]
exts

decodeServerHelloDone :: Get Handshake
decodeServerHelloDone :: Get Handshake
decodeServerHelloDone = Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return Handshake
ServerHelloDone

decodeCertificates :: Get Handshake
decodeCertificates :: Get Handshake
decodeCertificates = do
    CertificateChainRaw
certsRaw <- [ByteString] -> CertificateChainRaw
CertificateChainRaw ([ByteString] -> CertificateChainRaw)
-> Get [ByteString] -> Get CertificateChainRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getWord24 Get Int -> (Int -> Get [ByteString]) -> Get [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \len :: Int
len -> Int -> Get (Int, ByteString) -> Get [ByteString]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Get (Int, ByteString)
getCertRaw)
    case CertificateChainRaw -> Either (Int, String) CertificateChain
decodeCertificateChain CertificateChainRaw
certsRaw of
        Left (i :: Int
i, s :: String
s) -> String -> Get Handshake
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("error certificate parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
        Right cc :: CertificateChain
cc    -> Handshake -> Get Handshake
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake -> Get Handshake) -> Handshake -> Get Handshake
forall a b. (a -> b) -> a -> b
$ CertificateChain -> Handshake
Certificates CertificateChain
cc
  where getCertRaw :: Get (Int, ByteString)
getCertRaw = Get ByteString
getOpaque24 Get ByteString
-> (ByteString -> Get (Int, ByteString)) -> Get (Int, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cert :: ByteString
cert -> (Int, ByteString) -> Get (Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
cert, ByteString
cert)

decodeFinished :: Get Handshake
decodeFinished :: Get Handshake
decodeFinished = ByteString -> Handshake
Finished (ByteString -> Handshake) -> Get ByteString -> Get Handshake
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)

decodeCertRequest :: CurrentParams -> Get Handshake
decodeCertRequest :: CurrentParams -> Get Handshake
decodeCertRequest cp :: CurrentParams
cp = do
    [Maybe CertificateType]
mcertTypes <- (Word8 -> Maybe CertificateType)
-> [Word8] -> [Maybe CertificateType]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Maybe CertificateType
forall a. TypeValuable a => Word8 -> Maybe a
valToType (Word8 -> Maybe CertificateType)
-> (Word8 -> Word8) -> Word8 -> Maybe CertificateType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> [Maybe CertificateType])
-> Get [Word8] -> Get [Maybe CertificateType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word8]
getWords8
    [CertificateType]
certTypes <- (Maybe CertificateType -> Get CertificateType)
-> [Maybe CertificateType] -> Get [CertificateType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Maybe CertificateType -> Get CertificateType
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
fromJustM "decodeCertRequest") [Maybe CertificateType]
mcertTypes
    Maybe [HashAndSignatureAlgorithm]
sigHashAlgs <- if CurrentParams -> Version
cParamsVersion CurrentParams
cp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS12
                       then [HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm]
forall a. a -> Maybe a
Just ([HashAndSignatureAlgorithm] -> Maybe [HashAndSignatureAlgorithm])
-> Get [HashAndSignatureAlgorithm]
-> Get (Maybe [HashAndSignatureAlgorithm])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word16
getWord16 Get Word16
-> (Word16 -> Get [HashAndSignatureAlgorithm])
-> Get [HashAndSignatureAlgorithm]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Get [HashAndSignatureAlgorithm]
forall a. Integral a => a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms)
                       else Maybe [HashAndSignatureAlgorithm]
-> Get (Maybe [HashAndSignatureAlgorithm])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [HashAndSignatureAlgorithm]
forall a. Maybe a
Nothing
    [CertificateType]
-> Maybe [HashAndSignatureAlgorithm]
-> [DistinguishedName]
-> Handshake
CertRequest [CertificateType]
certTypes Maybe [HashAndSignatureAlgorithm]
sigHashAlgs ([DistinguishedName] -> Handshake)
-> Get [DistinguishedName] -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DistinguishedName]
getDNames
  where getSignatureHashAlgorithms :: a -> Get [HashAndSignatureAlgorithm]
getSignatureHashAlgorithms len :: a
len = Int
-> Get (Int, HashAndSignatureAlgorithm)
-> Get [HashAndSignatureAlgorithm]
forall a. Int -> Get (Int, a) -> Get [a]
getList (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len) (Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm Get HashAndSignatureAlgorithm
-> (HashAndSignatureAlgorithm
    -> Get (Int, HashAndSignatureAlgorithm))
-> Get (Int, HashAndSignatureAlgorithm)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \sh :: HashAndSignatureAlgorithm
sh -> (Int, HashAndSignatureAlgorithm)
-> Get (Int, HashAndSignatureAlgorithm)
forall (m :: * -> *) a. Monad m => a -> m a
return (2, HashAndSignatureAlgorithm
sh))

-- | Decode a list CA distinguished names
getDNames :: Get [DistinguishedName]
getDNames :: Get [DistinguishedName]
getDNames = do
    Word16
dNameLen <- Get Word16
getWord16
    -- FIXME: Decide whether to remove this check completely or to make it an option.
    -- when (cParamsVersion cp < TLS12 && dNameLen < 3) $ fail "certrequest distinguishname not of the correct size"
    Int -> Get (Int, DistinguishedName) -> Get [DistinguishedName]
forall a. Int -> Get (Int, a) -> Get [a]
getList (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dNameLen) Get (Int, DistinguishedName)
getDName
  where
    getDName :: Get (Int, DistinguishedName)
getDName = do
        ByteString
dName <- Get ByteString
getOpaque16
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
dName Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "certrequest: invalid DN length"
        DistinguishedName
dn <- (String -> Get DistinguishedName)
-> (DistinguishedName -> Get DistinguishedName)
-> Either String DistinguishedName
-> Get DistinguishedName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get DistinguishedName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail DistinguishedName -> Get DistinguishedName
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String DistinguishedName -> Get DistinguishedName)
-> Either String DistinguishedName -> Get DistinguishedName
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Either String DistinguishedName
forall a. ASN1Object a => String -> ByteString -> Either String a
decodeASN1Object "cert request DistinguishedName" ByteString
dName
        (Int, DistinguishedName) -> Get (Int, DistinguishedName)
forall (m :: * -> *) a. Monad m => a -> m a
return (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
dName, DistinguishedName
dn)

decodeCertVerify :: CurrentParams -> Get Handshake
decodeCertVerify :: CurrentParams -> Get Handshake
decodeCertVerify cp :: CurrentParams
cp = DigitallySigned -> Handshake
CertVerify (DigitallySigned -> Handshake)
-> Get DigitallySigned -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Get DigitallySigned
getDigitallySigned (CurrentParams -> Version
cParamsVersion CurrentParams
cp)

decodeClientKeyXchg :: CurrentParams -> Get Handshake
decodeClientKeyXchg :: CurrentParams -> Get Handshake
decodeClientKeyXchg cp :: CurrentParams
cp = -- case  ClientKeyXchg <$> (remaining >>= getBytes)
    case CurrentParams -> Maybe CipherKeyExchangeType
cParamsKeyXchgType CurrentParams
cp of
        Nothing  -> String -> Get Handshake
forall a. HasCallStack => String -> a
error "no client key exchange type"
        Just cke :: CipherKeyExchangeType
cke -> ClientKeyXchgAlgorithmData -> Handshake
ClientKeyXchg (ClientKeyXchgAlgorithmData -> Handshake)
-> Get ClientKeyXchgAlgorithmData -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CipherKeyExchangeType -> Get ClientKeyXchgAlgorithmData
parseCKE CipherKeyExchangeType
cke
  where parseCKE :: CipherKeyExchangeType -> Get ClientKeyXchgAlgorithmData
parseCKE CipherKeyExchange_RSA     = ByteString -> ClientKeyXchgAlgorithmData
CKX_RSA (ByteString -> ClientKeyXchgAlgorithmData)
-> Get ByteString -> Get ClientKeyXchgAlgorithmData
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)
        parseCKE CipherKeyExchange_DHE_RSA = Get ClientKeyXchgAlgorithmData
parseClientDHPublic
        parseCKE CipherKeyExchange_DHE_DSS = Get ClientKeyXchgAlgorithmData
parseClientDHPublic
        parseCKE CipherKeyExchange_DH_Anon = Get ClientKeyXchgAlgorithmData
parseClientDHPublic
        parseCKE CipherKeyExchange_ECDHE_RSA   = Get ClientKeyXchgAlgorithmData
parseClientECDHPublic
        parseCKE CipherKeyExchange_ECDHE_ECDSA = Get ClientKeyXchgAlgorithmData
parseClientECDHPublic
        parseCKE _                         = String -> Get ClientKeyXchgAlgorithmData
forall a. HasCallStack => String -> a
error "unsupported client key exchange type"
        parseClientDHPublic :: Get ClientKeyXchgAlgorithmData
parseClientDHPublic = DHPublic -> ClientKeyXchgAlgorithmData
CKX_DH (DHPublic -> ClientKeyXchgAlgorithmData)
-> (Integer -> DHPublic) -> Integer -> ClientKeyXchgAlgorithmData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DHPublic
dhPublic (Integer -> ClientKeyXchgAlgorithmData)
-> Get Integer -> Get ClientKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger16
        parseClientECDHPublic :: Get ClientKeyXchgAlgorithmData
parseClientECDHPublic = ByteString -> ClientKeyXchgAlgorithmData
CKX_ECDH (ByteString -> ClientKeyXchgAlgorithmData)
-> Get ByteString -> Get ClientKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getOpaque8

decodeServerKeyXchg_DH :: Get ServerDHParams
decodeServerKeyXchg_DH :: Get ServerDHParams
decodeServerKeyXchg_DH = Get ServerDHParams
getServerDHParams

-- We don't support ECDH_Anon at this moment
-- decodeServerKeyXchg_ECDH :: Get ServerECDHParams

decodeServerKeyXchg_RSA :: Get ServerRSAParams
decodeServerKeyXchg_RSA :: Get ServerRSAParams
decodeServerKeyXchg_RSA = Integer -> Integer -> ServerRSAParams
ServerRSAParams (Integer -> Integer -> ServerRSAParams)
-> Get Integer -> Get (Integer -> ServerRSAParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
getInteger16 -- modulus
                                          Get (Integer -> ServerRSAParams)
-> Get Integer -> Get ServerRSAParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
getInteger16 -- exponent

decodeServerKeyXchgAlgorithmData :: Version
                                 -> CipherKeyExchangeType
                                 -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData :: Version -> CipherKeyExchangeType -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData ver :: Version
ver cke :: CipherKeyExchangeType
cke = Get ServerKeyXchgAlgorithmData
toCKE
  where toCKE :: Get ServerKeyXchgAlgorithmData
toCKE = case CipherKeyExchangeType
cke of
            CipherKeyExchange_RSA     -> Maybe ServerRSAParams -> ServerKeyXchgAlgorithmData
SKX_RSA (Maybe ServerRSAParams -> ServerKeyXchgAlgorithmData)
-> (ServerRSAParams -> Maybe ServerRSAParams)
-> ServerRSAParams
-> ServerKeyXchgAlgorithmData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerRSAParams -> Maybe ServerRSAParams
forall a. a -> Maybe a
Just (ServerRSAParams -> ServerKeyXchgAlgorithmData)
-> Get ServerRSAParams -> Get ServerKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ServerRSAParams
decodeServerKeyXchg_RSA
            CipherKeyExchange_DH_Anon -> ServerDHParams -> ServerKeyXchgAlgorithmData
SKX_DH_Anon (ServerDHParams -> ServerKeyXchgAlgorithmData)
-> Get ServerDHParams -> Get ServerKeyXchgAlgorithmData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ServerDHParams
decodeServerKeyXchg_DH
            CipherKeyExchange_DHE_RSA -> do
                ServerDHParams
dhparams  <- Get ServerDHParams
getServerDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_RSA ServerDHParams
dhparams DigitallySigned
signature
            CipherKeyExchange_DHE_DSS -> do
                ServerDHParams
dhparams  <- Get ServerDHParams
getServerDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_DHE_DSS ServerDHParams
dhparams DigitallySigned
signature
            CipherKeyExchange_ECDHE_RSA -> do
                ServerECDHParams
ecdhparams  <- Get ServerECDHParams
getServerECDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_RSA ServerECDHParams
ecdhparams DigitallySigned
signature
            CipherKeyExchange_ECDHE_ECDSA -> do
                ServerECDHParams
ecdhparams  <- Get ServerECDHParams
getServerECDHParams
                DigitallySigned
signature <- Version -> Get DigitallySigned
getDigitallySigned Version
ver
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ServerECDHParams -> DigitallySigned -> ServerKeyXchgAlgorithmData
SKX_ECDHE_ECDSA ServerECDHParams
ecdhparams DigitallySigned
signature
            _ -> do
                ByteString
bs <- 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
                ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData)
-> ServerKeyXchgAlgorithmData -> Get ServerKeyXchgAlgorithmData
forall a b. (a -> b) -> a -> b
$ ByteString -> ServerKeyXchgAlgorithmData
SKX_Unknown ByteString
bs

decodeServerKeyXchg :: CurrentParams -> Get Handshake
decodeServerKeyXchg :: CurrentParams -> Get Handshake
decodeServerKeyXchg cp :: CurrentParams
cp =
    case CurrentParams -> Maybe CipherKeyExchangeType
cParamsKeyXchgType CurrentParams
cp of
        Just cke :: CipherKeyExchangeType
cke -> ServerKeyXchgAlgorithmData -> Handshake
ServerKeyXchg (ServerKeyXchgAlgorithmData -> Handshake)
-> Get ServerKeyXchgAlgorithmData -> Get Handshake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> CipherKeyExchangeType -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData (CurrentParams -> Version
cParamsVersion CurrentParams
cp) CipherKeyExchangeType
cke
        Nothing  -> ServerKeyXchgAlgorithmData -> Handshake
ServerKeyXchg (ServerKeyXchgAlgorithmData -> Handshake)
-> (ByteString -> ServerKeyXchgAlgorithmData)
-> ByteString
-> Handshake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ServerKeyXchgAlgorithmData
SKX_Unparsed (ByteString -> Handshake) -> Get ByteString -> Get Handshake
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)

encodeHandshake :: Handshake -> ByteString
encodeHandshake :: Handshake -> ByteString
encodeHandshake o :: Handshake
o =
    let content :: ByteString
content = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Handshake -> Put
encodeHandshakeContent Handshake
o in
    let len :: Int
len = ByteString -> Int
B.length ByteString
content in
    let header :: ByteString
header = case Handshake
o of
                    ClientHello _ _ _ _ _ _ (Just _) -> "" -- SSLv2 ClientHello message
                    _ -> Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ HandshakeType -> Int -> Put
encodeHandshakeHeader (Handshake -> HandshakeType
typeOfHandshake Handshake
o) Int
len in
    [ByteString] -> ByteString
B.concat [ ByteString
header, ByteString
content ]

encodeHandshakeHeader :: HandshakeType -> Int -> Put
encodeHandshakeHeader :: HandshakeType -> Int -> Put
encodeHandshakeHeader ty :: HandshakeType
ty len :: Int
len = Putter Word8
putWord8 (HandshakeType -> Word8
forall a. TypeValuable a => a -> Word8
valOfType HandshakeType
ty) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
putWord24 Int
len

encodeHandshakeContent :: Handshake -> Put

encodeHandshakeContent :: Handshake -> Put
encodeHandshakeContent (ClientHello _ _ _ _ _ _ (Just deprecated :: ByteString
deprecated)) = do
    ByteString -> Put
putBytes ByteString
deprecated
encodeHandshakeContent (ClientHello version :: Version
version random :: ClientRandom
random session :: Session
session cipherIDs :: [Word16]
cipherIDs compressionIDs :: [Word8]
compressionIDs exts :: [ExtensionRaw]
exts Nothing) = 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]
compressionIDs
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
    () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (ServerHello version :: Version
version random :: ServerRandom
random session :: Session
session cipherid :: Word16
cipherid compressionID :: Word8
compressionID exts :: [ExtensionRaw]
exts) = do
    Version -> Put
putBinaryVersion Version
version
    ServerRandom -> Put
putServerRandom32 ServerRandom
random
    Session -> Put
putSession Session
session
    Word16 -> Put
putWord16 Word16
cipherid
    Putter Word8
putWord8 Word8
compressionID
    [ExtensionRaw] -> Put
putExtensions [ExtensionRaw]
exts
    () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (Certificates cc :: CertificateChain
cc) = ByteString -> Put
putOpaque24 (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
putOpaque24 [ByteString]
certs)
  where (CertificateChainRaw certs :: [ByteString]
certs) = CertificateChain -> CertificateChainRaw
encodeCertificateChain CertificateChain
cc

encodeHandshakeContent (ClientKeyXchg ckx :: ClientKeyXchgAlgorithmData
ckx) = do
    case ClientKeyXchgAlgorithmData
ckx of
        CKX_RSA encryptedPreMaster :: ByteString
encryptedPreMaster -> ByteString -> Put
putBytes ByteString
encryptedPreMaster
        CKX_DH clientDHPublic :: DHPublic
clientDHPublic      -> Integer -> Put
putInteger16 (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ DHPublic -> Integer
dhUnwrapPublic DHPublic
clientDHPublic
        CKX_ECDH bytes :: ByteString
bytes             -> ByteString -> Put
putOpaque8 ByteString
bytes

encodeHandshakeContent (ServerKeyXchg skg :: ServerKeyXchgAlgorithmData
skg) =
    case ServerKeyXchgAlgorithmData
skg of
        SKX_RSA _              -> String -> Put
forall a. HasCallStack => String -> a
error "encodeHandshakeContent SKX_RSA not implemented"
        SKX_DH_Anon params :: ServerDHParams
params     -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params
        SKX_DHE_RSA params :: ServerDHParams
params sig :: DigitallySigned
sig -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_DHE_DSS params :: ServerDHParams
params sig :: DigitallySigned
sig -> ServerDHParams -> Put
putServerDHParams ServerDHParams
params Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_ECDHE_RSA params :: ServerECDHParams
params sig :: DigitallySigned
sig -> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
params Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_ECDHE_ECDSA params :: ServerECDHParams
params sig :: DigitallySigned
sig -> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
params Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DigitallySigned -> Put
putDigitallySigned DigitallySigned
sig
        SKX_Unparsed bytes :: ByteString
bytes     -> ByteString -> Put
putBytes ByteString
bytes
        _                      -> String -> Put
forall a. HasCallStack => String -> a
error ("encodeHandshakeContent: cannot handle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ServerKeyXchgAlgorithmData -> String
forall a. Show a => a -> String
show ServerKeyXchgAlgorithmData
skg)

encodeHandshakeContent HelloRequest    = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
encodeHandshakeContent ServerHelloDone = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

encodeHandshakeContent (CertRequest certTypes :: [CertificateType]
certTypes sigAlgs :: Maybe [HashAndSignatureAlgorithm]
sigAlgs certAuthorities :: [DistinguishedName]
certAuthorities) = do
    [Word8] -> Put
putWords8 ((CertificateType -> Word8) -> [CertificateType] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CertificateType -> Word8
forall a. TypeValuable a => a -> Word8
valOfType [CertificateType]
certTypes)
    case Maybe [HashAndSignatureAlgorithm]
sigAlgs of
        Nothing -> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just l :: [HashAndSignatureAlgorithm]
l  -> [Word16] -> Put
putWords16 ([Word16] -> Put) -> [Word16] -> Put
forall a b. (a -> b) -> a -> b
$ (HashAndSignatureAlgorithm -> Word16)
-> [HashAndSignatureAlgorithm] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: HashAlgorithm
x,y :: SignatureAlgorithm
y) -> Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HashAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType HashAlgorithm
x) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* 256 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SignatureAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType SignatureAlgorithm
y)) [HashAndSignatureAlgorithm]
l
    [DistinguishedName] -> Put
putDNames [DistinguishedName]
certAuthorities

encodeHandshakeContent (CertVerify digitallySigned :: DigitallySigned
digitallySigned) = DigitallySigned -> Put
putDigitallySigned DigitallySigned
digitallySigned

encodeHandshakeContent (Finished opaque :: ByteString
opaque) = ByteString -> Put
putBytes ByteString
opaque

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

-- | Encode a list of distinguished names.
putDNames :: [DistinguishedName] -> Put
putDNames :: [DistinguishedName] -> Put
putDNames dnames :: [DistinguishedName]
dnames = do
    [ByteString]
enc <- (DistinguishedName -> PutM ByteString)
-> [DistinguishedName] -> PutM [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DistinguishedName -> PutM ByteString
forall (m :: * -> *) a.
(Monad m, ASN1Object a) =>
a -> m ByteString
encodeCA [DistinguishedName]
dnames
    let totLength :: Int
totLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) 2 (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
enc
    Word16 -> Put
putWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength)
    (ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ b :: ByteString
b -> Word16 -> Put
putWord16 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
b)) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putBytes ByteString
b) [ByteString]
enc
  where
    -- Convert a distinguished name to its DER encoding.
    encodeCA :: a -> m ByteString
encodeCA dn :: a
dn = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeASN1Object a
dn

{- FIXME make sure it return error if not 32 available -}
getRandom32 :: Get ByteString
getRandom32 :: Get ByteString
getRandom32 = Int -> Get ByteString
getBytes 32

getServerRandom32 :: Get ServerRandom
getServerRandom32 :: Get ServerRandom
getServerRandom32 = ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> Get ByteString -> Get ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRandom32

getClientRandom32 :: Get ClientRandom
getClientRandom32 :: Get ClientRandom
getClientRandom32 = ByteString -> ClientRandom
ClientRandom (ByteString -> ClientRandom) -> Get ByteString -> Get ClientRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRandom32

putRandom32 :: ByteString -> Put
putRandom32 :: ByteString -> Put
putRandom32 = ByteString -> Put
putBytes

putClientRandom32 :: ClientRandom -> Put
putClientRandom32 :: ClientRandom -> Put
putClientRandom32 (ClientRandom r :: ByteString
r) = ByteString -> Put
putRandom32 ByteString
r

putServerRandom32 :: ServerRandom -> Put
putServerRandom32 :: ServerRandom -> Put
putServerRandom32 (ServerRandom r :: ByteString
r) = ByteString -> Put
putRandom32 ByteString
r

getSession :: Get Session
getSession :: Get Session
getSession = do
    Word8
len8 <- Get Word8
getWord8
    case Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len8 of
        0   -> Session -> Get Session
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> Get Session) -> Session -> Get Session
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
        len :: Int
len -> Maybe ByteString -> Session
Session (Maybe ByteString -> Session)
-> (ByteString -> Maybe ByteString) -> ByteString -> Session
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Session) -> Get ByteString -> Get Session
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
len

putSession :: Session -> Put
putSession :: Session -> Put
putSession (Session Nothing)  = Putter Word8
putWord8 0
putSession (Session (Just s :: ByteString
s)) = ByteString -> Put
putOpaque8 ByteString
s

getExtensions :: Int -> Get [ExtensionRaw]
getExtensions :: Int -> Get [ExtensionRaw]
getExtensions 0   = [ExtensionRaw] -> Get [ExtensionRaw]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getExtensions len :: Int
len = do
    Word16
extty <- Get Word16
getWord16
    Word16
extdatalen <- Get Word16
getWord16
    ByteString
extdata <- Int -> Get ByteString
getBytes (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extdatalen
    [ExtensionRaw]
extxs <- Int -> Get [ExtensionRaw]
getExtensions (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extdatalen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4)
    [ExtensionRaw] -> Get [ExtensionRaw]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExtensionRaw] -> Get [ExtensionRaw])
-> [ExtensionRaw] -> Get [ExtensionRaw]
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> ExtensionRaw
ExtensionRaw Word16
extty ByteString
extdata ExtensionRaw -> [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> [a] -> [a]
: [ExtensionRaw]
extxs

putExtension :: ExtensionRaw -> Put
putExtension :: ExtensionRaw -> Put
putExtension (ExtensionRaw ty :: Word16
ty l :: ByteString
l) = Word16 -> Put
putWord16 Word16
ty Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putOpaque16 ByteString
l

putExtensions :: [ExtensionRaw] -> Put
putExtensions :: [ExtensionRaw] -> Put
putExtensions [] = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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)

getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm = do
    HashAlgorithm
h <- (Word8 -> Maybe HashAlgorithm
forall a. TypeValuable a => Word8 -> Maybe a
valToType (Word8 -> Maybe HashAlgorithm)
-> Get Word8 -> Get (Maybe HashAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) Get (Maybe HashAlgorithm)
-> (Maybe HashAlgorithm -> Get HashAlgorithm) -> Get HashAlgorithm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe HashAlgorithm -> Get HashAlgorithm
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
fromJustM "getSignatureHashAlgorithm"
    SignatureAlgorithm
s <- (Word8 -> Maybe SignatureAlgorithm
forall a. TypeValuable a => Word8 -> Maybe a
valToType (Word8 -> Maybe SignatureAlgorithm)
-> Get Word8 -> Get (Maybe SignatureAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) Get (Maybe SignatureAlgorithm)
-> (Maybe SignatureAlgorithm -> Get SignatureAlgorithm)
-> Get SignatureAlgorithm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe SignatureAlgorithm -> Get SignatureAlgorithm
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
fromJustM "getSignatureHashAlgorithm"
    HashAndSignatureAlgorithm -> Get HashAndSignatureAlgorithm
forall (m :: * -> *) a. Monad m => a -> m a
return (HashAlgorithm
h,SignatureAlgorithm
s)

putSignatureHashAlgorithm :: HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm :: HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm (h :: HashAlgorithm
h,s :: SignatureAlgorithm
s) =
    Putter Word8
putWord8 (HashAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType HashAlgorithm
h) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 (SignatureAlgorithm -> Word8
forall a. TypeValuable a => a -> Word8
valOfType SignatureAlgorithm
s)

getServerDHParams :: Get ServerDHParams
getServerDHParams :: Get ServerDHParams
getServerDHParams = BigNum -> BigNum -> BigNum -> ServerDHParams
ServerDHParams (BigNum -> BigNum -> BigNum -> ServerDHParams)
-> Get BigNum -> Get (BigNum -> BigNum -> ServerDHParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BigNum
getBigNum16 Get (BigNum -> BigNum -> ServerDHParams)
-> Get BigNum -> Get (BigNum -> ServerDHParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BigNum
getBigNum16 Get (BigNum -> ServerDHParams) -> Get BigNum -> Get ServerDHParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BigNum
getBigNum16

putServerDHParams :: ServerDHParams -> Put
putServerDHParams :: ServerDHParams -> Put
putServerDHParams (ServerDHParams p :: BigNum
p g :: BigNum
g y :: BigNum
y) = (BigNum -> Put) -> [BigNum] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BigNum -> Put
putBigNum16 [BigNum
p,BigNum
g,BigNum
y]

-- RFC 4492 Section 5.4 Server Key Exchange
getServerECDHParams :: Get ServerECDHParams
getServerECDHParams :: Get ServerECDHParams
getServerECDHParams = do
    Word8
curveType <- Get Word8
getWord8
    case Word8
curveType of
        3 -> do               -- ECParameters ECCurveType: curve name type
            Maybe Group
mgrp <- Word16 -> Maybe Group
forall a. EnumSafe16 a => Word16 -> Maybe a
toEnumSafe16 (Word16 -> Maybe Group) -> Get Word16 -> Get (Maybe Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16  -- ECParameters NamedCurve
            case Maybe Group
mgrp of
              Nothing -> String -> Get ServerECDHParams
forall a. HasCallStack => String -> a
error "getServerECDHParams: unknown group"
              Just grp :: Group
grp -> do
                  ByteString
mxy <- Get ByteString
getOpaque8 -- ECPoint
                  case Group -> ByteString -> Either CryptoError GroupPublic
decodeGroupPublic Group
grp ByteString
mxy of
                    Left e :: CryptoError
e       -> String -> Get ServerECDHParams
forall a. HasCallStack => String -> a
error (String -> Get ServerECDHParams) -> String -> Get ServerECDHParams
forall a b. (a -> b) -> a -> b
$ "getServerECDHParams: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e
                    Right grppub :: GroupPublic
grppub -> ServerECDHParams -> Get ServerECDHParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerECDHParams -> Get ServerECDHParams)
-> ServerECDHParams -> Get ServerECDHParams
forall a b. (a -> b) -> a -> b
$ Group -> GroupPublic -> ServerECDHParams
ServerECDHParams Group
grp GroupPublic
grppub
        _ ->
            String -> Get ServerECDHParams
forall a. HasCallStack => String -> a
error "getServerECDHParams: unknown type for ECDH Params"

-- RFC 4492 Section 5.4 Server Key Exchange
putServerECDHParams :: ServerECDHParams -> Put
putServerECDHParams :: ServerECDHParams -> Put
putServerECDHParams (ServerECDHParams grp :: Group
grp grppub :: GroupPublic
grppub) = do
    Putter Word8
putWord8 3                            -- ECParameters ECCurveType
    Word16 -> Put
putWord16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Group -> Word16
forall a. EnumSafe16 a => a -> Word16
fromEnumSafe16 Group
grp        -- ECParameters NamedCurve
    ByteString -> Put
putOpaque8 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ GroupPublic -> ByteString
encodeGroupPublic GroupPublic
grppub -- ECPoint

getDigitallySigned :: Version -> Get DigitallySigned
getDigitallySigned :: Version -> Get DigitallySigned
getDigitallySigned ver :: Version
ver
    | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS12 = Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned (Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned)
-> Get (Maybe HashAndSignatureAlgorithm)
-> Get (ByteString -> DigitallySigned)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm
forall a. a -> Maybe a
Just (HashAndSignatureAlgorithm -> Maybe HashAndSignatureAlgorithm)
-> Get HashAndSignatureAlgorithm
-> Get (Maybe HashAndSignatureAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HashAndSignatureAlgorithm
getSignatureHashAlgorithm)
                                     Get (ByteString -> DigitallySigned)
-> Get ByteString -> Get DigitallySigned
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
getOpaque16
    | Bool
otherwise    = Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
DigitallySigned Maybe HashAndSignatureAlgorithm
forall a. Maybe a
Nothing (ByteString -> DigitallySigned)
-> Get ByteString -> Get DigitallySigned
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getOpaque16

putDigitallySigned :: DigitallySigned -> Put
putDigitallySigned :: DigitallySigned -> Put
putDigitallySigned (DigitallySigned mhash :: Maybe HashAndSignatureAlgorithm
mhash sig :: ByteString
sig) =
    Put
-> (HashAndSignatureAlgorithm -> Put)
-> Maybe HashAndSignatureAlgorithm
-> Put
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()) HashAndSignatureAlgorithm -> Put
putSignatureHashAlgorithm Maybe HashAndSignatureAlgorithm
mhash Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putOpaque16 ByteString
sig

{-
 - decode and encode ALERT
 -}

decodeChangeCipherSpec :: ByteString -> Either TLSError ()
decodeChangeCipherSpec :: ByteString -> Either TLSError ()
decodeChangeCipherSpec = String -> Get () -> ByteString -> Either TLSError ()
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "changecipherspec" (Get () -> ByteString -> Either TLSError ())
-> Get () -> ByteString -> Either TLSError ()
forall a b. (a -> b) -> a -> b
$ do
    Word8
x <- Get Word8
getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unknown change cipher spec content")

encodeChangeCipherSpec :: ByteString
encodeChangeCipherSpec :: ByteString
encodeChangeCipherSpec = Put -> ByteString
runPut (Putter Word8
putWord8 1)

-- rsa pre master secret
decodePreMasterSecret :: ByteString -> Either TLSError (Version, ByteString)
decodePreMasterSecret :: ByteString -> Either TLSError (Version, ByteString)
decodePreMasterSecret = String
-> Get (Version, ByteString)
-> ByteString
-> Either TLSError (Version, ByteString)
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "pre-master-secret" (Get (Version, ByteString)
 -> ByteString -> Either TLSError (Version, ByteString))
-> Get (Version, ByteString)
-> ByteString
-> Either TLSError (Version, ByteString)
forall a b. (a -> b) -> a -> b
$
    (,) (Version -> ByteString -> (Version, ByteString))
-> Get Version -> Get (ByteString -> (Version, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Version
getVersion Get (ByteString -> (Version, ByteString))
-> Get ByteString -> Get (Version, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
getBytes 46

encodePreMasterSecret :: Version -> ByteString -> ByteString
encodePreMasterSecret :: Version -> ByteString -> ByteString
encodePreMasterSecret version :: Version
version bytes :: ByteString
bytes = Put -> ByteString
runPut (Version -> Put
putBinaryVersion Version
version Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putBytes ByteString
bytes)

-- | in certain cases, we haven't manage to decode ServerKeyExchange properly,
-- because the decoding was too eager and the cipher wasn't been set yet.
-- we keep the Server Key Exchange in it unparsed format, and this function is
-- able to really decode the server key xchange if it's unparsed.
decodeReallyServerKeyXchgAlgorithmData :: Version
                                       -> CipherKeyExchangeType
                                       -> ByteString
                                       -> Either TLSError ServerKeyXchgAlgorithmData
decodeReallyServerKeyXchgAlgorithmData :: Version
-> CipherKeyExchangeType
-> ByteString
-> Either TLSError ServerKeyXchgAlgorithmData
decodeReallyServerKeyXchgAlgorithmData ver :: Version
ver cke :: CipherKeyExchangeType
cke =
    String
-> Get ServerKeyXchgAlgorithmData
-> ByteString
-> Either TLSError ServerKeyXchgAlgorithmData
forall a. String -> Get a -> ByteString -> Either TLSError a
runGetErr "server-key-xchg-algorithm-data" (Version -> CipherKeyExchangeType -> Get ServerKeyXchgAlgorithmData
decodeServerKeyXchgAlgorithmData Version
ver CipherKeyExchangeType
cke)


{-
 - generate things for packet content
 -}
type PRF = ByteString -> ByteString -> Int -> ByteString

-- | The TLS12 PRF is cipher specific, and some TLS12 algorithms use SHA384
-- instead of the default SHA256.
getPRF :: Version -> Cipher -> PRF
getPRF :: Version -> Cipher -> PRF
getPRF ver :: Version
ver ciph :: Cipher
ciph
    | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
TLS12 = PRF
prf_MD5SHA1
    | Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
TLS12) (Cipher -> Maybe Version
cipherMinVer Cipher
ciph) = PRF
prf_SHA256
    | Bool
otherwise = Version -> Hash -> PRF
prf_TLS Version
ver (Hash -> PRF) -> Hash -> PRF
forall a b. (a -> b) -> a -> b
$ Hash -> Maybe Hash -> Hash
forall a. a -> Maybe a -> a
fromMaybe Hash
SHA256 (Maybe Hash -> Hash) -> Maybe Hash -> Hash
forall a b. (a -> b) -> a -> b
$ Cipher -> Maybe Hash
cipherPRFHash Cipher
ciph

generateMasterSecret_SSL :: ByteArrayAccess preMaster => preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL :: preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL premasterSecret :: preMaster
premasterSecret (ClientRandom c :: ByteString
c) (ServerRandom s :: ByteString
s) =
    [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
computeMD5 ["A","BB","CCC"]
  where computeMD5 :: ByteString -> ByteString
computeMD5  label :: ByteString
label = Hash -> ByteString -> ByteString
hash Hash
MD5 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ preMaster -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret, ByteString -> ByteString
computeSHA1 ByteString
label ]
        computeSHA1 :: ByteString -> ByteString
computeSHA1 label :: ByteString
label = Hash -> ByteString -> ByteString
hash Hash
SHA1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
label, preMaster -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret, ByteString
c, ByteString
s ]

generateMasterSecret_TLS :: ByteArrayAccess preMaster => PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS :: PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS prf :: PRF
prf premasterSecret :: preMaster
premasterSecret (ClientRandom c :: ByteString
c) (ServerRandom s :: ByteString
s) =
    PRF
prf (preMaster -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret) ByteString
seed 48
  where seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ "master secret", ByteString
c, ByteString
s ]

generateMasterSecret :: ByteArrayAccess preMaster
                     => Version
                     -> Cipher
                     -> preMaster
                     -> ClientRandom
                     -> ServerRandom
                     -> ByteString
generateMasterSecret :: Version
-> Cipher
-> preMaster
-> ClientRandom
-> ServerRandom
-> ByteString
generateMasterSecret SSL2 _ = preMaster -> ClientRandom -> ServerRandom -> ByteString
forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL
generateMasterSecret SSL3 _ = preMaster -> ClientRandom -> ServerRandom -> ByteString
forall preMaster.
ByteArrayAccess preMaster =>
preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_SSL
generateMasterSecret v :: Version
v    c :: Cipher
c = PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
forall preMaster.
ByteArrayAccess preMaster =>
PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
generateMasterSecret_TLS (PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString)
-> PRF -> preMaster -> ClientRandom -> ServerRandom -> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> Cipher -> PRF
getPRF Version
v Cipher
c

generateExtendedMasterSec :: ByteArrayAccess preMaster
                          => Version
                          -> Cipher
                          -> preMaster
                          -> ByteString
                          -> ByteString
generateExtendedMasterSec :: Version -> Cipher -> preMaster -> ByteString -> ByteString
generateExtendedMasterSec v :: Version
v c :: Cipher
c premasterSecret :: preMaster
premasterSecret sessionHash :: ByteString
sessionHash =
    Version -> Cipher -> PRF
getPRF Version
v Cipher
c (preMaster -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert preMaster
premasterSecret) ByteString
seed 48
  where seed :: ByteString
seed = ByteString -> ByteString -> ByteString
B.append "extended master secret" ByteString
sessionHash

generateKeyBlock_TLS :: PRF -> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS :: PRF
-> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS prf :: PRF
prf (ClientRandom c :: ByteString
c) (ServerRandom s :: ByteString
s) mastersecret :: ByteString
mastersecret kbsize :: Int
kbsize =
    PRF
prf ByteString
mastersecret ByteString
seed Int
kbsize where seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ "key expansion", ByteString
s, ByteString
c ]

generateKeyBlock_SSL :: ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL :: ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL (ClientRandom c :: ByteString
c) (ServerRandom s :: ByteString
s) mastersecret :: ByteString
mastersecret kbsize :: Int
kbsize =
    [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
computeMD5 ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take ((Int
kbsize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [ByteString]
labels
  where labels :: [ByteString]
labels            = [ (Int -> Char -> ByteString) -> (Int, Char) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Char -> ByteString
BC.replicate (Int, Char)
x | (Int, Char)
x <- [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] ['A'..'Z'] ]
        computeMD5 :: ByteString -> ByteString
computeMD5  label :: ByteString
label = Hash -> ByteString -> ByteString
hash Hash
MD5 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, ByteString -> ByteString
computeSHA1 ByteString
label ]
        computeSHA1 :: ByteString -> ByteString
computeSHA1 label :: ByteString
label = Hash -> ByteString -> ByteString
hash Hash
SHA1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
label, ByteString
mastersecret, ByteString
s, ByteString
c ]

generateKeyBlock :: Version
                 -> Cipher
                 -> ClientRandom
                 -> ServerRandom
                 -> ByteString
                 -> Int
                 -> ByteString
generateKeyBlock :: Version
-> Cipher
-> ClientRandom
-> ServerRandom
-> ByteString
-> Int
-> ByteString
generateKeyBlock SSL2 _ = ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL
generateKeyBlock SSL3 _ = ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_SSL
generateKeyBlock v :: Version
v    c :: Cipher
c = PRF
-> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString
generateKeyBlock_TLS (PRF
 -> ClientRandom -> ServerRandom -> ByteString -> Int -> ByteString)
-> PRF
-> ClientRandom
-> ServerRandom
-> ByteString
-> Int
-> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> Cipher -> PRF
getPRF Version
v Cipher
c

generateFinished_TLS :: PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS :: PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS prf :: PRF
prf label :: ByteString
label mastersecret :: ByteString
mastersecret hashctx :: HashCtx
hashctx = PRF
prf ByteString
mastersecret ByteString
seed 12
  where seed :: ByteString
seed = [ByteString] -> ByteString
B.concat [ ByteString
label, HashCtx -> ByteString
hashFinal HashCtx
hashctx ]

generateFinished_SSL :: ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL :: ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL sender :: ByteString
sender mastersecret :: ByteString
mastersecret hashctx :: HashCtx
hashctx = [ByteString] -> ByteString
B.concat [ByteString
md5hash, ByteString
sha1hash]
  where md5hash :: ByteString
md5hash  = Hash -> ByteString -> ByteString
hash Hash
MD5 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, ByteString
pad2, ByteString
md5left ]
        sha1hash :: ByteString
sha1hash = Hash -> ByteString -> ByteString
hash Hash
SHA1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, Int -> ByteString -> ByteString
B.take 40 ByteString
pad2, ByteString
sha1left ]

        lefthash :: ByteString
lefthash = HashCtx -> ByteString
hashFinal (HashCtx -> ByteString) -> HashCtx -> ByteString
forall a b. (a -> b) -> a -> b
$ (HashCtx -> (ByteString, ByteString) -> HashCtx)
-> (ByteString, ByteString) -> HashCtx -> HashCtx
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashCtx -> (ByteString, ByteString) -> HashCtx
hashUpdateSSL (ByteString
pad1, Int -> ByteString -> ByteString
B.take 40 ByteString
pad1)
                             (HashCtx -> HashCtx) -> HashCtx -> HashCtx
forall a b. (a -> b) -> a -> b
$ (HashCtx -> ByteString -> HashCtx)
-> HashCtx -> [ByteString] -> HashCtx
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashctx [ByteString
sender,ByteString
mastersecret]
        (md5left :: ByteString
md5left,sha1left :: ByteString
sha1left) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 16 ByteString
lefthash
        pad2 :: ByteString
pad2     = Int -> Word8 -> ByteString
B.replicate 48 0x5c
        pad1 :: ByteString
pad1     = Int -> Word8 -> ByteString
B.replicate 48 0x36

generateClientFinished :: Version
                       -> Cipher
                       -> ByteString
                       -> HashCtx
                       -> ByteString
generateClientFinished :: Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateClientFinished ver :: Version
ver ciph :: Cipher
ciph
    | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
TLS10 = ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL "CLNT"
    | Bool
otherwise   = PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS (Version -> Cipher -> PRF
getPRF Version
ver Cipher
ciph) "client finished"

generateServerFinished :: Version
                       -> Cipher
                       -> ByteString
                       -> HashCtx
                       -> ByteString
generateServerFinished :: Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateServerFinished ver :: Version
ver ciph :: Cipher
ciph
    | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
TLS10 = ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL "SRVR"
    | Bool
otherwise   = PRF -> ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_TLS (Version -> Cipher -> PRF
getPRF Version
ver Cipher
ciph) "server finished"

{- returns *output* after final MD5/SHA1 -}
generateCertificateVerify_SSL :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL = ByteString -> ByteString -> HashCtx -> ByteString
generateFinished_SSL ""

{- returns *input* before final SHA1 -}
generateCertificateVerify_SSL_DSS :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL_DSS :: ByteString -> HashCtx -> ByteString
generateCertificateVerify_SSL_DSS mastersecret :: ByteString
mastersecret hashctx :: HashCtx
hashctx = ByteString
toHash
  where toHash :: ByteString
toHash = [ByteString] -> ByteString
B.concat [ ByteString
mastersecret, ByteString
pad2, ByteString
sha1left ]

        sha1left :: ByteString
sha1left = HashCtx -> ByteString
hashFinal (HashCtx -> ByteString) -> HashCtx -> ByteString
forall a b. (a -> b) -> a -> b
$ (HashCtx -> ByteString -> HashCtx)
-> ByteString -> HashCtx -> HashCtx
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashCtx -> ByteString -> HashCtx
hashUpdate ByteString
pad1
                             (HashCtx -> HashCtx) -> HashCtx -> HashCtx
forall a b. (a -> b) -> a -> b
$ HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashctx ByteString
mastersecret
        pad2 :: ByteString
pad2     = Int -> Word8 -> ByteString
B.replicate 40 0x5c
        pad1 :: ByteString
pad1     = Int -> Word8 -> ByteString
B.replicate 40 0x36

encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedDHParams dhparams :: ServerDHParams
dhparams cran :: ClientRandom
cran sran :: ServerRandom
sran = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
    ClientRandom -> Put
putClientRandom32 ClientRandom
cran Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerDHParams -> Put
putServerDHParams ServerDHParams
dhparams

-- Combination of RFC 5246 and 4492 is ambiguous.
-- Let's assume ecdhe_rsa and ecdhe_dss are identical to
-- dhe_rsa and dhe_dss.
encodeSignedECDHParams :: ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedECDHParams :: ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
encodeSignedECDHParams dhparams :: ServerECDHParams
dhparams cran :: ClientRandom
cran sran :: ServerRandom
sran = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
    ClientRandom -> Put
putClientRandom32 ClientRandom
cran Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerRandom -> Put
putServerRandom32 ServerRandom
sran Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerECDHParams -> Put
putServerECDHParams ServerECDHParams
dhparams

fromJustM :: MonadFail m => String -> Maybe a -> m a
fromJustM :: String -> Maybe a -> m a
fromJustM what :: String
what Nothing  = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("fromJustM " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Nothing")
fromJustM _    (Just x :: a
x) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x