TLSExtensions.fs

(*
 * Copyright 2015 INRIA and Microsoft Corporation
 * 
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 * 
 *     http://www.apache.org/licenses/LICENSE-2.0
 * 
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

#light "off"

module TLSExtensions

open Bytes
open Error
open TLSError
open TLSConstants
open TLSInfo

type clientExtension =
    | CE_renegotiation_info of cVerifyData
    | CE_server_name of list<serverName>
    | CE_extended_ms
    | CE_extended_padding
#if tls13
    | CE_negotiated_dh_group of list<dhGroup>
#endif
    | CE_ec_point_format of list<ECGroup.point_format>
    | CE_ec_curves of list<ECGroup.ec_all_curve>

let sameClientExt a b =
    match a,b with
    | CE_renegotiation_info (_), CE_renegotiation_info (_) -> true
    | CE_server_name _, CE_server_name _ -> true
    | CE_extended_ms, CE_extended_ms -> true
    | CE_extended_padding, CE_extended_padding -> true
#if tls13
    | CE_negotiated_dh_group _, CE_negotiated_dh_group _ -> true
#endif
    | CE_ec_curves _, CE_ec_curves _ -> true
    | CE_ec_point_format _, CE_ec_point_format _ -> true
    | _,_ -> false

type serverExtension =
    | SE_renegotiation_info of cVerifyData * sVerifyData
    | SE_server_name
    | SE_extended_ms
    | SE_extended_padding
#if tls13
    | SE_negotiated_dh_group of dhGroup
#endif
    | SE_ec_point_format of list<ECGroup.point_format>

let sameServerExt a b =
    match a,b with
    | SE_renegotiation_info (_,_), SE_renegotiation_info (_,_) -> true
    | SE_server_name, SE_server_name -> true
    | SE_extended_ms, SE_extended_ms -> true
    | SE_extended_padding, SE_extended_padding -> true
#if tls13
    | SE_negotiated_dh_group _, SE_negotiated_dh_group _ -> true
#endif
    | SE_ec_point_format _, SE_ec_point_format _ -> true
    | _,_ -> false

let sameServerClientExt a b =
    match a,b with
    | SE_renegotiation_info (_,_), CE_renegotiation_info (_) -> true
    | SE_server_name, CE_server_name _ -> true
    | SE_extended_ms, CE_extended_ms -> true
    | SE_extended_padding, CE_extended_padding -> true
#if tls13
    | SE_negotiated_dh_group _, CE_negotiated_dh_group _ -> true
#endif
    | SE_ec_point_format _, CE_ec_point_format _ -> true
    | _,_ -> false

let clientExtensionHeaderBytes ext =
    match ext with
    | CE_renegotiation_info(_) -> abyte2 (0xFFuy, 0x01uy)
    | CE_server_name (_)       -> abyte2 (0x00uy, 0x00uy)
    | CE_extended_ms           -> abyte2 (0x00uy, 0x17uy)
    | CE_extended_padding      -> abyte2 (0xBBuy, 0x8Fuy)
#if tls13
    | CE_negotiated_dh_group _ -> abyte2 (0xAAuy, 0xAAuy)
#endif
    | CE_ec_point_format _     -> abyte2 (0x00uy, 0x0Buy)
    | CE_ec_curves _           -> abyte2 (0x00uy, 0x0Auy)

type 'a CanFail =
| ExFail of alertDescription * string
| ExOK of 'a list

let compile_sni_list l =
    let rec aux = function
    | [] -> empty_bytes
    | SNI_DNS(x) :: r -> (abyte 0uy) @| bytes_of_int 2 (length x) @| x @| aux r
    | SNI_UNKNOWN(t, x) :: r -> (bytes_of_int 1 t) @| bytes_of_int 2 (length x) @| x @| aux r
    in aux l

let parse_sni_list b : Result<serverName list> =
    let rec aux b =
        if equalBytes b empty_bytes then ExOK([])
        else
            let (ty,v) = split b 1 in
            (match vlsplit 2 v with
            | Error(x,y) -> ExFail(x,y)
            | Correct(cur, next) ->
                (match aux next with
                | ExFail(x,y) -> ExFail(x,y)
                | ExOK(l) ->
                    let cur =
                        (match cbyte ty with
                        | 0uy -> SNI_DNS(cur)
                        | v -> SNI_UNKNOWN(int_of_bytes ty, cur))
                    in let snidup x =
                        (match (x,cur) with
                        | SNI_DNS _, SNI_DNS _ -> true
                        | SNI_UNKNOWN(a,_), SNI_UNKNOWN(b, _) when a=b -> true
                        | _ -> false)
                    in if List.exists snidup l then ExFail(AD_unrecognized_name, perror __SOURCE_FILE__ __LINE__ "Duplicate SNI type")
                    else ExOK(cur :: l)))
    in (match aux b with
    | ExFail(x,y) -> Error(x,y)
    | ExOK([]) -> Error(AD_unrecognized_name, perror __SOURCE_FILE__ __LINE__ "Empty SNI extension")
    | ExOK(l) -> correct (l))

let compile_curve_list l =
    let rec aux =
        function
        | [] -> empty_bytes
        | ECGroup.EC_CORE c :: r ->
            let cid = ECGroup.curve_id (ECGroup.getParams c) in
            cid @| aux r
        | ECGroup.EC_EXPLICIT_PRIME :: r -> abyte2 (255uy, 01uy) @| aux r
        | ECGroup.EC_EXPLICIT_BINARY :: r -> abyte2 (255uy, 02uy) @| aux r
        | ECGroup.EC_UNKNOWN(x) :: r -> bytes_of_int 2 x @| aux r
    in vlbytes 2 (aux l)

let parse_curve_list b : Result<list<ECGroup.ec_all_curve>> =
    let rec aux b =
        if equalBytes b empty_bytes then ExOK([])
        elif (length b) % 2 = 1 then ExFail(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "Bad encoding of curve list")
        else let (u,v) = split b 2 in
            (match aux v with
            | ExFail(x,y) -> ExFail(x,y)
            | ExOK(l) ->
                let cur =
                    (match cbyte2 u with
                    | (0uy, 23uy) -> ECGroup.EC_CORE ECC_P256
                    | (0uy, 24uy) -> ECGroup.EC_CORE ECC_P384
                    | (0uy, 25uy) -> ECGroup.EC_CORE ECC_P521
                    | (255uy, 1uy) -> ECGroup.EC_EXPLICIT_PRIME
                    | (255uy, 2uy) -> ECGroup.EC_EXPLICIT_BINARY
                    | _ -> ECGroup.EC_UNKNOWN(int_of_bytes u))
                in
                    if List.exists ((=)cur) l then ExFail(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "Duplicate curve")
                    else ExOK(cur :: l))
    in (match aux b with
    | ExFail(x,y) -> Error(x,y)
    | ExOK([]) -> Error(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "Empty supported curve list")
    | ExOK(l) -> correct (l))

let parse_ecpf_list b : Result<list<ECGroup.point_format>> =
    let rec aux b =
        if equalBytes b empty_bytes then ExOK([])
        else let (u,v) = split b 1 in
            (match aux v with
            | ExFail(x,y) -> ExFail(x,y)
            | ExOK(l) ->
                let cur = match cbyte u with
                | 0uy -> ECGroup.ECP_UNCOMPRESSED
                | _ -> ECGroup.ECP_UNKNOWN(int_of_bytes u)
                in ExOK(cur :: l))
    in (match aux b with
    | ExFail(x,y) -> Error(x,y)
    | ExOK(l) when not (List.exists ((=)ECGroup.ECP_UNCOMPRESSED) l) ->
        Error(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "Uncompressed point format not supported")
    | ExOK(l) -> correct (l))

let compile_ecpf_list l =
    let rec aux =
        function
        | [] -> empty_bytes
        | ECGroup.ECP_UNCOMPRESSED :: r -> (abyte 0uy) @| aux r
        | ECGroup.ECP_UNKNOWN(t) :: r -> (bytes_of_int 1 t) @| aux r
    in vlbytes 1 (aux l)

let clientExtensionPayloadBytes ext =
    match ext with
    | CE_renegotiation_info(cvd) -> vlbytes 1 cvd
    | CE_server_name(l) -> compile_sni_list l
    | CE_extended_ms -> empty_bytes
    | CE_extended_padding -> empty_bytes
#if tls13
    | CE_negotiated_dh_group gl ->
        let gb = dhGroupsBytes gl in
        vlbytes 1 gb
#endif
    | CE_ec_curves(l) -> compile_curve_list l
    | CE_ec_point_format(l) -> compile_ecpf_list l

let clientExtensionBytes ext =
    let head = clientExtensionHeaderBytes ext in
    let payload = clientExtensionPayloadBytes ext in
    let payload = vlbytes 2 payload in
    head @| payload

let clientExtensionsBytes extL =
    let extBL = List.map (fun e -> clientExtensionBytes e) extL in
    let extB = List.fold (fun s l -> s @| l) empty_bytes extBL in
    if equalBytes extB empty_bytes then
        empty_bytes
    else
        vlbytes 2 extB

let parseClientExtension head payload =
    match cbyte2 head with
    | (0uy, 0uy) -> // Server name indication
        (match vlparse 2 payload with
        | Error (x,y) -> Some(Error(x,y))
        | Correct(sni) ->
            (match parse_sni_list sni with
            | Error (x,y) -> Some(Error(x,y))
            | Correct(l) -> Some(correct (CE_server_name(l)))))
    | (0xFFuy, 0x01uy) -> // renegotiation info
        (match vlparse 1 payload with
        | Error (x,y) -> Some(Error(x,y))
        | Correct(cvd) ->
            let res = CE_renegotiation_info (cvd) in
            let res = correct res in
            Some(res))
    | (0x00uy, 0x0Auy) -> // Supported EC curves
        (match vlparse 2 payload with
        | Error (x,y) -> Some(Error(x,y))
        | Correct(ecl) ->
            (match parse_curve_list ecl with
            | Error (x,y) -> Some(Error(x,y))
            | Correct(l) -> Some(correct (CE_ec_curves(l)))))
    | (0x00uy, 0x0Buy) -> // Supported EC point formats
        (match vlparse 1 payload with
        | Error (x,y) -> Some(Error(x,y))
        | Correct(ecpf) ->
            (match parse_ecpf_list ecpf with
            | Error (x,y) -> Some(Error(x,y))
            | Correct(l) -> Some(correct (CE_ec_point_format(l)))))
#if TLSExt_sessionHash
    | (0x00uy, 0x17uy) -> // extended_ms
        if equalBytes payload empty_bytes then
            Some(correct (CE_extended_ms))
        else
            Some(Error(AD_illegal_parameter, perror __SOURCE_FILE__ __LINE__ "Invalid data for extended master secret extension"))
#endif
#if TLSExt_extendedPadding
    | (0xBBuy, 0x8Fuy) -> // extended_padding
        if equalBytes payload empty_bytes then
            Some(correct (CE_extended_padding))
        else
            Some(Error(AD_illegal_parameter, perror __SOURCE_FILE__ __LINE__ "Invalid data for extended padding extension"))
#endif
#if tls13
    | (0xAAuy, 0xAAuy) -> // negotiated_dh_group
        (match vlparse 1 payload with
        | Error (x,y) -> Some(Error(x,y))
        | Correct(sdhg) -> Some(correct(CE_negotiated_dh_group (parseDHGroups sdhg)))
        )
#endif
    | (_,_) -> None

let addOnceClient ext extList =
    if List.exists (sameClientExt ext) extList then
        Error(AD_handshake_failure, perror __SOURCE_FILE__ __LINE__ "Same extension received more than once")
    else
        let res = ext::extList in
        correct(res)

let rec parseClientExtensionList ext extList =
    match length ext with
    | 0 -> correct (extList)
    | x when x < 4 ->
        (* This is a parsing error, or a malformed extension *)
        Error (AD_decode_error, perror __SOURCE_FILE__ __LINE__ "")
    | _ ->
        let (extTypeBytes,rem) = Bytes.split ext 2 in
        match vlsplit 2 rem with
            | Error(x,y) -> Error (x,y) (* Parsing error *)
            | Correct (res) ->
                let (payload,rem) = res in
                match parseClientExtension extTypeBytes payload with
                | None ->
                    (* Unknown extension, skip it *)
                    parseClientExtensionList rem extList
                | Some(res) ->
                    match res with
                    | Error(x,y) -> Error(x,y)
                    | Correct(ce) ->
                        match addOnceClient ce extList with
                        | Error(x,y) -> Error(x,y)
                        | Correct(extList) -> parseClientExtensionList rem extList

let rec parseClientSCSVs ch_ciphers extL =
    if contains_TLS_EMPTY_RENEGOTIATION_INFO_SCSV ch_ciphers then
        addOnceClient (CE_renegotiation_info(empty_bytes)) extL
    else
        correct(extL)

let parseClientExtensions data ch_ciphers =
    match length data with
    | 0 -> parseClientSCSVs ch_ciphers []
    | 1 -> Error(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "")
    | _ ->
        match vlparse 2 data with
        | Error(x,y)    -> Error(x,y)
        | Correct(exts) ->
            match parseClientExtensionList exts [] with
            | Error(x,y) -> Error(x,y)
            | Correct(extL) -> parseClientSCSVs ch_ciphers extL

let prepareClientExtensions (cfg:config) (conn:ConnectionInfo) renegoCVD =
    (* Always send supported extensions. The configuration options will influence how strict the tests will be *)
    let res = [CE_renegotiation_info(renegoCVD)] in
#if TLSExt_sessionHash
    let res = CE_extended_ms :: res in
#endif
#if TLSExt_extendedPadding
    let res = CE_extended_padding :: res in
#endif
#if tls13
    let res =
        if cfg.negotiableDHGroups.IsEmpty then
            res
        else
            CE_negotiated_dh_group cfg.negotiableDHGroups :: res
    in
#endif
    let res =
        let curves = List.map (fun x -> ECGroup.EC_CORE x) cfg.ecdhGroups in
        if curves <> [] && List.exists (fun x -> isECDHECipherSuite x) cfg.ciphersuites then
            CE_ec_point_format([ECGroup.ECP_UNCOMPRESSED]) :: CE_ec_curves(curves) :: res
        else res
    in
    res

let serverToNegotiatedExtension cExtL (resuming:bool) cs res sExt : Result<negotiatedExtensions>=
    match res with
    | Error(x,y) -> Error(x,y)
    | Correct(l) ->
        if List.exists (sameServerClientExt sExt) cExtL then
            match sExt with
            | SE_renegotiation_info (cvd,svd) -> correct ({l with ne_renegotiation_info=Some(cvd,svd)})
            | SE_server_name ->
                if List.exists (fun x->match x with CE_server_name _ -> true | _ -> false) cExtL then correct(l)
                else Error(AD_handshake_failure,perror __SOURCE_FILE__ __LINE__ "Server sent an SNI acknowledgement without an SNI provided")
            | SE_ec_point_format(spf) ->
                if resuming then
                    correct l
                else
                    correct {l with ne_supported_point_formats = Some spf}
            | SE_extended_ms ->
                if resuming then
                    correct(l)
                else
                    correct({l with ne_extended_ms = true})
            | SE_extended_padding ->
                if resuming then
                    Error(AD_handshake_failure,perror __SOURCE_FILE__ __LINE__ "Server provided extended padding in a resuming handshake")
                else
                    if isOnlyMACCipherSuite cs then
                        Error(AD_handshake_failure,perror __SOURCE_FILE__ __LINE__ "Server provided extended padding for a MAC only ciphersuite")
                    else
                        correct({l with ne_extended_padding = true})
#if tls13
            | SE_negotiated_dh_group sdhg ->
                let picker x =
                    match x with
                    | CE_negotiated_dh_group (cdhgs) -> Some(cdhgs)
                    | _ -> None
                in
                let cdhgs = List.pick picker cExtL in
                if List.exists (fun x -> x = sdhg) cdhgs then
                    correct({l with ne_negotiated_dh_group=Some(sdhg)})
                else
                    Error(AD_handshake_failure, perror __SOURCE_FILE__ __LINE__ "Server provided DH group that was not offered by client")
#endif
        else
            Error(AD_handshake_failure,perror __SOURCE_FILE__ __LINE__ "Server provided an extension not given by the client")

let negotiateClientExtensions (cExtL:list<clientExtension>) (sExtL:list<serverExtension>) (resuming:bool) cs =

    let nes = ne_default in
    match Collections.List.fold (serverToNegotiatedExtension cExtL resuming cs) (correct nes) sExtL with
    | Error(x,y) -> Error(x,y)
    | Correct(l) ->
        // Client-side specific extension negotiation
        // Nothing for now
        correct(l)

let serverExtensionHeaderBytes ext =
    match ext with
    | SE_renegotiation_info (_,_) -> abyte2 (0xFFuy, 0x01uy)
    | SE_server_name (_)          -> abyte2 (0x00uy, 0x00uy)
    | SE_extended_ms              -> abyte2 (0x00uy, 0x17uy)
    | SE_extended_padding         -> abyte2 (0xBBuy, 0x8Fuy)
#if tls13
    | SE_negotiated_dh_group (_)  -> abyte2 (0xAAuy, 0xAAuy)
#endif
    | SE_ec_point_format _        -> abyte2 (0x00uy, 0x0Buy)

let serverExtensionPayloadBytes ext =
    match ext with
    | SE_renegotiation_info (cvd,svd) ->
        let p = cvd @| svd in
        vlbytes 1 p
    | SE_ec_point_format(l) -> compile_ecpf_list l
    | SE_server_name -> empty_bytes
    | SE_extended_ms -> empty_bytes
    | SE_extended_padding -> empty_bytes
#if tls13
    | SE_negotiated_dh_group dhg -> dhGroupBytes dhg
#endif

let serverExtensionBytes ext =
    let head = serverExtensionHeaderBytes ext in
    let payload = serverExtensionPayloadBytes ext in
    let payload = vlbytes 2 payload in
    head @| payload

let serverExtensionsBytes extL =
    let extBL = List.map (fun e -> serverExtensionBytes e) extL in
    let extB = List.fold (fun s l -> s @| l) empty_bytes extBL in
    if equalBytes extB empty_bytes then
        empty_bytes
    else
        vlbytes 2 extB

let parseServerExtension head payload =
    match cbyte2 head with
    | (0xFFuy, 0x01uy) -> // renegotiation info
        (match vlparse 1 payload with
        | Error (x,y) -> Error(x,y)
        | Correct(vd) ->
            let vdL = length vd in
            let (cvd,svd) = split vd (vdL/2) in
            let res = SE_renegotiation_info (cvd,svd) in
            correct(res))
    | (0x00uy, 0x17uy) -> // extended master secret
        if equalBytes payload empty_bytes then
            correct(SE_extended_ms)
        else
            Error(AD_illegal_parameter, perror __SOURCE_FILE__ __LINE__ "Invalid data for extended master secret extension")
    | (0xBBuy, 0x8Fuy) -> // extended padding
        if equalBytes payload empty_bytes then
            correct(SE_extended_padding)
        else
            Error(AD_illegal_parameter, perror __SOURCE_FILE__ __LINE__ "Invalid data for extended padding extension")
#if tls13
    | (0xAAuy, 0xAAuy) -> // negotiated DH group
        (match parseDHGroup payload with
        | Error(x,y) -> Error(AD_illegal_parameter,y) // we never sent a group we don't support
        | Correct(dhg) -> correct(SE_negotiated_dh_group dhg))
#endif
    | (0uy, 0x0Buy) -> // Supported EC point format
        (match vlparse 1 payload with
        | Error (x,y) -> Error(x,y)
        | Correct(ecpf) ->
            (match parse_ecpf_list ecpf with
            | Error (x,y) -> Error(x,y)
            | Correct(l) -> correct (SE_ec_point_format(l))))
    | (_,_) ->
        // A server can never send an extension the client doesn't support
        Error(AD_unsupported_extension, perror __SOURCE_FILE__ __LINE__ "Server provided an unsupported extension")

let addOnceServer ext extList =
    if List.exists (sameServerExt ext) extList then
        Error(AD_handshake_failure, perror __SOURCE_FILE__ __LINE__ "Same extension received more than once")
    else
        let res = ext::extList in
        correct(res)

let rec parseServerExtensionList ext extList =
    match length ext with
    | 0 -> correct (extList)
    | x when x < 4 ->
        (* This is a parsing error, or a malformed extension *)
        Error (AD_decode_error, perror __SOURCE_FILE__ __LINE__ "")
    | _ ->
        let (extTypeBytes,rem) = Bytes.split ext 2 in
        match vlsplit 2 rem with
            | Error(x,y) -> Error (x,y) (* Parsing error *)
            | Correct (res) ->
                let (payload,rem) = res in
                match parseServerExtension extTypeBytes payload with
                | Error(x,y) -> Error(x,y)
                | Correct(ce) ->
                    match addOnceServer ce extList with
                    | Error(x,y) -> Error(x,y)
                    | Correct(extList) -> parseServerExtensionList rem extList

let parseServerExtensions data =
    match length data with
    | 0 -> let el = [] in correct (el)
    | 1 -> Error(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "")
    | _ ->
        match vlparse 2 data with
        | Error(x,y)    -> Error(x,y)
        | Correct(exts) -> parseServerExtensionList exts []

let preferredDHGroup pref allowed =
    List.tryPick (
        fun x ->
            if List.exists (fun y -> x = y) allowed then
                Some(x)
            else
                None
        ) pref

let ClientToServerExtension (cfg:config) cs ((renegoCVD:cVerifyData),(renegoSVD:sVerifyData)) (resuming:bool) cExt : option<serverExtension>=
    match cExt with
    | CE_renegotiation_info (_) -> Some (SE_renegotiation_info (renegoCVD,renegoSVD))
    | CE_server_name l ->
        (match List.tryFind (fun x->match x with SNI_DNS _ -> true | _ -> false) l with
        | Some _ -> Some(SE_server_name)
        | _ -> None)
    | CE_ec_point_format(l) ->
        if resuming then None
        else Some(SE_ec_point_format [ECGroup.ECP_UNCOMPRESSED])
    | CE_ec_curves(l) -> None
    | CE_extended_ms -> Some(SE_extended_ms)
    | CE_extended_padding ->
        if resuming then
            None
        else
            if isOnlyMACCipherSuite cs then
                None
            else
                Some(SE_extended_padding)
#if tls13
    | CE_negotiated_dh_group dhgl ->
        if isDHECipherSuite cs then
            match preferredDHGroup dhgl cfg.negotiableDHGroups with
            | None -> None
            | Some(dhg) -> Some(SE_negotiated_dh_group dhg)
        else
            // don't negotiate any group for non DHE ciphersuites
            None
#endif

let clientToNegotiatedExtension (cfg:config) cs ((cvd:cVerifyData),(svd:sVerifyData)) (resuming:bool)  neg cExt =
    match cExt with
    | CE_renegotiation_info (_) -> {neg with ne_renegotiation_info=Some(cvd,svd)}
    | CE_ec_curves l ->
        if resuming then neg
        else
            let rec okcurves = function
            | ECGroup.EC_CORE(x) :: r ->
                let rl = okcurves r in
                if List.exists ((=)x) cfg.ecdhGroups then x::rl else rl
            | x :: r -> okcurves r
            | [] -> [] in
            {neg with ne_supported_curves = Some (okcurves l)}
    | CE_ec_point_format l ->
        if resuming then neg
        else
            let nl = List.filter (fun x -> x = ECGroup.ECP_UNCOMPRESSED) l in
            {neg with ne_supported_point_formats = Some nl}
    | CE_server_name l ->
        {neg with ne_server_names = Some l}
    | CE_extended_ms ->
        if resuming then
            neg
        else
            {neg with ne_extended_ms = true}
    | CE_extended_padding ->
        if resuming then
            neg
        else
            if isOnlyMACCipherSuite cs then
                neg
            else
                {neg with ne_extended_padding = true}
#if tls13
    | CE_negotiated_dh_group dhgl ->
        if isDHECipherSuite cs then
            match preferredDHGroup dhgl cfg.negotiableDHGroups with
            | None -> neg
            | Some(dhg) -> {neg with ne_negotiated_dh_group=Some(dhg)}
        else
            neg
#endif

let negotiateServerExtensions cExtL cfg cs (cvd,svd) resuming  : serverExtension list  * negotiatedExtensions =
    let server = List.choose (ClientToServerExtension cfg cs (cvd,svd) resuming) cExtL in

    let negi = ne_default in
    let nego = Collections.List.fold (clientToNegotiatedExtension cfg cs (cvd,svd) resuming) negi cExtL in
    (server,nego)

let isClientRenegotiationInfo e =
    match e with
    | CE_renegotiation_info(cvd) -> Some(cvd)
    | _ -> None

let checkClientRenegotiationInfoExtension config (cExtL: list<clientExtension>) cVerifyData =
    match List.tryPick isClientRenegotiationInfo cExtL with
    | None -> not (config.safe_renegotiation)
    | Some(payload) -> equalBytes payload cVerifyData

let isServerRenegotiationInfo e =
    match e with
    | SE_renegotiation_info (cvd,svd) -> Some((cvd,svd))
    | _ -> None

let checkServerRenegotiationInfoExtension config (sExtL: list<serverExtension>) cVerifyData sVerifyData =
    match List.tryPick isServerRenegotiationInfo sExtL with
    | None -> not (config.safe_renegotiation)
    | Some(x) ->
        let (cvd,svd) = x in
        equalBytes (cvd @| svd) (cVerifyData @| sVerifyData)

let hasExtendedMS extL = extL.ne_extended_ms = true

#if tls13
let getNegotiatedDHGroup extL = extL.ne_negotiated_dh_group

let getOfferedDHGroups extL =
    let getGroup ext =
        match ext with
        | CE_negotiated_dh_group (gl) -> Some(gl)
        | _ -> None
    in
    List.tryPick getGroup extL
#endif

let hasExtendedPadding id = id.ext.ne_extended_padding = true

(* sigHashAlg parsing functions *)
let sigHashAlgBytes alg =
    // pre: we're in TLS 1.2
    let (sign,hash) = alg in
    let signB = sigAlgBytes sign in
    let hashB = hashAlgBytes hash in
    hashB @| signB

let parseSigHashAlg b =
    let (hashB,signB) = Bytes.split b 1 in
    match parseSigAlg signB with
    | Error(x,y) -> Error(x,y)
    | Correct(sign) ->
        match parseHashAlg hashB with
        | Error(x,y) -> Error(x,y)
        | Correct(hash) -> correct(sign,hash)

let rec sigHashAlgListBytes algL =
    match algL with
    | [] -> empty_bytes
    | h::t ->
        let oneItem = sigHashAlgBytes h in
        oneItem @| sigHashAlgListBytes t

let rec parseSigHashAlgList b : (Result<list<Sig.alg>>)=
    if length b = 0 then correct([])
    elif length b = 1 then Error(AD_decode_error, perror __SOURCE_FILE__ __LINE__ "")
    else
        let (thisB,remB) = Bytes.split b 2 in
        match parseSigHashAlgList remB with
        | Error(x,y) -> Error(x,y)
        | Correct(rem) ->
            match parseSigHashAlg thisB with
            | Error(x,y) -> // skip this one
                correct(rem)
            | Correct(this) ->
                correct(this :: rem)

let default_sigHashAlg_fromSig pv sigAlg=
    match sigAlg with
    | SA_RSA ->
        (match pv with
#if tls13
        | TLS_1p3
#endif
        | TLS_1p2                     -> [(SA_RSA, SHA)]
        | TLS_1p0 | TLS_1p1 | SSL_3p0 -> [(SA_RSA,MD5SHA1)])
        //| SSL_3p0 -> [(SA_RSA,NULL)]
    | SA_DSA ->
        [(SA_DSA,SHA)]
        //match pv with
        //| TLS_1p0| TLS_1p1 | TLS_1p2 -> [(SA_DSA, SHA)]
        //| SSL_3p0 -> [(SA_DSA,NULL)]
    | _ -> unexpected "[default_sigHashAlg_fromSig] invoked on an invalid signature algorithm"

let default_sigHashAlg pv cs =
    default_sigHashAlg_fromSig pv (sigAlg_of_ciphersuite cs)

let sigHashAlg_contains (algList:list<Sig.alg>) (alg:Sig.alg) =
    List.exists (fun a -> a = alg) algList

let sigHashAlg_bySigList (algList:list<Sig.alg>) (sigAlgList:list<sigAlg>):list<Sig.alg> =
    List.choose (fun alg -> let (sigA,_) = alg in if (List.exists (fun a -> a = sigA) sigAlgList) then Some(alg) else None) algList

let cert_type_to_SigHashAlg ct pv =
    match ct with
    | TLSConstants.DSA_fixed_dh | TLSConstants.DSA_sign -> default_sigHashAlg_fromSig pv SA_DSA
    | TLSConstants.RSA_fixed_dh | TLSConstants.RSA_sign -> default_sigHashAlg_fromSig pv SA_RSA

let rec cert_type_list_to_SigHashAlg ctl pv =

    match ctl with
    | [] -> []
    | h::t -> (cert_type_to_SigHashAlg h pv) @ (cert_type_list_to_SigHashAlg t pv)

let cert_type_to_SigAlg ct =
    match ct with
    | TLSConstants.DSA_fixed_dh | TLSConstants.DSA_sign -> SA_DSA
    | TLSConstants.RSA_fixed_dh | TLSConstants.RSA_sign -> SA_RSA

let rec cert_type_list_to_SigAlg ctl =

    match ctl with
    | [] -> []
    | h::t -> (cert_type_to_SigAlg h) :: (cert_type_list_to_SigAlg t)