Skip to content
Snippets Groups Projects
Unverified Commit 94fcbc6c authored by Jean-Paul Calderone's avatar Jean-Paul Calderone Committed by GitHub
Browse files

Merge pull request #32 from vu3rdd/31.replace-keys-with-paths

Pass paths to secrets in commandline arguments instead of secrets
parents c5651f58 e331edad
No related branches found
No related tags found
No related merge requests found
...@@ -47,9 +47,6 @@ import PaymentServer.Issuer ...@@ -47,9 +47,6 @@ import PaymentServer.Issuer
import PaymentServer.Server import PaymentServer.Server
( paymentServerApp ( paymentServerApp
) )
import PaymentServer.Processors.Stripe
( StripeSecretKey
)
import Options.Applicative import Options.Applicative
( Parser ( Parser
...@@ -76,6 +73,8 @@ import System.Exit ...@@ -76,6 +73,8 @@ import System.Exit
( exitFailure ( exitFailure
) )
import Data.Semigroup ((<>)) import Data.Semigroup ((<>))
import qualified Data.Text.IO as TIO
import qualified Data.ByteString as B
data Issuer = data Issuer =
Trivial Trivial
...@@ -89,11 +88,11 @@ data Database = ...@@ -89,11 +88,11 @@ data Database =
data ServerConfig = ServerConfig data ServerConfig = ServerConfig
{ issuer :: Issuer { issuer :: Issuer
, signingKey :: Maybe Text , signingKeyPath :: Maybe FilePath
, database :: Database , database :: Database
, databasePath :: Maybe Text , databasePath :: Maybe Text
, endpoint :: Endpoint , endpoint :: Endpoint
, stripeKey :: StripeSecretKey , stripeKeyPath :: FilePath
} }
deriving (Show, Eq) deriving (Show, Eq)
...@@ -150,8 +149,8 @@ sample = ServerConfig ...@@ -150,8 +149,8 @@ sample = ServerConfig
<> showDefault <> showDefault
<> value Trivial ) <> value Trivial )
<*> optional (option str <*> optional (option str
( long "signing-key" ( long "signing-key-path"
<> help "The base64 encoded signing key (ristretto only)" <> help "Path to base64 encoded signing key (ristretto only)"
<> showDefault ) ) <> showDefault ) )
<*> option auto <*> option auto
( long "database" ( long "database"
...@@ -164,8 +163,8 @@ sample = ServerConfig ...@@ -164,8 +163,8 @@ sample = ServerConfig
<> showDefault ) ) <> showDefault ) )
<*> (http <|> https) <*> (http <|> https)
<*> option str <*> option str
( long "stripe-key" ( long "stripe-key-path"
<> help "Stripe Secret key" ) <> help "Path to Stripe Secret key" )
opts :: ParserInfo ServerConfig opts :: ParserInfo ServerConfig
opts = info (sample <**> helper) opts = info (sample <**> helper)
...@@ -205,18 +204,21 @@ logEndpoint endpoint = ...@@ -205,18 +204,21 @@ logEndpoint endpoint =
getApp :: ServerConfig -> IO Application getApp :: ServerConfig -> IO Application
getApp config = getApp config =
let let
getIssuer ServerConfig{ issuer, signingKey } = getIssuer ServerConfig{ issuer, signingKeyPath } =
case (issuer, signingKey) of case (issuer, signingKeyPath) of
(Trivial, Nothing) -> Right trivialIssue (Trivial, Nothing) -> return $ Right trivialIssue
(Ristretto, Just key) -> Right $ ristrettoIssue key (Ristretto, Just keyPath) -> do
_ -> Left "invalid options" key <- TIO.readFile keyPath
return $ Right $ ristrettoIssue key
_ -> return $ Left "invalid options"
getDatabase ServerConfig{ database, databasePath } = getDatabase ServerConfig{ database, databasePath } =
case (database, databasePath) of case (database, databasePath) of
(Memory, Nothing) -> Right memory (Memory, Nothing) -> Right memory
(SQLite3, Just path) -> Right (getDBConnection path) (SQLite3, Just path) -> Right (getDBConnection path)
_ -> Left "invalid options" _ -> Left "invalid options"
in do in do
case getIssuer config of issuer <- getIssuer config
case issuer of
Left err -> do Left err -> do
print err print err
exitFailure exitFailure
...@@ -227,7 +229,7 @@ getApp config = ...@@ -227,7 +229,7 @@ getApp config =
exitFailure exitFailure
Right getDB -> do Right getDB -> do
db <- getDB db <- getDB
let key = stripeKey config key <- B.readFile (stripeKeyPath config)
let app = paymentServerApp key issuer db let app = paymentServerApp key issuer db
logger <- mkRequestLogger (def { outputFormat = Detailed True}) logger <- mkRequestLogger (def { outputFormat = Detailed True})
return $ logger app return $ logger app
...@@ -174,7 +174,7 @@ charge d key (Charges token voucher amount currency) = do ...@@ -174,7 +174,7 @@ charge d key (Charges token voucher amount currency) = do
Left StripeError {} -> throwError err400 { errBody = "Stripe charge didn't succeed" } Left StripeError {} -> throwError err400 { errBody = "Stripe charge didn't succeed" }
where where
getCurrency :: Text -> Handler Currency getCurrency :: Text -> Handler Currency
getCurrency maybeCurrency = do getCurrency maybeCurrency =
case readMaybe (unpack currency) of case readMaybe (unpack currency) of
Just currency' -> return currency' Just currency' -> return currency'
Nothing -> throwError err400 { errBody = "Invalid currency specified" } Nothing -> throwError err400 { errBody = "Invalid currency specified" }
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
-- | This module exposes a Servant-based Network.Wai server for payment -- | This module exposes a Servant-based Network.Wai server for payment
-- interactions. -- interactions.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment