    {-# LANGUAGE OverloadedStrings #-}
    -- |
    -- Module      : Network.TLS.Handshake.Signature
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Network.TLS.Handshake.Signature
        (
          createCertificateVerify
        , checkCertificateVerify
        , digitallySignDHParams
        , digitallySignECDHParams
        , digitallySignDHParamsVerify
        , digitallySignECDHParamsVerify
        , checkSupportedHashSignature
        , certificateCompatible
        , signatureCompatible
        , signatureCompatible13
        , hashSigToCertType
        , signatureParams
        , decryptError
        ) where

    import Network.TLS.Crypto
    import Network.TLS.Context.Internal
    import Network.TLS.Parameters
    import Network.TLS.Struct
    import Network.TLS.Imports
    import Network.TLS.Packet (generateCertificateVerify_SSL, generateCertificateVerify_SSL_DSS,
                               encodeSignedDHParams, encodeSignedECDHParams)
    import Network.TLS.State
    import Network.TLS.Handshake.State
    import Network.TLS.Handshake.Key
    import Network.TLS.Util
    import Network.TLS.X509

    import Control.Monad.State.Strict

    decryptError :: MonadIO m => String -> m a
    decryptError :: String -> m a
    decryptError msg :: String
    msg = TLSError -> m a
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwCore (TLSError -> m a) -> TLSError -> m a
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    msg, Bool
    True, AlertDescription
    DecryptError)

    -- | Check that the key is compatible with a list of 'CertificateType' values.
    -- Ed25519 and Ed448 have no assigned code point and are checked with extension
    -- "signature_algorithms" only.
    certificateCompatible :: PubKey -> [CertificateType] -> Bool
    certificateCompatible :: PubKey -> [CertificateType] -> Bool
    certificateCompatible (PubKeyRSA _)      cTypes :: [CertificateType]
    cTypes = CertificateType
    CertificateType_RSA_Sign CertificateType -> [CertificateType] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CertificateType]
    cTypes
    certificateCompatible (PubKeyDSA _)      cTypes :: [CertificateType]
    cTypes = CertificateType
    CertificateType_DSS_Sign CertificateType -> [CertificateType] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CertificateType]
    cTypes
    certificateCompatible (PubKeyEC _)       cTypes :: [CertificateType]
    cTypes = CertificateType
    CertificateType_ECDSA_Sign CertificateType -> [CertificateType] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CertificateType]
    cTypes
    certificateCompatible (PubKeyEd25519 _)  _      = Bool
    True
    certificateCompatible (PubKeyEd448 _)    _      = Bool
    True
    certificateCompatible _                  _      = Bool
    False

    signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (HashSHA1,   SignatureRSA)     = PublicKey -> Hash -> Bool
    kxCanUseRSApkcs1 PublicKey
    pk Hash
    SHA1
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (HashSHA256, SignatureRSA)     = PublicKey -> Hash -> Bool
    kxCanUseRSApkcs1 PublicKey
    pk Hash
    SHA256
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (HashSHA384, SignatureRSA)     = PublicKey -> Hash -> Bool
    kxCanUseRSApkcs1 PublicKey
    pk Hash
    SHA384
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (HashSHA512, SignatureRSA)     = PublicKey -> Hash -> Bool
    kxCanUseRSApkcs1 PublicKey
    pk Hash
    SHA512
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (_, SignatureRSApssRSAeSHA256) = PublicKey -> Hash -> Bool
    kxCanUseRSApss PublicKey
    pk Hash
    SHA256
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (_, SignatureRSApssRSAeSHA384) = PublicKey -> Hash -> Bool
    kxCanUseRSApss PublicKey
    pk Hash
    SHA384
    signatureCompatible (PubKeyRSA pk :: PublicKey
    pk)      (_, SignatureRSApssRSAeSHA512) = PublicKey -> Hash -> Bool
    kxCanUseRSApss PublicKey
    pk Hash
    SHA512
    signatureCompatible (PubKeyDSA _)       (_, SignatureDSS)              = Bool
    True
    signatureCompatible (PubKeyEC _)        (_, SignatureECDSA)            = Bool
    True
    signatureCompatible (PubKeyEd25519 _)   (_, SignatureEd25519)          = Bool
    True
    signatureCompatible (PubKeyEd448 _)     (_, SignatureEd448)            = Bool
    True
    signatureCompatible _                   (_, _)                         = Bool
    False

    -- Same as 'signatureCompatible' but for TLS13: for ECDSA this also checks the
    -- relation between hash in the HashAndSignatureAlgorithm and elliptic curve
    signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible13 (PubKeyEC ecPub :: PubKeyEC
    ecPub) (h :: HashAlgorithm
    h, SignatureECDSA) =
        Bool -> (Group -> Bool) -> Maybe Group -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (\g :: Group
    g -> PubKeyEC -> Maybe Group
    findEllipticCurveGroup PubKeyEC
    ecPub Maybe Group -> Maybe Group -> Bool
    forall a. Eq a => a -> a -> Bool
    == Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    g) (HashAlgorithm -> Maybe Group
    hashCurve HashAlgorithm
    h)
      where
        hashCurve :: HashAlgorithm -> Maybe Group
    hashCurve HashSHA256 = Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    P256
        hashCurve HashSHA384 = Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    P384
        hashCurve HashSHA512 = Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    P521
        hashCurve _          = Maybe Group
    forall a. Maybe a
    Nothing
    signatureCompatible13 pub :: PubKey
    pub hs :: HashAndSignatureAlgorithm
    hs = PubKey -> HashAndSignatureAlgorithm -> Bool
    signatureCompatible PubKey
    pub HashAndSignatureAlgorithm
    hs

    -- | Translate a 'HashAndSignatureAlgorithm' to an acceptable 'CertificateType'.
    -- Perhaps this needs to take supported groups into account, so that, for
    -- example, if we don't support any shared ECDSA groups with the server, we
    -- return 'Nothing' rather than 'CertificateType_ECDSA_Sign'.
    --
    -- Therefore, this interface is preliminary.  It gets us moving in the right
    -- direction.  The interplay between all the various TLS extensions and
    -- certificate selection is rather complex.
    --
    -- The goal is to ensure that the client certificate request callback only sees
    -- 'CertificateType' values that are supported by the library and also
    -- compatible with the server signature algorithms extension.
    --
    -- Since we don't yet support ECDSA private keys, the caller will use
    -- 'lastSupportedCertificateType' to filter those out for now, leaving just
    -- @RSA@ as the only supported client certificate algorithm for TLS 1.3.
    --
    -- FIXME: Add RSA_PSS_PSS signatures when supported.
    --
    hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
    --
    hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
    hashSigToCertType (_, SignatureRSA)   = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_RSA_Sign
    --
    hashSigToCertType (_, SignatureDSS)   = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_DSS_Sign
    --
    hashSigToCertType (_, SignatureECDSA) = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_ECDSA_Sign
    --
    hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA256)
        = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_RSA_Sign
    hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA384)
        = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_RSA_Sign
    hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA512)
        = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_RSA_Sign
    hashSigToCertType (HashIntrinsic, SignatureEd25519)
        = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_Ed25519_Sign
    hashSigToCertType (HashIntrinsic, SignatureEd448)
        = CertificateType -> Maybe CertificateType
    forall a. a -> Maybe a
    Just CertificateType
    CertificateType_Ed448_Sign
    --
    hashSigToCertType _ = Maybe CertificateType
    forall a. Maybe a
    Nothing

    checkCertificateVerify :: Context
                           -> Version
                           -> PubKey
                           -> ByteString
                           -> DigitallySigned
                           -> IO Bool
    checkCertificateVerify :: Context
    -> Version -> PubKey -> ByteString -> DigitallySigned -> IO Bool
    checkCertificateVerify ctx :: Context
    ctx usedVersion :: Version
    usedVersion pubKey :: PubKey
    pubKey msgs :: ByteString
    msgs digSig :: DigitallySigned
    digSig@(DigitallySigned hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg _) =
        case (Version
    usedVersion, Maybe HashAndSignatureAlgorithm
    hashSigAlg) of
            (TLS12, Nothing)    -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            (TLS12, Just hs :: HashAndSignatureAlgorithm
    hs) | PubKey
    pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
    `signatureCompatible` HashAndSignatureAlgorithm
    hs -> IO Bool
    doVerify
                             | Bool
    otherwise                       -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            (_,     Nothing)    -> IO Bool
    doVerify
            (_,     Just _)     -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where
        doVerify :: IO Bool
    doVerify =
            Context
    -> Version
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> ByteString
    -> IO CertVerifyData
    prepareCertificateVerifySignatureData Context
    ctx Version
    usedVersion PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    hashSigAlg ByteString
    msgs IO CertVerifyData -> (CertVerifyData -> IO Bool) -> IO Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            Context -> DigitallySigned -> CertVerifyData -> IO Bool
    signatureVerifyWithCertVerifyData Context
    ctx DigitallySigned
    digSig

    createCertificateVerify :: Context
                            -> Version
                            -> PubKey
                            -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                            -> ByteString
                            -> IO DigitallySigned
    createCertificateVerify :: Context
    -> Version
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> ByteString
    -> IO DigitallySigned
    createCertificateVerify ctx :: Context
    ctx usedVersion :: Version
    usedVersion pubKey :: PubKey
    pubKey hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg msgs :: ByteString
    msgs =
        Context
    -> Version
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> ByteString
    -> IO CertVerifyData
    prepareCertificateVerifySignatureData Context
    ctx Version
    usedVersion PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    hashSigAlg ByteString
    msgs IO CertVerifyData
    -> (CertVerifyData -> IO DigitallySigned) -> IO DigitallySigned
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
        Context
    -> Maybe HashAndSignatureAlgorithm
    -> CertVerifyData
    -> IO DigitallySigned
    signatureCreateWithCertVerifyData Context
    ctx Maybe HashAndSignatureAlgorithm
    hashSigAlg

    type CertVerifyData = (SignatureParams, ByteString)

    -- in the case of TLS < 1.2, RSA signing, then the data need to be hashed first, as
    -- the SHA1_MD5 algorithm expect an already digested data
    buildVerifyData :: SignatureParams -> ByteString -> CertVerifyData
    buildVerifyData :: SignatureParams -> ByteString -> CertVerifyData
    buildVerifyData (RSAParams SHA1_MD5 enc :: RSAEncoding
    enc) bs :: ByteString
    bs = (Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA1_MD5 RSAEncoding
    enc, HashCtx -> ByteString
    hashFinal (HashCtx -> ByteString) -> HashCtx -> ByteString
    forall a b. (a -> b) -> a -> b
    $ HashCtx -> ByteString -> HashCtx
    hashUpdate (Hash -> HashCtx
    hashInit Hash
    SHA1_MD5) ByteString
    bs)
    buildVerifyData sigParam :: SignatureParams
    sigParam             bs :: ByteString
    bs = (SignatureParams
    sigParam, ByteString
    bs)

    prepareCertificateVerifySignatureData :: Context
                                          -> Version
                                          -> PubKey
                                          -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                                          -> ByteString
                                          -> IO CertVerifyData
    prepareCertificateVerifySignatureData :: Context
    -> Version
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> ByteString
    -> IO CertVerifyData
    prepareCertificateVerifySignatureData ctx :: Context
    ctx usedVersion :: Version
    usedVersion pubKey :: PubKey
    pubKey hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg msgs :: ByteString
    msgs
        | Version
    usedVersion Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    SSL3 = do
            (hashCtx :: HashCtx
    hashCtx, params :: SignatureParams
    params, generateCV_SSL :: ByteString -> HashCtx -> ByteString
    generateCV_SSL) <-
                case PubKey
    pubKey of
                    PubKeyRSA _ -> (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
    -> IO
         (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Hash -> HashCtx
    hashInit Hash
    SHA1_MD5, Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA1_MD5 RSAEncoding
    RSApkcs1, ByteString -> HashCtx -> ByteString
    generateCertificateVerify_SSL)
                    PubKeyDSA _ -> (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
    -> IO
         (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Hash -> HashCtx
    hashInit Hash
    SHA1, SignatureParams
    DSSParams, ByteString -> HashCtx -> ByteString
    generateCertificateVerify_SSL_DSS)
                    _           -> TLSError
    -> IO
         (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwCore (TLSError
     -> IO
          (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString))
    -> TLSError
    -> IO
         (HashCtx, SignatureParams, ByteString -> HashCtx -> ByteString)
    forall a b. (a -> b) -> a -> b
    $ String -> TLSError
    Error_Misc ("unsupported CertificateVerify signature for SSL3: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> String
    pubkeyType PubKey
    pubKey)
            Just masterSecret :: ByteString
    masterSecret <- Context -> HandshakeM (Maybe ByteString) -> IO (Maybe ByteString)
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM (Maybe ByteString) -> IO (Maybe ByteString))
    -> HandshakeM (Maybe ByteString) -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ (HandshakeState -> Maybe ByteString)
    -> HandshakeM (Maybe ByteString)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets HandshakeState -> Maybe ByteString
    hstMasterSecret
            CertVerifyData -> IO CertVerifyData
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SignatureParams
    params, ByteString -> HashCtx -> ByteString
    generateCV_SSL ByteString
    masterSecret (HashCtx -> ByteString) -> HashCtx -> ByteString
    forall a b. (a -> b) -> a -> b
    $ HashCtx -> ByteString -> HashCtx
    hashUpdate HashCtx
    hashCtx ByteString
    msgs)
        | Version
    usedVersion Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    TLS10 Bool -> Bool -> Bool
    || Version
    usedVersion Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    TLS11 =
                CertVerifyData -> IO CertVerifyData
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CertVerifyData -> IO CertVerifyData)
    -> CertVerifyData -> IO CertVerifyData
    forall a b. (a -> b) -> a -> b
    $ SignatureParams -> ByteString -> CertVerifyData
    buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    forall a. Maybe a
    Nothing) ByteString
    msgs
        | Bool
    otherwise = CertVerifyData -> IO CertVerifyData
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    hashSigAlg, ByteString
    msgs)

    signatureParams :: PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams :: PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams (PubKeyRSA _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg =
        case Maybe HashAndSignatureAlgorithm
    hashSigAlg of
            Just (HashSHA512, SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA512   RSAEncoding
    RSApkcs1
            Just (HashSHA384, SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA384   RSAEncoding
    RSApkcs1
            Just (HashSHA256, SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA256   RSAEncoding
    RSApkcs1
            Just (HashSHA1  , SignatureRSA) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA1     RSAEncoding
    RSApkcs1
            Just (HashIntrinsic , SignatureRSApssRSAeSHA512) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA512 RSAEncoding
    RSApss
            Just (HashIntrinsic , SignatureRSApssRSAeSHA384) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA384 RSAEncoding
    RSApss
            Just (HashIntrinsic , SignatureRSApssRSAeSHA256) -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA256 RSAEncoding
    RSApss
            Nothing                         -> Hash -> RSAEncoding -> SignatureParams
    RSAParams Hash
    SHA1_MD5 RSAEncoding
    RSApkcs1
            Just (hsh :: HashAlgorithm
    hsh       , SignatureRSA) -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("unimplemented RSA signature hash type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HashAlgorithm -> String
    forall a. Show a => a -> String
    show HashAlgorithm
    hsh)
            Just (_         , sigAlg :: SignatureAlgorithm
    sigAlg)       -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("signature algorithm is incompatible with RSA: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SignatureAlgorithm -> String
    forall a. Show a => a -> String
    show SignatureAlgorithm
    sigAlg)
    signatureParams (PubKeyDSA _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg =
        case Maybe HashAndSignatureAlgorithm
    hashSigAlg of
            Nothing                       -> SignatureParams
    DSSParams
            Just (HashSHA1, SignatureDSS) -> SignatureParams
    DSSParams
            Just (_       , SignatureDSS) -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error "invalid DSA hash choice, only SHA1 allowed"
            Just (_       , sigAlg :: SignatureAlgorithm
    sigAlg)       -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("signature algorithm is incompatible with DSS: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SignatureAlgorithm -> String
    forall a. Show a => a -> String
    show SignatureAlgorithm
    sigAlg)
    signatureParams (PubKeyEC _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg =
        case Maybe HashAndSignatureAlgorithm
    hashSigAlg of
            Just (HashSHA512, SignatureECDSA) -> Hash -> SignatureParams
    ECDSAParams Hash
    SHA512
            Just (HashSHA384, SignatureECDSA) -> Hash -> SignatureParams
    ECDSAParams Hash
    SHA384
            Just (HashSHA256, SignatureECDSA) -> Hash -> SignatureParams
    ECDSAParams Hash
    SHA256
            Just (HashSHA1  , SignatureECDSA) -> Hash -> SignatureParams
    ECDSAParams Hash
    SHA1
            Nothing                           -> Hash -> SignatureParams
    ECDSAParams Hash
    SHA1
            Just (hsh :: HashAlgorithm
    hsh       , SignatureECDSA) -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("unimplemented ECDSA signature hash type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HashAlgorithm -> String
    forall a. Show a => a -> String
    show HashAlgorithm
    hsh)
            Just (_         , sigAlg :: SignatureAlgorithm
    sigAlg)         -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("signature algorithm is incompatible with ECDSA: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SignatureAlgorithm -> String
    forall a. Show a => a -> String
    show SignatureAlgorithm
    sigAlg)
    signatureParams (PubKeyEd25519 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg =
        case Maybe HashAndSignatureAlgorithm
    hashSigAlg of
            Nothing                                 -> SignatureParams
    Ed25519Params
            Just (HashIntrinsic , SignatureEd25519) -> SignatureParams
    Ed25519Params
            Just (hsh :: HashAlgorithm
    hsh           , SignatureEd25519) -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("unimplemented Ed25519 signature hash type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HashAlgorithm -> String
    forall a. Show a => a -> String
    show HashAlgorithm
    hsh)
            Just (_             , sigAlg :: SignatureAlgorithm
    sigAlg)           -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("signature algorithm is incompatible with Ed25519: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SignatureAlgorithm -> String
    forall a. Show a => a -> String
    show SignatureAlgorithm
    sigAlg)
    signatureParams (PubKeyEd448 _) hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg =
        case Maybe HashAndSignatureAlgorithm
    hashSigAlg of
            Nothing                               -> SignatureParams
    Ed448Params
            Just (HashIntrinsic , SignatureEd448) -> SignatureParams
    Ed448Params
            Just (hsh :: HashAlgorithm
    hsh           , SignatureEd448) -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("unimplemented Ed448 signature hash type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HashAlgorithm -> String
    forall a. Show a => a -> String
    show HashAlgorithm
    hsh)
            Just (_             , sigAlg :: SignatureAlgorithm
    sigAlg)         -> String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("signature algorithm is incompatible with Ed448: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SignatureAlgorithm -> String
    forall a. Show a => a -> String
    show SignatureAlgorithm
    sigAlg)
    signatureParams pk :: PubKey
    pk _ = String -> SignatureParams
    forall a. HasCallStack => String -> a
    error ("signatureParams: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PubKey -> String
    pubkeyType PubKey
    pk String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " is not supported")

    signatureCreateWithCertVerifyData :: Context
                                      -> Maybe HashAndSignatureAlgorithm
                                      -> CertVerifyData
                                      -> IO DigitallySigned
    signatureCreateWithCertVerifyData :: Context
    -> Maybe HashAndSignatureAlgorithm
    -> CertVerifyData
    -> IO DigitallySigned
    signatureCreateWithCertVerifyData ctx :: Context
    ctx malg :: Maybe HashAndSignatureAlgorithm
    malg (sigParam :: SignatureParams
    sigParam, toSign :: ByteString
    toSign) = do
        Role
    cc <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    isClientContext
        Maybe HashAndSignatureAlgorithm -> ByteString -> DigitallySigned
    DigitallySigned Maybe HashAndSignatureAlgorithm
    malg (ByteString -> DigitallySigned)
    -> IO ByteString -> IO DigitallySigned
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> Role -> SignatureParams -> ByteString -> IO ByteString
    signPrivate Context
    ctx Role
    cc SignatureParams
    sigParam ByteString
    toSign

    signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
    signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
    signatureVerify ctx :: Context
    ctx digSig :: DigitallySigned
    digSig@(DigitallySigned hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg _) pubKey :: PubKey
    pubKey toVerifyData :: ByteString
    toVerifyData = do
        Version
    usedVersion <- Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        let (sigParam :: SignatureParams
    sigParam, toVerify :: ByteString
    toVerify) =
                case (Version
    usedVersion, Maybe HashAndSignatureAlgorithm
    hashSigAlg) of
                    (TLS12, Nothing)    -> String -> CertVerifyData
    forall a. HasCallStack => String -> a
    error "expecting hash and signature algorithm in a TLS12 digitally signed structure"
                    (TLS12, Just hs :: HashAndSignatureAlgorithm
    hs) | PubKey
    pubKey PubKey -> HashAndSignatureAlgorithm -> Bool
    `signatureCompatible` HashAndSignatureAlgorithm
    hs -> (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    hashSigAlg, ByteString
    toVerifyData)
                                     | Bool
    otherwise                       -> String -> CertVerifyData
    forall a. HasCallStack => String -> a
    error "expecting different signature algorithm"
                    (_,     Nothing)    -> SignatureParams -> ByteString -> CertVerifyData
    buildVerifyData (PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    forall a. Maybe a
    Nothing) ByteString
    toVerifyData
                    (_,     Just _)     -> String -> CertVerifyData
    forall a. HasCallStack => String -> a
    error "not expecting hash and signature algorithm in a < TLS12 digitially signed structure"
        Context -> DigitallySigned -> CertVerifyData -> IO Bool
    signatureVerifyWithCertVerifyData Context
    ctx DigitallySigned
    digSig (SignatureParams
    sigParam, ByteString
    toVerify)

    signatureVerifyWithCertVerifyData :: Context
                                      -> DigitallySigned
                                      -> CertVerifyData
                                      -> IO Bool
    signatureVerifyWithCertVerifyData :: Context -> DigitallySigned -> CertVerifyData -> IO Bool
    signatureVerifyWithCertVerifyData ctx :: Context
    ctx (DigitallySigned hs :: Maybe HashAndSignatureAlgorithm
    hs bs :: ByteString
    bs) (sigParam :: SignatureParams
    sigParam, toVerify :: ByteString
    toVerify) = do
        Context -> Maybe HashAndSignatureAlgorithm -> IO ()
    checkSupportedHashSignature Context
    ctx Maybe HashAndSignatureAlgorithm
    hs
        Context -> SignatureParams -> ByteString -> ByteString -> IO Bool
    verifyPublic Context
    ctx SignatureParams
    sigParam ByteString
    toVerify ByteString
    bs

    digitallySignParams :: Context -> ByteString -> PubKey -> Maybe HashAndSignatureAlgorithm -> IO DigitallySigned
    digitallySignParams :: Context
    -> ByteString
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> IO DigitallySigned
    digitallySignParams ctx :: Context
    ctx signatureData :: ByteString
    signatureData pubKey :: PubKey
    pubKey hashSigAlg :: Maybe HashAndSignatureAlgorithm
    hashSigAlg =
        let sigParam :: SignatureParams
    sigParam = PubKey -> Maybe HashAndSignatureAlgorithm -> SignatureParams
    signatureParams PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    hashSigAlg
         in Context
    -> Maybe HashAndSignatureAlgorithm
    -> CertVerifyData
    -> IO DigitallySigned
    signatureCreateWithCertVerifyData Context
    ctx Maybe HashAndSignatureAlgorithm
    hashSigAlg (SignatureParams -> ByteString -> CertVerifyData
    buildVerifyData SignatureParams
    sigParam ByteString
    signatureData)

    digitallySignDHParams :: Context
                          -> ServerDHParams
                          -> PubKey
                          -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                          -> IO DigitallySigned
    digitallySignDHParams :: Context
    -> ServerDHParams
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> IO DigitallySigned
    digitallySignDHParams ctx :: Context
    ctx serverParams :: ServerDHParams
    serverParams pubKey :: PubKey
    pubKey mhash :: Maybe HashAndSignatureAlgorithm
    mhash = do
        ByteString
    dhParamsData <- Context
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
    withClientAndServerRandom Context
    ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
    encodeSignedDHParams ServerDHParams
    serverParams
        Context
    -> ByteString
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> IO DigitallySigned
    digitallySignParams Context
    ctx ByteString
    dhParamsData PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    mhash

    digitallySignECDHParams :: Context
                            -> ServerECDHParams
                            -> PubKey
                            -> Maybe HashAndSignatureAlgorithm -- TLS12 only
                            -> IO DigitallySigned
    digitallySignECDHParams :: Context
    -> ServerECDHParams
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> IO DigitallySigned
    digitallySignECDHParams ctx :: Context
    ctx serverParams :: ServerECDHParams
    serverParams pubKey :: PubKey
    pubKey mhash :: Maybe HashAndSignatureAlgorithm
    mhash = do
        ByteString
    ecdhParamsData <- Context
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
    withClientAndServerRandom Context
    ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
    encodeSignedECDHParams ServerECDHParams
    serverParams
        Context
    -> ByteString
    -> PubKey
    -> Maybe HashAndSignatureAlgorithm
    -> IO DigitallySigned
    digitallySignParams Context
    ctx ByteString
    ecdhParamsData PubKey
    pubKey Maybe HashAndSignatureAlgorithm
    mhash

    digitallySignDHParamsVerify :: Context
                                -> ServerDHParams
                                -> PubKey
                                -> DigitallySigned
                                -> IO Bool
    digitallySignDHParamsVerify :: Context -> ServerDHParams -> PubKey -> DigitallySigned -> IO Bool
    digitallySignDHParamsVerify ctx :: Context
    ctx dhparams :: ServerDHParams
    dhparams pubKey :: PubKey
    pubKey signature :: DigitallySigned
    signature = do
        ByteString
    expectedData <- Context
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
    withClientAndServerRandom Context
    ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
    encodeSignedDHParams ServerDHParams
    dhparams
        Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
    signatureVerify Context
    ctx DigitallySigned
    signature PubKey
    pubKey ByteString
    expectedData

    digitallySignECDHParamsVerify :: Context
                                  -> ServerECDHParams
                                  -> PubKey
                                  -> DigitallySigned
                                  -> IO Bool
    digitallySignECDHParamsVerify :: Context -> ServerECDHParams -> PubKey -> DigitallySigned -> IO Bool
    digitallySignECDHParamsVerify ctx :: Context
    ctx dhparams :: ServerECDHParams
    dhparams pubKey :: PubKey
    pubKey signature :: DigitallySigned
    signature = do
        ByteString
    expectedData <- Context
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall b. Context -> (ClientRandom -> ServerRandom -> b) -> IO b
    withClientAndServerRandom Context
    ctx ((ClientRandom -> ServerRandom -> ByteString) -> IO ByteString)
    -> (ClientRandom -> ServerRandom -> ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
    encodeSignedECDHParams ServerECDHParams
    dhparams
        Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
    signatureVerify Context
    ctx DigitallySigned
    signature PubKey
    pubKey ByteString
    expectedData

    withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b
    withClientAndServerRandom :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b
    withClientAndServerRandom ctx :: Context
    ctx f :: ClientRandom -> ServerRandom -> b
    f = do
        (cran :: ClientRandom
    cran, sran :: ServerRandom
    sran) <- Context
    -> HandshakeM (ClientRandom, ServerRandom)
    -> IO (ClientRandom, ServerRandom)
    forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
    usingHState Context
    ctx (HandshakeM (ClientRandom, ServerRandom)
     -> IO (ClientRandom, ServerRandom))
    -> HandshakeM (ClientRandom, ServerRandom)
    -> IO (ClientRandom, ServerRandom)
    forall a b. (a -> b) -> a -> b
    $ (,) (ClientRandom -> ServerRandom -> (ClientRandom, ServerRandom))
    -> HandshakeM ClientRandom
    -> HandshakeM (ServerRandom -> (ClientRandom, ServerRandom))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (HandshakeState -> ClientRandom) -> HandshakeM ClientRandom
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets HandshakeState -> ClientRandom
    hstClientRandom
                                              HandshakeM (ServerRandom -> (ClientRandom, ServerRandom))
    -> HandshakeM ServerRandom
    -> HandshakeM (ClientRandom, ServerRandom)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (String -> Maybe ServerRandom -> ServerRandom
    forall a. String -> Maybe a -> a
    fromJust "withClientAndServer : server random" (Maybe ServerRandom -> ServerRandom)
    -> HandshakeM (Maybe ServerRandom) -> HandshakeM ServerRandom
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (HandshakeState -> Maybe ServerRandom)
    -> HandshakeM (Maybe ServerRandom)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets HandshakeState -> Maybe ServerRandom
    hstServerRandom)
        b -> IO b
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> IO b) -> b -> IO b
    forall a b. (a -> b) -> a -> b
    $ ClientRandom -> ServerRandom -> b
    f ClientRandom
    cran ServerRandom
    sran

    -- verify that the hash and signature selected by the peer is supported in
    -- the local configuration
    checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO ()
    checkSupportedHashSignature :: Context -> Maybe HashAndSignatureAlgorithm -> IO ()
    checkSupportedHashSignature _   Nothing   = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkSupportedHashSignature ctx :: Context
    ctx (Just hs :: HashAndSignatureAlgorithm
    hs) =
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (HashAndSignatureAlgorithm
    hs HashAndSignatureAlgorithm -> [HashAndSignatureAlgorithm] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Supported -> [HashAndSignatureAlgorithm]
    supportedHashSignatures (Context -> Supported
    ctxSupported Context
    ctx)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            let msg :: String
    msg = "unsupported hash and signature algorithm: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HashAndSignatureAlgorithm -> String
    forall a. Show a => a -> String
    show HashAndSignatureAlgorithm
    hs
             in TLSError -> IO ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwCore (TLSError -> IO ()) -> TLSError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, Bool, AlertDescription) -> TLSError
    Error_Protocol (String
    msg, Bool
    True, AlertDescription
    IllegalParameter)