warp-tls-simple (empty) → 0.1.0.0

raw patch · 3 files changed

+342/−0 lines, 3 filesdep +basedep +directorydep +filepath

Dependencies added: base, directory, filepath, optparse-applicative, process, relude, text, wai, warp, warp-tls, which

Files

• LICENSE +21/−0
• src/Network/Wai/Handler/WarpTLS/Simple.hs +250/−0
• warp-tls-simple.cabal +71/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Sridhar Ratnakumar++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,250 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.Wai.Handler.WarpTLS.Simple (+  -- * Type+  TLSConfig (..),++  -- * Function+  tlsConfigResolve,+  startWarpServer,++  -- * CLI parser+  tlsConfigParser,+) where++import Network.Wai (Application)+import Network.Wai.Handler.Warp qualified as Warp+import Network.Wai.Handler.WarpTLS qualified as WarpTLS+import Network.Wai.Handler.WarpTLS.Internal qualified as WarpTLS+import Options.Applicative+import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.FilePath ((</>))+import System.Process (callProcess)+import System.Which (staticWhich)+import Text.Show (Show (..))++{- | Path to the `openssl` executable++This should be available in the PATH, thanks to Nix and `which` library.+-}+opensslBin :: FilePath+opensslBin = $(staticWhich "openssl")++-- | TLS configuration with HTTPS enabled by default+data TLSConfig+  = -- | No TLS - run HTTP only (explicit)+    TLSDisabled+  | -- | TLS with auto-generated certificates (default)+    TLSAuto+  | -- | TLS with user-provided certificate and key files+    TLSExplicit WarpTLS.TLSSettings++instance Show TLSConfig where+  show = \case+    TLSDisabled -> "TLSDisabled"+    TLSAuto -> "TLSAuto"+    TLSExplicit tlsSettings -> "TLSExplicit (user-provided certificates): " <> Text.Show.show (WarpTLS.getCertSettings tlsSettings)++-- | Parser for TLS configuration with HTTPS enabled by default+tlsConfigParser :: Parser TLSConfig+tlsConfigParser =+  noHttpsMode <|> tlsExplicitMode <|> defaultMode+  where+    noHttpsMode =+      flag'+        TLSDisabled+        ( long "no-https"+            <> help "Disable HTTPS and run HTTP server only"+        )++    tlsExplicitMode =+      fmap TLSExplicit . WarpTLS.tlsSettings+        <$> strOption+          ( long "tls-cert"+              <> metavar "TLS_CERT"+              <> help "Path to TLS certificate file (requires --tls-key)"+          )+        <*> strOption+          ( long "tls-key"+              <> metavar "TLS_KEY"+              <> help "Path to TLS private key file (requires --tls-cert)"+          )++    -- Default to auto-generation (HTTPS enabled by default)+    defaultMode = pure TLSAuto++tlsConfigResolve :: FilePath -> TLSConfig -> IO (Maybe WarpTLS.TLSSettings)+tlsConfigResolve stateDir = \case+  TLSDisabled -> pure Nothing+  TLSAuto -> Just <$> ensureTLSSettings (stateDir </> "tls") "localhost"+  TLSExplicit tlsSettings -> pure (Just tlsSettings)++{- | Ensure TLS certificates exist for auto-generation mode+Returns TLSSettings configured with the certificate and key file paths+-}+ensureTLSSettings :: FilePath -> Text -> IO WarpTLS.TLSSettings+ensureTLSSettings certDir hostArg = do+  let (certPath, keyPath) = certPaths certDir++  certExists <- doesFileExist certPath+  keyExists <- doesFileExist keyPath++  if certExists && keyExists+    then do+      putTextLn $ "Using existing TLS certificates from " <> toText certDir <> "/"+    else do+      putTextLn "Generating TLS certificates for HTTPS support..."+      createDirectoryIfMissing True certDir+      generateCertificates certDir hostArg++  pure $ WarpTLS.tlsSettings certPath keyPath++-- | Helper function to construct certificate and key file paths from a directory+certPaths :: FilePath -> (FilePath, FilePath)+certPaths certDir =+  let certPath = certDir <> "/server.crt"+      keyPath = certDir <> "/server.key"+   in (certPath, keyPath)++-- | High-level certificate request configuration+data CertificateRequest = CertificateRequest+  { certSubject :: CertSubject+  , certValidityDays :: Int+  , certSANHosts :: [Text] -- Additional SAN hostnames+  , certSANIPs :: [Text] -- Additional SAN IP addresses+  }+  deriving stock (Show)++-- | Certificate subject information for self-signed certificates+data CertSubject = CertSubject+  { certCountry :: Text+  , certState :: Text+  , certLocality :: Text+  , certOrganization :: Text+  , certOrganizationalUnit :: Text+  , certCommonName :: Text+  }+  deriving stock (Show)++-- | Default certificate subject for development+defaultCertSubject :: CertSubject+defaultCertSubject =+  CertSubject+    { certCountry = "US"+    , certState = "CA"+    , certLocality = "San Francisco"+    , certOrganization = "Vira Development"+    , certOrganizationalUnit = "IT Department"+    , certCommonName = "localhost"+    }++-- | Default certificate request for local development+defaultCertRequest :: Text -> CertificateRequest+defaultCertRequest hostArg =+  CertificateRequest+    { certSubject = defaultCertSubject+    , certValidityDays = 3650 -- 10 years+    , certSANHosts = ["localhost", hostArg]+    , certSANIPs =+        [ "127.0.0.1"+        , "::1"+        , "0.0.0.0"+        , "192.168.1.1"+        , "192.168.1.100"+        , "192.168.0.1"+        , "192.168.0.100"+        , "10.0.0.1"+        , "10.0.0.100"+        , "172.16.0.1"+        , "172.16.0.100"+        ]+    }++-- | Generate a self-signed certificate using a certificate request+generateCertificateWithRequest :: FilePath -> CertificateRequest -> IO ()+generateCertificateWithRequest certDir request = do+  let (certPath, keyPath) = certPaths certDir++  -- Generate private key+  callProcess opensslBin ["genrsa", "-out", keyPath, "2048"]++  -- Create OpenSSL config+  let opensslConfig = generateOpenSSLConfig request+      configPath = certDir <> "/openssl.conf"++  writeFileText configPath opensslConfig++  -- Generate self-signed certificate+  callProcess+    opensslBin+    [ "req"+    , "-new"+    , "-x509"+    , "-key"+    , keyPath+    , "-out"+    , certPath+    , "-days"+    , Prelude.show request.certValidityDays+    , "-config"+    , configPath+    ]++  putTextLn "Generated TLS certificates:"+  putTextLn $ "  Certificate: " <> toText certPath+  putTextLn $ "  Private key: " <> toText keyPath+  let hostList = intercalate ", " (map toString request.certSANHosts)+  putTextLn $ "  Valid for: " <> toText hostList <> " and common local network IPs"++-- | Generate OpenSSL configuration from a certificate request+generateOpenSSLConfig :: CertificateRequest -> Text+generateOpenSSLConfig request =+  let subject = request.certSubject+      dnsEntries =+        zipWith+          (\i host -> "DNS." <> Prelude.show i <> " = " <> host)+          [(1 :: Int) ..]+          request.certSANHosts+      ipEntries =+        zipWith+          (\i ip -> "IP." <> Prelude.show i <> " = " <> ip)+          [(length request.certSANHosts + 1 :: Int) ..]+          request.certSANIPs+      allSANEntries = dnsEntries <> ipEntries+      altNamesSection = unlines $ "[alt_names]" : allSANEntries+   in unlines+        [ "[req]"+        , "distinguished_name = req_distinguished_name"+        , "req_extensions = v3_req"+        , "prompt = no"+        , ""+        , "[req_distinguished_name]"+        , "C = " <> subject.certCountry+        , "ST = " <> subject.certState+        , "L = " <> subject.certLocality+        , "O = " <> subject.certOrganization+        , "OU = " <> subject.certOrganizationalUnit+        , "CN = " <> subject.certCommonName+        , ""+        , "[v3_req]"+        , "basicConstraints = CA:FALSE"+        , "keyUsage = critical, digitalSignature, keyEncipherment, keyAgreement"+        , "extendedKeyUsage = critical, serverAuth, clientAuth"+        , "subjectAltName = @alt_names"+        , ""+        , altNamesSection+        ]++-- | Generate self-signed certificates with proper SAN for local network access (simplified API)+generateCertificates :: FilePath -> Text -> IO ()+generateCertificates certDir hostArg =+  generateCertificateWithRequest certDir (defaultCertRequest hostArg)++-- | Start a Warp server with optional TLS+startWarpServer :: Warp.Settings -> FilePath -> TLSConfig -> Application -> IO ()+startWarpServer settings stateDir tlsConfig app =+  tlsConfigResolve stateDir tlsConfig >>= \case+    Nothing -> Warp.runSettings settings app+    Just tlsSettings -> WarpTLS.runTLS tlsSettings settings app

