secure-sockets 1.0 → 1.0.1

raw patch · 4 files changed

+47/−23 lines, 4 files

Files

• LICENSE +1/−1
• Network/Secure/Connection.hs +17/−6
• Network/Secure/Identity.hs +28/−15
• secure-sockets.cabal +1/−1

@@ -1,4 +1,4 @@-Copyright David Anderson 2010+Copyright Google Inc. 2010  All rights reserved. 

@@ -38,17 +38,28 @@ -- |An established authenticated connection to a peer. It is -- guaranteed that all Connection objects are with a known peer, and -- that the connection is strongly encrypted.-data Connection = C +data Connection = C     {-      ssl  :: SSL+      ssl   :: SSL       -- |Return the 'PeerIdentity' of the remote end of the connection.-    , peer :: PeerIdentity+    , peer  :: PeerIdentity+    , _addr :: SockAddr     } +instance Eq Connection where+    (C _ p1 a1) == (C _ p2 a2) = (p1, a1) == (p2, a2)++instance Show Connection where+    show (C _ p a) = concat [ "Connection { peer = "+                            , show p+                            , ", addr = "+                            , show a+                            , " }" ]+ -- |A server socket that accepts only secure connections. newtype Socket = S {      unSocket :: Network.Socket.Socket-    }+    } deriving (Eq, Show)  -- |Connect securely to the given host/port. The 'Connection' is -- returned only if the peer accepts the given 'LocalIdentity', and if@@ -117,8 +128,8 @@     flip onException (shutdown conn Unidirectional) $ do         initiate conn         verifyConnection conn >>= flip unless (fail "Peer verification error")-        peerId <- fromX509 . fromJust <$> getPeerCertificate conn-        return $ C conn peerId+        peerId <- fromX509 . fromJust =<< getPeerCertificate conn+        C conn peerId <$> getPeerName sock   where     verifyConnection conn = do         verified <- getVerifyResult conn

@@ -29,57 +29,68 @@ import OpenSSL.RSA (RSAKeyPair) import OpenSSL.Session (context, contextSetPrivateKey,                         contextSetCertificate, contextCheckPrivateKey)-import OpenSSL.X509 (X509, compareX509)+import OpenSSL.X509 (X509, compareX509, getSubjectName) import System.Directory (getTemporaryDirectory, removeFile) import System.IO (openBinaryTempFile, hFlush) import System.IO.Unsafe (unsafePerformIO)  -- |The public identity of a peer. This kind of identity can be used -- to authenticate the remote ends of connections.-newtype PeerIdentity = PI {+data PeerIdentity = PI+    {       piX509 :: X509+    , _piCN  :: String     }  -- |Serialize a 'PeerIdentity' to a 'ByteString' for storage or -- transmission. writePeerIdentity :: PeerIdentity -> IO ByteString-writePeerIdentity (PI cert) = pack <$> writeX509 cert+writePeerIdentity (PI cert _) = pack <$> writeX509 cert  -- |Read back a 'PeerIdentity' previously serialized with -- 'writePeerIdentity'. readPeerIdentity :: ByteString -> IO PeerIdentity-readPeerIdentity = fmap PI . readX509 . unpack+readPeerIdentity b = do+    cert <- readX509 (unpack b)+    PI cert <$> getCN cert  instance Eq PeerIdentity where     a == b = compare a b == EQ  instance Ord PeerIdentity where-    compare (PI a) (PI b) = unsafePerformIO $ compareX509 a b+    compare (PI a _) (PI b _) = unsafePerformIO $ compareX509 a b -fromX509 :: X509 -> PeerIdentity-fromX509 = PI+instance Show PeerIdentity where+    show (PI _ cn) = "PeerIdentity " ++ cn +fromX509 :: X509 -> IO PeerIdentity+fromX509 cert = PI cert <$> getCN cert+ -- |A local identity. This kind of identity can be used to -- authenticate /to/ remote ends of connections. data LocalIdentity = LI     {       liX509 :: X509      , liKey  :: RSAKeyPair+    , _liCN  :: String     }  instance Eq LocalIdentity where     a == b = compare a b == EQ  instance Ord LocalIdentity where-    compare (LI c1 k1) (LI c2 k2) =-        case compare (PI c1) (PI c2) of+    compare (LI c1 k1 cn1) (LI c2 k2 cn2) =+        case compare (PI c1 cn1) (PI c2 cn2) of             EQ -> compare k1 k2             GT -> GT             LT -> LT +instance Show LocalIdentity where+    show (LI _ _ cn) = "LocalIdentity " ++ cn+ -- |Serialize a 'LocalIdentity' to a 'ByteString' for storage. writeLocalIdentity :: LocalIdentity -> IO ByteString-writeLocalIdentity (LI cert key) = do+writeLocalIdentity (LI cert key _) = do     c <- writeX509 cert     k <- writePKCS8PrivateKey key Nothing     return $ pack (c ++ k)@@ -88,13 +99,12 @@ -- 'writeLocalIdentity'. readLocalIdentity :: ByteString -> IO LocalIdentity readLocalIdentity b = do-    let s = unpack b-    cert <- readX509 s-    key <- toKeyPair <$> readPrivateKey s PwNone+    (PI cert cn) <- readPeerIdentity b+    key <- toKeyPair <$> readPrivateKey (unpack b) PwNone     when (isNothing key) $ fail "Bad private key"     certMatchesKey cert (fromJust key) >>= \r ->         if r-        then return $ LI cert (fromJust key)+        then return $ LI cert (fromJust key) cn         else fail "Cert and key don't match"  -- |Extract the public parts of a 'LocalIdentity' into a@@ -102,7 +112,7 @@ -- 'PeerIdentity' will allow them to verify your identity when you -- authenticate using the corresponding 'LocalIdentity'. toPeerIdentity :: LocalIdentity -> PeerIdentity-toPeerIdentity (LI cert _) = PI cert+toPeerIdentity (LI cert _ cn) = PI cert cn  -- |Generate a new 'LocalIdentity', giving it an identifying name and -- a validity period in days.@@ -130,3 +140,6 @@     contextSetPrivateKey ctx key     contextSetCertificate ctx cert     contextCheckPrivateKey ctx++getCN :: X509 -> IO String+getCN cert = fromJust . lookup "CN" <$> getSubjectName cert False

@@ -1,5 +1,5 @@ Name:                secure-sockets-Version:             1.0+Version:             1.0.1 Synopsis:            Secure point-to-point connectivity library Description:     This library simplifies the task of securely connecting two