summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2016-01-24 01:53:55 -0500
committerAndrew Cady <d@jerkface.net>2016-01-24 01:53:55 -0500
commitfdf06576f7d21392f512492b164df899136f30d3 (patch)
treebd490b0e629d851660441eb96c34ffb8148a5436 /src
parent05817369d9388d2175e942af79888ec01aa4b74a (diff)
Validate email address
Diffstat (limited to 'src')
-rw-r--r--src/Network/ACME.hs14
1 files changed, 8 insertions, 6 deletions
diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs
index ccd0a8c..d6a0f47 100644
--- a/src/Network/ACME.hs
+++ b/src/Network/ACME.hs
@@ -1,6 +1,6 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-} 2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE ScopedTypeVariables #-} 3{-# LANGUAGE ScopedTypeVariables #-}
4 4
5module Network.ACME ( 5module Network.ACME (
6 Keys(..), 6 Keys(..),
@@ -32,6 +32,8 @@ import OpenSSL.EVP.PKey
32import OpenSSL.EVP.Sign 32import OpenSSL.EVP.Sign
33import OpenSSL.PEM 33import OpenSSL.PEM
34import OpenSSL.RSA 34import OpenSSL.RSA
35import Text.Email.Validate
36import qualified Data.Text as T
35 37
36data Keys = Keys RSAKeyPair RSAPubKey 38data Keys = Keys RSAKeyPair RSAPubKey
37readKeys :: String -> IO (Maybe Keys) 39readKeys :: String -> IO (Maybe Keys)
@@ -69,7 +71,7 @@ header key nonce = (toStrict . encode)
69 (Header "RS256" (JWK (rsaE key) "RSA" (rsaN key)) (Just nonce)) 71 (Header "RS256" (JWK (rsaE key) "RSA" (rsaN key)) (Just nonce))
70 72
71-- | Registration payload to sign with user key. 73-- | Registration payload to sign with user key.
72registration :: String -> String -> ByteString 74registration :: EmailAddress -> String -> ByteString
73registration emailAddr terms = (b64 . toStrict . encode) (Reg emailAddr terms) 75registration emailAddr terms = (b64 . toStrict . encode) (Reg emailAddr terms)
74 76
75-- | Challenge request payload to sign with user key. 77-- | Challenge request payload to sign with user key.
@@ -125,7 +127,7 @@ instance ToJSON JWK where
125 ] 127 ]
126 128
127data Reg = Reg 129data Reg = Reg
128 { rMail :: String 130 { rMail :: EmailAddress
129 , rAgreement :: String 131 , rAgreement :: String
130 } 132 }
131 deriving Show 133 deriving Show
@@ -133,7 +135,7 @@ data Reg = Reg
133instance ToJSON Reg where 135instance ToJSON Reg where
134 toJSON Reg{..} = object 136 toJSON Reg{..} = object
135 [ "resource" .= ("new-reg" :: String) 137 [ "resource" .= ("new-reg" :: String)
136 , "contact" .= ["mailto:" ++ rMail] 138 , "contact" .= ["mailto:" ++ (T.unpack . decodeUtf8 . toByteString $ rMail)]
137 , "agreement" .= rAgreement 139 , "agreement" .= rAgreement
138 ] 140 ]
139 141