{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Handler.WarpTLS.Internal (
    CertSettings (..),
    TLSSettings (..),
    defaultTlsSettings,
    OnInsecure (..),

    -- * Accessors
    getCertSettings,
) where

import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.Default.Class (def)
import qualified Data.IORef as I
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra as TLSExtra
import qualified Network.TLS.SessionManager as SM

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

-- | Determines where to load the certificate, chain
-- certificates, and key from.
data CertSettings
    = CertFromFile !FilePath ![FilePath] !FilePath
    | CertFromMemory !S.ByteString ![S.ByteString] !S.ByteString
    | CertFromRef
        !(I.IORef S.ByteString)
        ![I.IORef S.ByteString]
        !(I.IORef S.ByteString)

instance Show CertSettings where
    show :: CertSettings -> String
show (CertFromFile String
a [String]
b String
c) = String
"CertFromFile " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
c
    show (CertFromMemory ByteString
a [ByteString]
b ByteString
c) = String
"CertFromMemory " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ByteString] -> String
forall a. Show a => a -> String
show [ByteString]
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
c
    show (CertFromRef IORef ByteString
_ [IORef ByteString]
_ IORef ByteString
_) = String
"CertFromRef"

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

-- | An action when a plain HTTP comes to HTTP over TLS/SSL port.
data OnInsecure
    = DenyInsecure L.ByteString
    | AllowInsecure
    deriving (Int -> OnInsecure -> ShowS
[OnInsecure] -> ShowS
OnInsecure -> String
(Int -> OnInsecure -> ShowS)
-> (OnInsecure -> String)
-> ([OnInsecure] -> ShowS)
-> Show OnInsecure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnInsecure -> ShowS
showsPrec :: Int -> OnInsecure -> ShowS
$cshow :: OnInsecure -> String
show :: OnInsecure -> String
$cshowList :: [OnInsecure] -> ShowS
showList :: [OnInsecure] -> ShowS
Show)

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

-- | Settings for WarpTLS.
data TLSSettings = TLSSettings
    { TLSSettings -> CertSettings
certSettings :: CertSettings
    -- ^ Where are the certificate, chain certificates, and key
    -- loaded from?
    --
    -- >>> certSettings defaultTlsSettings
    -- CertFromFile "certificate.pem" [] "key.pem"
    --
    -- @since 3.3.0
    , TLSSettings -> OnInsecure
onInsecure :: OnInsecure
    -- ^ Do we allow insecure connections with this server as well?
    --
    -- >>> onInsecure defaultTlsSettings
    -- DenyInsecure "This server only accepts secure HTTPS connections."
    --
    -- Since 1.4.0
    , TLSSettings -> Logging
tlsLogging :: TLS.Logging
    -- ^ The level of logging to turn on.
    --
    -- Default: 'TLS.defaultLogging'.
    --
    -- Since 1.4.0
    , TLSSettings -> [Version]
tlsAllowedVersions :: [TLS.Version]
    -- ^ The TLS versions this server accepts.
    --
    -- Since 1.4.2
    , TLSSettings -> [Cipher]
tlsCiphers
        :: [TLS.Cipher]
    -- ^ The TLS ciphers this server accepts.
    --
    -- Since 1.4.2
    , TLSSettings -> Bool
tlsWantClientCert :: Bool
    -- ^ Whether or not to demand a certificate from the client.  If this
    -- is set to True, you must handle received certificates in a server hook
    -- or all connections will fail.
    --
    -- >>> tlsWantClientCert defaultTlsSettings
    -- False
    --
    -- Since 3.0.2
    , TLSSettings -> ServerHooks
tlsServerHooks :: TLS.ServerHooks
    -- ^ The server-side hooks called by the tls package, including actions
    -- to take when a client certificate is received.  See the "Network.TLS"
    -- module for details.
    --
    -- Default: def
    --
    -- Since 3.0.2
    , TLSSettings -> Maybe DHParams
tlsServerDHEParams :: Maybe TLS.DHParams
    -- ^ Configuration for ServerDHEParams
    -- more function lives in `crypton` package
    --
    -- Default: Nothing
    --
    -- Since 3.2.2
    , TLSSettings -> Maybe Config
tlsSessionManagerConfig :: Maybe SM.Config
    -- ^ Configuration for in-memory TLS session manager.
    -- If Nothing, 'TLS.noSessionManager' is used.
    -- Otherwise, an in-memory TLS session manager is created
    -- according to 'Config'.
    --
    -- Default: Nothing
    --
    -- Since 3.2.4
    , TLSSettings -> Maybe Credentials
tlsCredentials :: Maybe TLS.Credentials
    -- ^ Specifying 'TLS.Credentials' directly.  If this value is
    --   specified, other fields such as 'certFile' are ignored.
    --
    --   Since 3.2.12
    , TLSSettings -> Maybe SessionManager
tlsSessionManager :: Maybe TLS.SessionManager
    -- ^ Specifying 'TLS.SessionManager' directly. If this value is
    --   specified, 'tlsSessionManagerConfig' is ignored.
    --
    --   Since 3.2.12
    , TLSSettings -> [HashAndSignatureAlgorithm]
tlsSupportedHashSignatures :: [TLS.HashAndSignatureAlgorithm]
    -- ^ Specifying supported hash/signature algorithms, ordered by decreasing
    -- priority. See the "Network.TLS" module for details
    --
    --   Since 3.3.3
    }

