secure-sockets 1.0.1 → 1.1.0
raw patch · 3 files changed
+60/−63 lines, 3 filesdep +transformers
Dependencies added: transformers
Files
- Network/Secure.hs +10/−16
- Network/Secure/Identity.hs +47/−45
- secure-sockets.cabal +3/−2
Network/Secure.hs view
@@ -20,16 +20,10 @@ -- $internals -- * Managing identities-- -- ** Authenticating peers- PeerIdentity- , writePeerIdentity- , readPeerIdentity-- -- ** Authenticating to peers+ Identity(..)+ , PeerIdentity , LocalIdentity- , writeLocalIdentity- , readLocalIdentity+ , toPeerIdentity , newLocalIdentity @@ -66,7 +60,7 @@ -- -- > do -- > id <- newLocalIdentity "server1.domain.com" 365--- > writeLocalIdentity id >>= writeFile "server.key"+-- > writeIdentity id >>= writeFile "server.key" -- -- The name is not used at all by the library, it just allows you to -- identify the key later on if you need to.@@ -76,8 +70,8 @@ -- that can be given to other hosts. -- -- > do--- > id <- readFile "server.key" >>= readLocalIdentity--- > writePeerIdentity (toPeerIdentity id) >>= writeFile "server.pub"+-- > id <- readFile "server.key" >>= readIdentity+-- > writeIdentity (toPeerIdentity id) >>= writeFile "server.pub" -- -- This public file should be distributed to the servers with whom you -- want to communicate. Once everyone has the public identities of@@ -85,16 +79,16 @@ -- start listening for connections. -- -- > do--- > me <- readFile "a.key" >>= readLocalIdentity--- > you <- readFile "b.pub" >>= readPeerIdentity+-- > me <- readFile "a.key" >>= readIdentity+-- > you <- readFile "b.pub" >>= readIdentity -- > server <- newServer (Nothing, "4242") -- > conn <- accept me [you] server -- -- Then, another host needs to connect. -- -- > do--- > me <- readFile "b.key" >>= readLocalIdentity--- > you <- readFile "a.pub" >>= readPeerIdentity+-- > me <- readFile "b.key" >>= readIdentity+-- > you <- readFile "a.pub" >>= readIdentity -- > conn <- connect me you ("a.com", "4242") -- -- Et voila! From there on, you can communicate using the usual
Network/Secure/Identity.hs view
@@ -1,12 +1,9 @@ module Network.Secure.Identity (- PeerIdentity- , readPeerIdentity- , writePeerIdentity- + Identity(..)+ , PeerIdentity , LocalIdentity- , readLocalIdentity- , writeLocalIdentity+ , toPeerIdentity , newLocalIdentity @@ -19,6 +16,7 @@ import Control.Applicative ((<$>)) import Control.Exception (bracket) import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString, append, hPut) import Data.ByteString.Char8 (pack, unpack) import Data.Maybe (fromJust, isNothing)@@ -34,6 +32,18 @@ import System.IO (openBinaryTempFile, hFlush) import System.IO.Unsafe (unsafePerformIO) +-- |An identity, public or private.+class Identity a where+ -- |Return the description that was associated with the identity+ -- when it was created.+ identityName :: a -> String+ -- |Serialize an identity to a 'ByteString' for storage or+ -- transmission.+ writeIdentity :: (Functor m, MonadIO m) => a -> m ByteString+ -- |Read back an identity previously serialized with+ -- writeIdentity.+ readIdentity :: (Functor m, MonadIO m) => ByteString -> m a+ -- |The public identity of a peer. This kind of identity can be used -- to authenticate the remote ends of connections. data PeerIdentity = PI@@ -42,18 +52,6 @@ , _piCN :: String } --- |Serialize a 'PeerIdentity' to a 'ByteString' for storage or--- transmission.-writePeerIdentity :: PeerIdentity -> IO ByteString-writePeerIdentity (PI cert _) = pack <$> writeX509 cert---- |Read back a 'PeerIdentity' previously serialized with--- 'writePeerIdentity'.-readPeerIdentity :: ByteString -> IO PeerIdentity-readPeerIdentity b = do- cert <- readX509 (unpack b)- PI cert <$> getCN cert- instance Eq PeerIdentity where a == b = compare a b == EQ @@ -63,6 +61,13 @@ instance Show PeerIdentity where show (PI _ cn) = "PeerIdentity " ++ cn +instance Identity PeerIdentity where+ identityName (PI _ cn) = cn+ writeIdentity (PI cert _) = liftIO $ pack <$> writeX509 cert+ readIdentity b = do+ cert <- liftIO $ readX509 (unpack b)+ PI cert <$> getCN cert+ fromX509 :: X509 -> IO PeerIdentity fromX509 cert = PI cert <$> getCN cert @@ -86,26 +91,22 @@ 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- c <- writeX509 cert- k <- writePKCS8PrivateKey key Nothing- return $ pack (c ++ k)+ show (LI _ _ cn) = cn --- |Read back a 'LocalIdentity' previously serialized with--- 'writeLocalIdentity'.-readLocalIdentity :: ByteString -> IO LocalIdentity-readLocalIdentity b = do- (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) cn- else fail "Cert and key don't match"+instance Identity LocalIdentity where+ identityName (LI _ _ cn) = cn+ writeIdentity (LI cert key _) = do+ c <- liftIO $ writeX509 cert+ k <- liftIO $ writePKCS8PrivateKey key Nothing+ return $ pack (c ++ k)+ readIdentity b = do+ (PI cert cn) <- readIdentity b+ key <- liftIO $ toKeyPair <$> readPrivateKey (unpack b) PwNone+ when (isNothing key) $ fail "Bad private key"+ liftIO (certMatchesKey cert $ fromJust key) >>= \r ->+ if r+ then return $ LI cert (fromJust key) cn+ else fail "Cert and key don't match" -- |Extract the public parts of a 'LocalIdentity' into a -- 'PeerIdentity' suitable for sharing with peers. The resulting@@ -119,12 +120,13 @@ -- -- Note that this function may take quite a while to execute, as it is -- generating key material for the identity.-newLocalIdentity :: String -> Int -> IO LocalIdentity-newLocalIdentity commonName days = bracket mkKeyFile rmKeyFile $ \(p,h) -> do- key <- run genKey- hPut h key >> hFlush h- cert <- run $ genCert p- readLocalIdentity $ append key cert+newLocalIdentity :: (MonadIO m) => String -> Int -> m LocalIdentity+newLocalIdentity commonName days =+ liftIO $ bracket mkKeyFile rmKeyFile $ \(p,h) -> do+ key <- run genKey+ hPut h key >> hFlush h+ cert <- run $ genCert p+ readIdentity $ append key cert where mkKeyFile = getTemporaryDirectory >>= flip openBinaryTempFile "key.pem" rmKeyFile = removeFile . fst@@ -141,5 +143,5 @@ contextSetCertificate ctx cert contextCheckPrivateKey ctx -getCN :: X509 -> IO String-getCN cert = fromJust . lookup "CN" <$> getSubjectName cert False+getCN :: MonadIO m => X509 -> m String+getCN cert = liftIO $ fromJust . lookup "CN" <$> getSubjectName cert False
secure-sockets.cabal view
@@ -1,5 +1,5 @@ Name: secure-sockets-Version: 1.0.1+Version: 1.1.0 Synopsis: Secure point-to-point connectivity library Description: This library simplifies the task of securely connecting two@@ -25,7 +25,8 @@ directory ==1.0.*, HSH ==2.0.*, HsOpenSSL ==0.8.*,- network ==2.*+ network ==2.*,+ transformers ==0.2.* ghc-prof-options: -auto-all ghc-options: -Wall -funbox-strict-fields -fwarn-tabs