diff options
author | Andrew Cady <d@jerkface.net> | 2016-04-09 22:33:28 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2016-04-09 22:33:28 -0400 |
commit | 2767871a0dc502b369a9baa0a6f55dc541cc1e13 (patch) | |
tree | 1bb5f1868881773263bb383b8868c07ddca4374d | |
parent | ccb8a70a1e3492adcc18d23de965af4410a684c1 (diff) |
disable misc. test output
-rw-r--r-- | acme-certify.hs | 31 |
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 | |||
325 | getOrCreateDH = getOrCreate (genDHParams' >>= writeDHParams) readDHParams | 332 | getOrCreateDH = getOrCreate (genDHParams' >>= writeDHParams) readDHParams |
326 | 333 | ||
327 | domainName' :: String -> DomainName | 334 | domainName' :: String -> DomainName |
328 | domainName' dom = fromMaybe (error $ "Error: invalid domain name: " ++ show dom) (domainName $ fromString dom) | 335 | domainName' dom = fromMaybe (error $ "Error: invalid domain name: " ++ dom) (domainName $ fromString dom) |
329 | 336 | ||
330 | genDHParams' :: IO DHP | 337 | genDHParams' :: IO DHP |
331 | genDHParams' = do | 338 | genDHParams' = do |