summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2016-04-09 22:33:28 -0400
committerAndrew Cady <d@jerkface.net>2016-04-09 22:33:28 -0400
commit2767871a0dc502b369a9baa0a6f55dc541cc1e13 (patch)
tree1bb5f1868881773263bb383b8868c07ddca4374d
parentccb8a70a1e3492adcc18d23de965af4410a684c1 (diff)
disable misc. test output
-rw-r--r--acme-certify.hs31
1 files changed, 19 insertions, 12 deletions
diff --git a/acme-certify.hs b/acme-certify.hs
index 418fbbb..5f4c24d 100644
--- a/acme-certify.hs
+++ b/acme-certify.hs
@@ -169,26 +169,33 @@ runUpdate UpdateOpts { .. } = do
169 "domains") <&> extractObject 169 "domains") <&> extractObject
170 forM (HashMap.keys hostParts) $ \domain -> 170 forM (HashMap.keys hostParts) $ \domain ->
171 return (unpack host, combineSubdomains domain hostParts) 171 return (unpack host, combineSubdomains domain hostParts)
172 forM_ certReqDomains print 172
173 when False $ forM_ certReqDomains print
173 174
174 globalCertificateDir <- getHomeDirectory <&> (</> ".acme/test") 175 globalCertificateDir <- getHomeDirectory <&> (</> ".acme/test")
175 createDirectoryIfMissing True globalCertificateDir 176 createDirectoryIfMissing True globalCertificateDir
176 177
177 Just keys <- getOrCreateKeys $ globalCertificateDir </> "rsa.key" 178 Just keys <- getOrCreateKeys $ globalCertificateDir </> "rsa.key"
178 179
179 let certSpecs = flip map certReqDomains $ \(host, domains) -> case dereference $ map (chooseProvisioner host) domains of 180 let certSpecs = flip map certReqDomains $ \(host, domains) -> fmap ((,) host) $
180 Just provisioners -> certSpec globalCertificateDir keys (host, provisioners) 181 dereference (map (chooseProvisioner host) domains) <&> certSpec globalCertificateDir keys host
181 Nothing -> error "invalid configuration file"
182 182
183 mapM_ print certSpecs 183 when False $ do
184 mapM_ print certSpecs
184 185
185 h <- remoteTemp "localhost" "/tmp/whatevs 'bro'" "this content\ncontains stuff'" 186 h <- remoteTemp "localhost" "/tmp/whatevs 'bro'" "this content\ncontains stuff'"
186 threadDelay $ 1000 * 1000 * 10 187 threadDelay $ 1000 * 1000 * 10
187 removeTemp h 188 removeTemp h
188 189
189 error "Error: unimplemented" 190 forM_ certReqDomains $ \(host, domains) -> do
191 when (host == "fifty") $ do
192 putStrLn host
193 let cs = dereference (map (chooseProvisioner host) domains) <&> certSpec globalCertificateDir keys host
194 print cs
195 error "Error: unimplemented"
190 196
191 where 197 where
198
192 dereference :: [(DomainName, Either DomainName HttpProvisioner)] -> Maybe [(DomainName, HttpProvisioner)] 199 dereference :: [(DomainName, Either DomainName HttpProvisioner)] -> Maybe [(DomainName, HttpProvisioner)]
193 dereference xs = plumb $ xs <&> fmap (either deref Just) 200 dereference xs = plumb $ xs <&> fmap (either deref Just)
194 where 201 where
@@ -200,8 +207,8 @@ runUpdate UpdateOpts { .. } = do
200 chooseProvisioner host (VHostSpec domain pathInfo) = 207 chooseProvisioner host (VHostSpec domain pathInfo) =
201 (domain, provisionViaRemoteFile host <$> pathInfo) 208 (domain, provisionViaRemoteFile host <$> pathInfo)
202 209
203 certSpec :: FilePath -> Keys -> (String, [(DomainName, HttpProvisioner)]) -> CertSpec 210 certSpec :: FilePath -> Keys -> String -> [(DomainName, HttpProvisioner)] -> CertSpec
204 certSpec baseDir keys (host, requestDomains) = CertSpec { .. } 211 certSpec baseDir keys host requestDomains = CertSpec { .. }
205 where 212 where
206 csDomains = requestDomains 213 csDomains = requestDomains
207 csSkipDH = True -- TODO: implement 214 csSkipDH = True -- TODO: implement
@@ -325,7 +332,7 @@ getOrCreateDH :: FilePath -> IO DHP
325getOrCreateDH = getOrCreate (genDHParams' >>= writeDHParams) readDHParams 332getOrCreateDH = getOrCreate (genDHParams' >>= writeDHParams) readDHParams
326 333
327domainName' :: String -> DomainName 334domainName' :: String -> DomainName
328domainName' dom = fromMaybe (error $ "Error: invalid domain name: " ++ show dom) (domainName $ fromString dom) 335domainName' dom = fromMaybe (error $ "Error: invalid domain name: " ++ dom) (domainName $ fromString dom)
329 336
330genDHParams' :: IO DHP 337genDHParams' :: IO DHP
331genDHParams' = do 338genDHParams' = do