transient-universe-tls 0.1.0.0 → 0.1.1.0

raw patch · 3 files changed

+31/−20 lines, 3 filesdep +x509-systemdep −certificatedep ~transient-universe

Dependencies added: x509-system

Dependencies removed: certificate

Dependency ranges changed: transient-universe

Files

• README.md +4/−2
• src/Transient/TLS.hs +24/−15
• transient-universe-tls.cabal +3/−3

@@ -1,9 +1,11 @@ # transient-universe-tls
-secure communications for transient-universe. 
+Secure communications for transient-universe. 
 
 `initTLS` must be called before using any communication. Then any connection with other nodes is atempted to be secure. It is necessary a certificate and a key for the node at the folder where it is executed.  Certificate verification from calling nodes is disabled in this version, so encription of messages among nodes, and not verification is the goal initially.
 
-Connection from nodes accept `https` requests. If a connection is secure, socket communications are encripted too.
+upon initTLS has been called,  any `connect`  will try to establish a secure connection or will fail.
+
+Connection from web nodes accept `https` requests. If a connection is secure, socket communications are encripted too.
 
 In order to generate a self-signed certificate for testing, try the following:
 

@@ -13,7 +13,7 @@ 
 {-# LANGUAGE   CPP, OverloadedStrings, BangPatterns, ScopedTypeVariables #-}
 
-module Transient.TLS(initTLS) where
+module Transient.TLS(initTLS, initTLS') where
 #ifndef ghcjs_HOST_OS
 import           Transient.Internals
 import           Transient.Move.Internals
@@ -32,7 +32,6 @@ import qualified Data.ByteString.Lazy.Char8         as BL8
 import qualified Data.ByteString.Char8              as B
 import qualified Data.ByteString                    as BE
-import qualified Data.Certificate.X509              as X
 
 import qualified Data.X509.CertificateStore         as C
 import           Data.Default
@@ -49,18 +48,25 @@ 
 
 initTLS :: MonadIO m => m ()
-initTLS= liftIO $
-      writeIORef tlsHooks (unsafeCoerce $ (TLS.sendData :: TLS.Context -> BL8.ByteString -> IO ())
-                          ,unsafeCoerce $ (TLS.recvData :: TLS.Context -> IO BE.ByteString)
-                          ,unsafeCoerce $ Transient.TLS.maybeTLSServerHandshake
-                          ,unsafeCoerce $ Transient.TLS.maybeClientTLSHandshake )
+initTLS = initTLS' "certificate.pem" "key.pem"
 
+initTLS' :: MonadIO m => FilePath -> FilePath -> m ()
+initTLS' certpath keypath = liftIO $ writeIORef
+  tlsHooks
+  ( unsafeCoerce $ (TLS.sendData :: TLS.Context -> BL8.ByteString -> IO ())
+  , unsafeCoerce $ (TLS.recvData :: TLS.Context -> IO BE.ByteString)
+  , unsafeCoerce $ Transient.TLS.maybeTLSServerHandshake certpath keypath
+  , unsafeCoerce $ Transient.TLS.maybeClientTLSHandshake
+  )
 
-maybeTLSServerHandshake sock input= do
+
+maybeTLSServerHandshake
+  :: FilePath -> FilePath -> Socket -> BL8.ByteString -> TransIO ()
+maybeTLSServerHandshake certpath keypath sock input= do
  if ((not $ BL.null input) && BL.head input  == 0x16)
    then  do
         mctx <- liftIO $( do
-              ctx <- makeServerContext ssettings sock  input
+              ctx <- makeServerContext (ssettings certpath keypath) sock  input
               TLS.handshake ctx
               return $Just ctx )
                `catch` \(e:: SomeException) -> do
@@ -77,13 +83,13 @@              onException $ \(e:: SomeException) -> liftIO $ TLS.contextClose ctx
    else return ()
 
-ssettings = unsafePerformIO $ do
-      cred <- either error id <$> TLS.credentialLoadX509
-             "certificate.pem"
-             "key.pem"
+ssettings :: FilePath -> FilePath -> ServerParams
+ssettings certpath keypath = unsafePerformIO $ do
+      cred <- either error id <$> TLS.credentialLoadX509 certpath keypath
       return $ makeServerSettings    cred
 
 
+maybeClientTLSHandshake :: String -> Socket -> BL8.ByteString -> TransIO ()
 maybeClientTLSHandshake hostname sock input = do
    mctx <- liftIO $ (do
            global <- getSystemCertificateStore
@@ -94,9 +100,9 @@            return $ Just ctx)
               `catch` \(e :: SomeException) -> return Nothing
    case mctx of
-     Nothing -> print "No TLS connection" >> return ()                   --  !> "NO TLS"
+     Nothing -> liftIO $ print "No TLS connection" >> return ()                   --  !> "NO TLS"
      Just ctx -> do
-        print "TLS connetion" >> return ()                           --  !> "TLS"
+        liftIO $ print "TLS connetion" >> return ()                           --  !> "TLS"
         modifyState $ \(Just c) -> Just  c{connData= Just $ TLSNode2Node $ unsafeCoerce ctx}
 
         setData $ ParseContext (TLS.recvData ctx >>= return . BL.fromChunks . (:[]))
@@ -228,4 +234,7 @@ 
 initTLS :: MonadIO m => m ()
 initTLS= return ()
+
+initTLS' :: MonadIO m => FilePath -> FilePath -> m ()
+initTLS' _ _ = return ()
 #endif

@@ -1,6 +1,6 @@ name: transient-universe-tls
 description: Secure communications for transient
-version: 0.1.0.0
+version: 0.1.1.0
 cabal-version: >=1.10
 build-type: Simple
 license: BSD3
@@ -20,8 +20,8 @@ 
 library
     build-depends:
-        base >=4.8 && <5.9, tls, cprng-aes,  certificate, transient, transient-universe,
-        bytestring, data-default, network, x509-store
+        base >=4.8 && <5.9, tls, cprng-aes, transient, transient-universe >= 0.4.1,
+        bytestring, data-default, network, x509-store, x509-system
     default-language: Haskell2010
     hs-source-dirs: src
     exposed-modules: