implement remote file http provisioner

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)