@@ -0,0 +1,71 @@+cabal-version: 2.0++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name:           warp-tls-simple+version: 0.1.0.0+synopsis:       Simple TLS configuration for Warp+description:    Simplified TLS setup and certificate generation for Warp servers+category:       Web+author:         Sridhar Ratnakumar+maintainer:     srid@srid.ca+copyright:      2025 Juspay+license:        MIT+license-file:   LICENSE+build-type:     Simple++library+  exposed-modules:+      Network.Wai.Handler.WarpTLS.Simple+  other-modules:+      Paths_warp_tls_simple+  autogen-modules:+      Paths_warp_tls_simple+  hs-source-dirs:+      src+  default-extensions:+      DataKinds+      DeriveDataTypeable+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      ExplicitForAll+      FlexibleContexts+      FlexibleInstances+      GeneralizedNewtypeDeriving+      ImportQualifiedPost+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      NoStarIsType+      NumericUnderscores+      OverloadedStrings+      ScopedTypeVariables+      StrictData+      TypeApplications+      TypeFamilies+      TypeOperators+      TypeSynonymInstances+      ViewPatterns+  ghc-options: -Wall -optP-Wno-nonportable-include-path -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wunused-foralls -fprint-explicit-foralls -fprint-explicit-kinds+  build-depends:+      base ==4.*+    , directory+    , filepath+    , optparse-applicative+    , process+    , relude >=1.0+    , text+    , wai+    , warp+    , warp-tls+    , which+  mixins:+      base hiding (Prelude)+    , relude (Relude as Prelude, Relude.Container.One)+    , relude +  default-language: GHC2021