{-# LANGUAGE PatternGuards #-}
-- |
-- Module      : Network.TLS.Handshake.Random
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Handshake.Random (
      serverRandom
    , clientRandom
    , hrrRandom
    , isHelloRetryRequest
    , isDowngraded
    ) where

import qualified Data.ByteString as B
import Network.TLS.Context.Internal
import Network.TLS.Struct

-- | Generate a server random suitable for the version selected by the server
-- and its supported versions.  We use an 8-byte downgrade suffix when the
-- selected version is lowered because of incomplete client support, but also
-- when a version downgrade has been forced with 'debugVersionForced'.  This
-- second part allows to test that the client implementation correctly detects
-- downgrades.  The suffix is not used when forcing TLS13 to a server not
-- officially supporting TLS13 (this is not a downgrade scenario but only the
-- consequence of our debug API allowing this).
serverRandom :: Context -> Version -> [Version] -> IO ServerRandom
serverRandom :: Context -> Version -> [Version] -> IO ServerRandom
serverRandom ctx :: Context
ctx chosenVer :: Version
chosenVer suppVers :: [Version]
suppVers
  | Version
TLS13 Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version]
suppVers = case Version
chosenVer of
      TLS13  -> ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Int -> IO ByteString
getStateRNG Context
ctx 32
      TLS12  -> ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO ByteString
genServRand ByteString
suffix12
      _      -> ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO ByteString
genServRand ByteString
suffix11
  | Version
TLS12 Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version]
suppVers = case Version
chosenVer of
      TLS13  -> ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Int -> IO ByteString
getStateRNG Context
ctx 32
      TLS12  -> ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Int -> IO ByteString
getStateRNG Context
ctx 32
      _      -> ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO ByteString
genServRand ByteString
suffix11
  | Bool
otherwise = ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> IO ByteString -> IO ServerRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Int -> IO ByteString
getStateRNG Context
ctx 32
  where
    genServRand :: ByteString -> IO ByteString
genServRand suff :: ByteString
suff = do
        ByteString
pref <- Context -> Int -> IO ByteString
getStateRNG Context
ctx 24
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
pref ByteString -> ByteString -> ByteString
`B.append` ByteString
suff)

-- | Test if the negotiated version was artificially downgraded (that is, for
-- other reason than the versions supported by the client).
isDowngraded :: Version -> [Version] -> ServerRandom -> Bool
isDowngraded :: Version -> [Version] -> ServerRandom -> Bool
isDowngraded ver :: Version
ver suppVers :: [Version]
suppVers (ServerRandom sr :: ByteString
sr)
  | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
TLS12
  , Version
TLS13 Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version]
suppVers = ByteString
suffix12 ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
sr
                         Bool -> Bool -> Bool
|| ByteString
suffix11 ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
sr
  | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
TLS11
  , Version
TLS12 Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version]
suppVers = ByteString
suffix11 ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
sr
  | Bool
otherwise             = Bool
False

suffix12 :: B.ByteString
suffix12 :: ByteString
suffix12 = [Word8] -> ByteString
B.pack [0x44, 0x4F, 0x57, 0x4E, 0x47, 0x52, 0x44, 0x01]

suffix11 :: B.ByteString
suffix11 :: ByteString
suffix11 = [Word8] -> ByteString
B.pack [0x44, 0x4F, 0x57, 0x4E, 0x47, 0x52, 0x44, 0x00]

clientRandom :: Context -> IO ClientRandom
clientRandom :: Context -> IO ClientRandom
clientRandom ctx :: Context
ctx = ByteString -> ClientRandom
ClientRandom (ByteString -> ClientRandom) -> IO ByteString -> IO ClientRandom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Int -> IO ByteString
getStateRNG Context
ctx 32

hrrRandom :: ServerRandom
hrrRandom :: ServerRandom
hrrRandom = ByteString -> ServerRandom
ServerRandom (ByteString -> ServerRandom) -> ByteString -> ServerRandom
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [
    0xCF, 0x21, 0xAD, 0x74, 0xE5, 0x9A, 0x61, 0x11
  , 0xBE, 0x1D, 0x8C, 0x02, 0x1E, 0x65, 0xB8, 0x91
  , 0xC2, 0xA2, 0x11, 0x16, 0x7A, 0xBB, 0x8C, 0x5E
  , 0x07, 0x9E, 0x09, 0xE2, 0xC8, 0xA8, 0x33, 0x9C
  ]

isHelloRetryRequest :: ServerRandom -> Bool
isHelloRetryRequest :: ServerRandom -> Bool
isHelloRetryRequest = (ServerRandom -> ServerRandom -> Bool
forall a. Eq a => a -> a -> Bool
== ServerRandom
hrrRandom)