thread key material through cli options

main
Brian Hicks 2019-12-31 14:27:35 -06:00
parent a0023a4f5b
commit e313440b8f
2 changed files with 21 additions and 4 deletions

View File

@ -2,12 +2,15 @@
module CliOptions where
import Data.Aeson (decode)
import Data.ByteString (ByteString)
import Data.Semigroup ((<>))
import Data.String (fromString)
import Crypto.JOSE.JWA.JWK (KeyMaterial)
import Options.Applicative
data Command
= Serve Int ByteString
= Serve Int ByteString (Maybe KeyMaterial)
| GenerateOpenAPI
| GenerateJWK Int
@ -30,6 +33,14 @@ serveParser =
<> showDefault
<> value "postgresql://localhost:5432/cfp"
)
<*> option
(maybeReader (decode . fromString))
( help "key material for signing, in JSON format. If not provided, I will generate a random key."
<> long "key"
<> short 'k'
<> showDefault
<> value Nothing
)
generateElmParser :: Parser Command
generateElmParser =

View File

@ -3,7 +3,7 @@ module Main where
import API (API)
import qualified CliOptions
import Crypto.JOSE.JWA.JWK (genKeyMaterial, KeyMaterialGenParam (RSAGenParam))
import Crypto.JOSE.JWK (JWK)
import Crypto.JOSE.JWK (JWK, fromKeyMaterial)
import Data.Aeson (encode)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BSL8
@ -45,10 +45,16 @@ main :: IO ()
main = do
command <- execParser CliOptions.parserInfo
case command of
CliOptions.Serve port connStr -> do
CliOptions.Serve port connStr maybeMaterial -> do
material <- case maybeMaterial of
Just material -> pure material
Nothing -> do
putStrLn "generating a new RSA key for JWT signing. This should only be used in development!"
genKeyMaterial $ RSAGenParam 1024
let key = fromKeyMaterial material
pool <- initConnectionPool connStr
let settings = setPort port $ setBeforeMainLoop (hPutStrLn stderr ("listening on port " ++ show port)) $ defaultSettings
runSettings settings =<< app undefined pool
runSettings settings =<< app key pool
CliOptions.GenerateOpenAPI ->
BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy API)
CliOptions.GenerateJWK size -> do