From 53840cb3e183bebead084a1ed550728b69ed88f3 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 27 Jan 2016 07:41:05 -0500 Subject: remove Keys type from Network.ACME.Encoding --- acme-certify.hs | 17 +++++------ src/Network/ACME.hs | 71 ++++++++++++++++++++++++++++---------------- src/Network/ACME/Encoding.hs | 24 ++++----------- 3 files changed, 58 insertions(+), 54 deletions(-) diff --git a/acme-certify.hs b/acme-certify.hs index 98f6711..352be21 100644 --- a/acme-certify.hs +++ b/acme-certify.hs @@ -12,22 +12,21 @@ module Main where import BasePrelude -import Network.ACME (canProvision, certify, - ensureWritableDir, fileProvisioner, - genReq, ()) -import Network.ACME.Encoding (Keys (..), readKeys) -import Network.ACME.Issuer (letsEncryptX1CrossSigned) +import Network.ACME (Keys (..), canProvision, certify, + ensureWritableDir, fileProvisioner, + genReq, 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 Text.Domain.Validate hiding (validate) +import Text.Domain.Validate hiding (validate) import Text.Email.Validate stagingDirectoryUrl, liveDirectoryUrl, defaultTerms :: URI diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs index 85a27e4..2734132 100644 --- a/src/Network/ACME.hs +++ b/src/Network/ACME.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -9,41 +10,44 @@ module Network.ACME where -import Control.Lens hiding (each, (.=)) +import Control.Arrow +import Control.Error +import Control.Lens hiding (each, (.=)) import Control.Monad import Control.Monad.RWS.Strict -import Data.Aeson (Value) -import Data.Aeson.Lens hiding (key) -import qualified Data.Aeson.Lens as JSON -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString.Lazy.Char8 as LC +import Control.Monad.Trans.Resource hiding (register) +import Data.Aeson (Value) +import Data.Aeson.Lens hiding (key) +import qualified Data.Aeson.Lens as JSON +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as LB +import qualified Data.ByteString.Lazy.Char8 as LC import Data.Coerce -import Data.String (fromString) -import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8, encodeUtf8) -import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.List +import Data.String (fromString) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Time.Clock.POSIX (getPOSIXTime) import Network.ACME.Encoding -import Network.Wreq (Response, checkStatus, defaults, - responseBody, responseHeader, - responseStatus, statusCode, - statusMessage) -import qualified Network.Wreq as W -import qualified Network.Wreq.Session as WS -import System.Directory -import Text.Email.Validate -import Text.Domain.Validate hiding (validate) import Network.URI +import Network.Wreq (Response, checkStatus, defaults, + responseBody, responseHeader, + responseStatus, statusCode, + statusMessage) +import qualified Network.Wreq as W +import qualified Network.Wreq.Session as WS import OpenSSL import OpenSSL.EVP.Digest +import OpenSSL.EVP.PKey +import OpenSSL.EVP.Sign hiding (sign) +import OpenSSL.PEM import OpenSSL.RSA +import OpenSSL.X509 (X509, readDerX509) import OpenSSL.X509.Request -import OpenSSL.X509 (readDerX509, X509) -import Data.List -import Control.Error -import Control.Arrow -import Control.Monad.Trans.Resource hiding (register) +import System.Directory +import Text.Domain.Validate hiding (validate) +import Text.Email.Validate genReq :: Keys -> [DomainName] -> IO CSR genReq _ [] = error "genReq called with zero domains" @@ -59,6 +63,21 @@ genReq (Keys priv pub) domains@(domain:_) = withOpenSSL $ do where nidSubjectAltName = 85 +data Keys = Keys RSAKeyPair RSAPubKey +readKeys :: String -> IO (Maybe Keys) +readKeys privKeyData = do + keypair :: SomeKeyPair <- readPrivateKey privKeyData PwTTY + let (priv :: Maybe RSAKeyPair) = toKeyPair keypair + pub <- maybe (return Nothing) (fmap Just . rsaCopyPublic) priv + return $ Keys <$> priv <*> pub + +signPayload :: Keys -> String -> ByteString -> IO LC.ByteString +signPayload (Keys priv pub) = signPayload' sign pub + where + sign x = do + Just dig <- getDigestByName "SHA256" + signBS dig priv x + type HttpProvisioner = URI -> ByteString -> ResIO () fileProvisioner :: WritableDir -> HttpProvisioner fileProvisioner challengeDir uri thumbtoken = do diff --git a/src/Network/ACME/Encoding.hs b/src/Network/ACME/Encoding.hs index dc2c963..315ff49 100644 --- a/src/Network/ACME/Encoding.hs +++ b/src/Network/ACME/Encoding.hs @@ -3,8 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module Network.ACME.Encoding ( - Keys(..), - readKeys, thumbprint, JWK(..), toStrict, @@ -12,7 +10,7 @@ module Network.ACME.Encoding ( challenge, registration, authz, - signPayload, + signPayload', ) where import Crypto.Number.Serialize (i2osp) @@ -27,29 +25,17 @@ import Data.Digest.Pure.SHA (bytestringDigest, sha256) import Data.Maybe import Data.Text.Encoding (decodeUtf8) import OpenSSL -import OpenSSL.EVP.Digest -import OpenSSL.EVP.PKey -import OpenSSL.EVP.Sign -import OpenSSL.PEM import OpenSSL.RSA import Text.Email.Validate import qualified Data.Text as T -data Keys = Keys RSAKeyPair RSAPubKey -readKeys :: String -> IO (Maybe Keys) -readKeys privKeyData = do - keypair :: SomeKeyPair <- readPrivateKey privKeyData PwTTY - let (priv :: Maybe RSAKeyPair) = toKeyPair keypair - pub <- maybe (return Nothing) (fmap Just . rsaCopyPublic) priv - return $ Keys <$> priv <*> pub - -------------------------------------------------------------------------------- -- | Sign return a payload with a nonce-protected header. -signPayload :: Keys -> String -> ByteString -> IO LC.ByteString -signPayload (Keys priv pub) nonce_ payload = withOpenSSL $ do + +signPayload' :: (ByteString -> IO ByteString) -> RSAPubKey -> String -> ByteString -> IO LC.ByteString +signPayload' sign pub nonce_ payload = withOpenSSL $ do let protected = b64 (header pub nonce_) - Just dig <- getDigestByName "SHA256" - sig <- b64 <$> signBS dig priv (B.concat [protected, ".", payload]) + sig <- b64 <$> sign (B.concat [protected, ".", payload]) return $ encode (Request (header' pub) protected payload sig) -------------------------------------------------------------------------------- -- cgit v1.2.3