From 76cd49c6568bcf909f6ec31bfb8d6ed320e546bb Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 8 Apr 2016 23:28:46 -0400
Subject: Improve HttpProvisioner interface

These still need to be renamed
---
 src/Network/ACME.hs | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

(limited to 'src')

diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs
index 2312389..c7e1535 100644
--- a/src/Network/ACME.hs
+++ b/src/Network/ACME.hs
@@ -86,13 +86,25 @@ pollResults (link:links) = do
 
 type HttpProvisioner = DomainName -> ByteString -> ByteString -> ResIO ()
 fileProvisioner :: (DomainName -> Maybe WritableDir) -> HttpProvisioner
-fileProvisioner challengeDir (challengeDir -> Just dir) tok thumbtoken = do
+fileProvisioner challengeDir (challengeDir -> Just dir) tok thumbtoken = provisionViaFile dir tok thumbtoken
+fileProvisioner _ dom _ _ = liftIO $ fail $ "fileProvisioner: no writable directory for domain: " ++ show dom
+
+type HttpProvisioner' = ByteString -> ByteString -> ResIO ()
+dispatchProvisioner :: (DomainName -> Maybe HttpProvisioner') -> HttpProvisioner
+dispatchProvisioner dispatch (dispatch -> Just provision) = provision
+dispatchProvisioner _ dom = const . const . liftIO $ fail errmsg
+  where errmsg = "No means specified to provision files over HTTP for domain: " ++ show dom
+
+dispatchProvisioner' :: [(DomainName, HttpProvisioner')] -> HttpProvisioner
+dispatchProvisioner' xs = dispatchProvisioner (`lookup` xs)
+
+provisionViaFile :: WritableDir -> HttpProvisioner'
+provisionViaFile dir tok thumbtoken = do
   void $ allocate (return f) removeFile
   liftIO $ BC.writeFile f thumbtoken
 
   where
     f = (coerce dir </>) (T.unpack $ decodeUtf8 tok)
-fileProvisioner _ dom _ _ = liftIO $ fail $ "fileProvisioner: no writable directory for domain: " ++ show dom
 
 newtype WritableDir = WritableDir String
 ensureWritableDir :: FilePath -> String -> IO WritableDir
-- 
cgit v1.2.3