From 70137d8dba49353f525b4d3e93a919df80e81765 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Sat, 9 Apr 2016 19:42:31 -0400 Subject: implement remote file http provisioner --- acme-certify.cabal | 3 ++- acme-certify.hs | 42 +++++++++++++++++++++++++++--------------- 2 files changed, 29 insertions(+), 16 deletions(-) diff --git a/acme-certify.cabal b/acme-certify.cabal index 5c89233..364e269 100644 --- a/acme-certify.cabal +++ b/acme-certify.cabal @@ -29,7 +29,8 @@ executable acme cryptonite, aeson, bytestring, base64-bytestring, SHA, text, HsOpenSSL, optparse-applicative, time, email-validate, network-uri, directory, yaml-config, - yaml, unordered-containers, lens, lens-aeson, process, posix-escape + yaml, unordered-containers, lens, lens-aeson, process, + posix-escape, transformers, resourcet default-language: Haskell2010 -- test-suite acme-certify-test diff --git a/acme-certify.hs b/acme-certify.hs index 1e9655c..5f4613f 100644 --- a/acme-certify.hs +++ b/acme-certify.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------------------- -- | Get a certificate from Let's Encrypt using the ACME protocol. @@ -15,31 +16,35 @@ module Main where import BasePrelude -import Control.Lens hiding ((&)) +import Control.Lens hiding ((&)) +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource import Data.Aeson.Lens -import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text, unpack) -import Data.Yaml (Object) -import qualified Data.Yaml.Config as Config -import Data.Yaml.Config.Internal (Config (..)) -import Network.ACME (HttpProvisioner, Keys (..), - canProvision, certify, - ensureWritableDir, provisionViaFile, - readKeys, ()) -import Network.ACME.Issuer (letsEncryptX1CrossSigned) +import qualified Data.HashMap.Strict as HashMap +import Data.Text (Text, unpack) +import Data.Text.Encoding (decodeUtf8) +import Data.Yaml (Object) +import qualified Data.Yaml.Config as Config +import Data.Yaml.Config.Internal (Config (..)) +import Network.ACME (HttpProvisioner, Keys (..), + canProvision, certify, + ensureWritableDir, + provisionViaFile, readKeys, + ()) +import Network.ACME.Issuer (letsEncryptX1CrossSigned) import Network.URI import OpenSSL import OpenSSL.DH import OpenSSL.PEM import OpenSSL.RSA -import OpenSSL.X509 (X509) -import Options.Applicative hiding (header) -import qualified Options.Applicative as Opt +import OpenSSL.X509 (X509) +import Options.Applicative hiding (header) +import qualified Options.Applicative as Opt import System.Directory import System.IO import System.Posix.Escape import System.Process -import Text.Domain.Validate hiding (validate) +import Text.Domain.Validate hiding (validate) import Text.Email.Validate stagingDirectoryUrl, liveDirectoryUrl, defaultTerms :: URI @@ -217,6 +222,13 @@ remoteTemp host fileName content = do where ssh cmd = runInteractiveProcess "ssh" (host : words "-- sh -c" ++ [escape cmd]) Nothing Nothing +provisionViaRemoteFile :: String -> FilePath -> HttpProvisioner +provisionViaRemoteFile = provision + where + provision host dir (bsToS -> tok) (bsToS -> thumbtoken) = + void $ allocate (liftIO $ remoteTemp host (dir tok) thumbtoken) removeTemp + bsToS = unpack . decodeUtf8 + runCertify :: CertifyOpts -> IO (Either String ()) runCertify CertifyOpts{..} = do let terms = fromMaybe defaultTerms (join $ parseAbsoluteURI <$> optTerms) -- cgit v1.2.3