-- Since 3.3.1

-- | Some programs need access to cert settings
getCertSettings :: TLSSettings -> CertSettings
getCertSettings :: TLSSettings -> CertSettings
getCertSettings = TLSSettings -> CertSettings
certSettings

-- | The default 'CertSettings'.
defaultCertSettings :: CertSettings
defaultCertSettings :: CertSettings
defaultCertSettings = String -> [String] -> String -> CertSettings
CertFromFile String
"certificate.pem" [] String
"key.pem"

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

-- | Default 'TLSSettings'. Use this to create 'TLSSettings' with the field record name (aka accessors).
defaultTlsSettings :: TLSSettings
defaultTlsSettings :: TLSSettings
defaultTlsSettings =
    TLSSettings
        { certSettings :: CertSettings
certSettings = CertSettings
defaultCertSettings
        , onInsecure :: OnInsecure
onInsecure = ByteString -> OnInsecure
DenyInsecure ByteString
"This server only accepts secure HTTPS connections."
        , tlsLogging :: Logging
tlsLogging = Logging
forall a. Default a => a
def
        , tlsAllowedVersions :: [Version]
tlsAllowedVersions = Supported -> [Version]
TLS.supportedVersions Supported
forall a. Default a => a
def
        , tlsCiphers :: [Cipher]
tlsCiphers = [Cipher]
ciphers
        , tlsWantClientCert :: Bool
tlsWantClientCert = Bool
False
        , tlsServerHooks :: ServerHooks
tlsServerHooks = ServerHooks
forall a. Default a => a
def
        , tlsServerDHEParams :: Maybe DHParams
tlsServerDHEParams = Maybe DHParams
forall a. Maybe a
Nothing
        , tlsSessionManagerConfig :: Maybe Config
tlsSessionManagerConfig = Maybe Config
forall a. Maybe a
Nothing
        , tlsCredentials :: Maybe Credentials
tlsCredentials = Maybe Credentials
forall a. Maybe a
Nothing
        , tlsSessionManager :: Maybe SessionManager
tlsSessionManager = Maybe SessionManager
forall a. Maybe a
Nothing
        , tlsSupportedHashSignatures :: [HashAndSignatureAlgorithm]
tlsSupportedHashSignatures = Supported -> [HashAndSignatureAlgorithm]
TLS.supportedHashSignatures Supported
forall a. Default a => a
def
        }

-- taken from stunnel example in tls-extra
ciphers :: [TLS.Cipher]
ciphers :: [Cipher]
ciphers = [Cipher]
TLSExtra.ciphersuite_strong