revert spurious spacing change

This commit is contained in:
Keagan McClelland
2020-11-30 22:14:52 -07:00
parent 462cace449
commit 24003a8397

View File

@@ -1,16 +1,16 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Lib.Ssl module Lib.Ssl
( DeriveCertificate(..) ( DeriveCertificate(..)
, root_CA_CERT_NAME , root_CA_CERT_NAME
, writeRootCaCert , writeRootCaCert
, writeIntermediateCert , writeIntermediateCert
, domain_CSR_CONF , domain_CSR_CONF
, writeLeafCert , writeLeafCert
, root_CA_OPENSSL_CONF , root_CA_OPENSSL_CONF
, intermediate_CA_OPENSSL_CONF , intermediate_CA_OPENSSL_CONF
, segment , segment
) )
where where
import Startlude import Startlude
@@ -269,52 +269,52 @@ OU = Embassy
writeRootCaCert :: MonadIO m => FilePath -> FilePath -> FilePath -> m (ExitCode, String, String) writeRootCaCert :: MonadIO m => FilePath -> FilePath -> FilePath -> m (ExitCode, String, String)
writeRootCaCert confPath keyFilePath certFileDestinationPath = liftIO $ readProcessWithExitCode writeRootCaCert confPath keyFilePath certFileDestinationPath = liftIO $ readProcessWithExitCode
"openssl" "openssl"
[ "req" [ "req"
, -- use x509 , -- use x509
"-new" "-new"
, -- new request , -- new request
"-x509" "-x509"
, -- self signed x509 , -- self signed x509
"-nodes" "-nodes"
, -- no passphrase , -- no passphrase
"-days" "-days"
, -- expires in... , -- expires in...
"3650" "3650"
, -- valid for 10 years. Max is 20 years , -- valid for 10 years. Max is 20 years
"-key" "-key"
, -- source private key , -- source private key
toS keyFilePath toS keyFilePath
, "-out" , "-out"
-- target cert path -- target cert path
, toS certFileDestinationPath , toS certFileDestinationPath
, "-config" , "-config"
-- configured by... -- configured by...
, toS confPath , toS confPath
] ]
"" ""
data DeriveCertificate = DeriveCertificate data DeriveCertificate = DeriveCertificate
{ applicantConfPath :: FilePath { applicantConfPath :: FilePath
, applicantKeyPath :: FilePath , applicantKeyPath :: FilePath
, applicantCertPath :: FilePath , applicantCertPath :: FilePath
, signingConfPath :: FilePath , signingConfPath :: FilePath
, signingKeyPath :: FilePath , signingKeyPath :: FilePath
, signingCertPath :: FilePath , signingCertPath :: FilePath
, duration :: Integer , duration :: Integer
} }
writeIntermediateCert :: MonadIO m => DeriveCertificate -> m (ExitCode, String, String) writeIntermediateCert :: MonadIO m => DeriveCertificate -> m (ExitCode, String, String)
writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do
-- openssl genrsa -out dump/int.key 4096 -- openssl genrsa -out dump/int.key 4096
segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|] segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|]
-- openssl req -new -config dump/int-csr.conf -key dump/int.key -nodes -out dump/int.csr -- openssl req -new -config dump/int-csr.conf -key dump/int.key -nodes -out dump/int.csr
segment $ openssl [i|req -new segment $ openssl [i|req -new
-config #{applicantConfPath} -config #{applicantConfPath}
-key #{applicantKeyPath} -key #{applicantKeyPath}
-nodes -nodes
-out #{applicantCertPath <> ".csr"}|] -out #{applicantCertPath <> ".csr"}|]
-- openssl x509 -CA dump/ca.crt -CAkey dump/ca.key -CAcreateserial -days 3650 -req -in dump/int.csr -out dump/int.crt -- openssl x509 -CA dump/ca.crt -CAkey dump/ca.key -CAcreateserial -days 3650 -req -in dump/int.csr -out dump/int.crt
segment $ openssl [i|ca -batch segment $ openssl [i|ca -batch
-config #{signingConfPath} -config #{signingConfPath}
-rand_serial -rand_serial
-keyfile #{signingKeyPath} -keyfile #{signingKeyPath}
@@ -324,17 +324,17 @@ writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do
-notext -notext
-in #{applicantCertPath <> ".csr"} -in #{applicantCertPath <> ".csr"}
-out #{applicantCertPath}|] -out #{applicantCertPath}|]
liftIO $ readFile signingCertPath >>= appendFile applicantCertPath liftIO $ readFile signingCertPath >>= appendFile applicantCertPath
writeLeafCert :: MonadIO m => DeriveCertificate -> Text -> Text -> m (ExitCode, String, String) writeLeafCert :: MonadIO m => DeriveCertificate -> Text -> Text -> m (ExitCode, String, String)
writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $ do writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $ do
segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|] segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|]
segment $ openssl [i|req -config #{applicantConfPath} segment $ openssl [i|req -config #{applicantConfPath}
-key #{applicantKeyPath} -key #{applicantKeyPath}
-new -new
-addext subjectAltName=DNS:#{hostname},DNS:*.#{hostname},DNS:#{torAddress},DNS:*.#{torAddress} -addext subjectAltName=DNS:#{hostname},DNS:*.#{hostname},DNS:#{torAddress},DNS:*.#{torAddress}
-out #{applicantCertPath <> ".csr"}|] -out #{applicantCertPath <> ".csr"}|]
segment $ openssl [i|ca -batch segment $ openssl [i|ca -batch
-config #{signingConfPath} -config #{signingConfPath}
-rand_serial -rand_serial
-keyfile #{signingKeyPath} -keyfile #{signingKeyPath}
@@ -345,7 +345,7 @@ writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $
-in #{applicantCertPath <> ".csr"} -in #{applicantCertPath <> ".csr"}
-out #{applicantCertPath} -out #{applicantCertPath}
|] |]
liftIO $ readFile signingCertPath >>= appendFile applicantCertPath liftIO $ readFile signingCertPath >>= appendFile applicantCertPath
openssl :: MonadIO m => Text -> m (ExitCode, String, String) openssl :: MonadIO m => Text -> m (ExitCode, String, String)
openssl = liftIO . ($ "") . readProcessWithExitCode "openssl" . fmap toS . words openssl = liftIO . ($ "") . readProcessWithExitCode "openssl" . fmap toS . words
@@ -361,6 +361,6 @@ regroup (a, (b, c)) = (a, b, c)
segment :: MonadIO m => m (ExitCode, String, String) -> ExceptT ExitCode (StateT (String, String) m) () segment :: MonadIO m => m (ExitCode, String, String) -> ExceptT ExitCode (StateT (String, String) m) ()
segment action = (lift . lift) action >>= \case segment action = (lift . lift) action >>= \case
(ExitSuccess, o, e) -> modify (bimap (<> o) (<> e)) (ExitSuccess, o, e) -> modify (bimap (<> o) (<> e))
(ec , o, e) -> modify (bimap (<> o) (<> e)) *> throwE ec (ec , o, e) -> modify (bimap (<> o) (<> e)) *> throwE ec
{-# INLINE segment #-} {-# INLINE segment #-}