Skip to content
Snippets Groups Projects
Commit 5afdba98 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone
Browse files

Switch to running on TLS

parent 028d2615
No related branches found
No related tags found
1 merge request!27Switch to running on TLS
......@@ -31,6 +31,7 @@ library
, wai-extra
, data-default
, warp
, warp-tls
, stripe-core
, text
, containers
......
......@@ -9,6 +9,9 @@ module PaymentServer.Main
import Text.Printf
( printf
)
import Data.Maybe
( maybeToList
)
import Data.Text
( Text
)
......@@ -16,7 +19,16 @@ import Data.Default
( def
)
import Network.Wai.Handler.Warp
( run
( defaultSettings
, setPort
)
import Network.Wai.Handler.WarpTLS
( TLSSettings
, runTLS
, tlsSettingsChain
)
import Network.Wai
( Application
)
import Network.Wai.Middleware.RequestLogger
( OutputFormat(Detailed)
......@@ -38,6 +50,7 @@ import PaymentServer.Server
import Options.Applicative
( Parser
, ParserInfo
, strOption
, option
, auto
, str
......@@ -70,10 +83,14 @@ data Database =
deriving (Show, Eq, Ord, Read)
data ServerConfig = ServerConfig
{ issuer :: Issuer
, signingKey :: Maybe Text
, database :: Database
, databasePath :: Maybe Text
{ issuer :: Issuer
, signingKey :: Maybe Text
, database :: Database
, databasePath :: Maybe Text
, httpPortNumber :: Int
, certificatePath :: String
, chainPath :: Maybe String
, keyPath :: String
}
deriving (Show, Eq)
......@@ -97,6 +114,21 @@ sample = ServerConfig
( long "database-path"
<> help "Path to on-disk database (sqlite3 only)"
<> showDefault ) )
<*> option auto
( long "https-port"
<> help "Port number on which to accept HTTPS connections."
<> showDefault
<> value 443 )
<*> strOption
( long "https-certificate-path"
<> help "Filesystem path to the TLS certificate to use for HTTPS." )
<*> optional ( strOption
( long "https-certificate-chain-path"
<> help "Filesystem path to the TLS certificate chain to use for HTTPS." ) )
<*> strOption
( long "https-key-path"
<> help "Filesystem path to the TLS private key to use for HTTPS." )
opts :: ParserInfo ServerConfig
opts = info (sample <**> helper)
......@@ -106,7 +138,20 @@ opts = info (sample <**> helper)
)
main :: IO ()
main =
main = do
config <- execParser opts
let port = httpPortNumber config
app <- getApp config
tlsSettings <- getTlsSettings config
putStrLn (printf "Accepting HTTPS connections on %d" port :: String)
runTLS tlsSettings (setPort port defaultSettings) app
getTlsSettings :: ServerConfig -> IO TLSSettings
getTlsSettings ServerConfig{ certificatePath, chainPath, keyPath } =
return $ tlsSettingsChain certificatePath (maybeToList chainPath) keyPath
getApp :: ServerConfig -> IO Application
getApp config =
let
getIssuer ServerConfig{ issuer, signingKey } =
case (issuer, signingKey) of
......@@ -119,20 +164,17 @@ main =
(SQLite3, Just path) -> Right (getDBConnection path)
_ -> Left "invalid options"
in do
config <- execParser opts
case getIssuer config of
Left err -> do
print err
exitFailure
Right issuer ->
case getDatabase config of
Left err ->do
Left err -> do
print err
exitFailure
Right getDB -> do
db <- getDB
let port = 8081
let app = paymentServerApp issuer db
logger <- mkRequestLogger (def { outputFormat = Detailed True})
putStrLn (printf "Listening on %d" port :: String)
run port $ logger app
return $ logger app
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment