never executed always true always false

    1 module PureClaw.Gateway.Server
    2   ( -- * Server
    3     runGateway
    4     -- * Configuration
    5   , GatewayConfig (..)
    6   , GatewayBind (..)
    7   , defaultGatewayConfig
    8     -- * Warp settings
    9   , mkWarpSettings
   10   ) where
   11 
   12 import Data.Text qualified as T
   13 import Network.Wai.Handler.Warp qualified as Warp
   14 
   15 import PureClaw.Gateway.Routes
   16 import PureClaw.Handles.Log
   17 import PureClaw.Security.Pairing
   18 
   19 -- | How the gateway binds to the network.
   20 data GatewayBind
   21   = LocalhostOnly
   22   | PublicBind
   23   deriving stock (Show, Eq)
   24 
   25 -- | Gateway configuration.
   26 data GatewayConfig = GatewayConfig
   27   { _gc_port    :: Int
   28   , _gc_bind    :: GatewayBind
   29   , _gc_timeout :: Int
   30   , _gc_maxConn :: Int
   31   }
   32   deriving stock (Show, Eq)
   33 
   34 -- | Secure defaults: localhost-only, port 3000, 30s timeout, 100 connections.
   35 defaultGatewayConfig :: GatewayConfig
   36 defaultGatewayConfig = GatewayConfig
   37   { _gc_port    = 3000
   38   , _gc_bind    = LocalhostOnly
   39   , _gc_timeout = 30
   40   , _gc_maxConn = 100
   41   }
   42 
   43 -- | Build Warp settings from our gateway config.
   44 mkWarpSettings :: GatewayConfig -> Warp.Settings
   45 mkWarpSettings gc =
   46   Warp.setPort (_gc_port gc)
   47   $ Warp.setTimeout (_gc_timeout gc)
   48   $ Warp.setHost (bindHost (_gc_bind gc))
   49     Warp.defaultSettings
   50 
   51 bindHost :: GatewayBind -> Warp.HostPreference
   52 bindHost LocalhostOnly = "127.0.0.1"
   53 bindHost PublicBind     = "*"
   54 
   55 -- | Start the gateway HTTP server.
   56 runGateway :: GatewayConfig -> PairingState -> LogHandle -> IO ()
   57 runGateway gc ps lh = do
   58   case _gc_bind gc of
   59     PublicBind -> _lh_logWarn lh "Gateway bound to 0.0.0.0 — ensure tunnel is in use"
   60     LocalhostOnly -> pure ()
   61   _lh_logInfo lh $ "Gateway starting on port " <> T.pack (show (_gc_port gc))
   62   let settings = mkWarpSettings gc
   63       app = mkApp ps lh
   64   Warp.runSettings settings app