diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -5,3 +5,4 @@ Renzo Carbonara Vincent Hanquez Joseph Abrahamson +Gabriel Gonzalez diff --git a/examples/https-client.hs b/examples/https-client.hs deleted file mode 100644 --- a/examples/https-client.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main (main) where - -import Control.Applicative ((<$>), (<*>), pure) -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as BL () -import Data.Certificate.X509 (X509) -import Data.CertificateStore (CertificateStore - ,makeCertificateStore) -import Data.Maybe (maybeToList) -import Data.Monoid ((<>)) -import qualified Network.Simple.TCP.TLS as Z -import qualified Network.Socket as NS -import qualified Network.TLS as T -import Network.TLS.Extra as TE -import System.Certificate.X509 (getSystemCertificateStore) -import System.Console.GetOpt -import System.Environment (getProgName, getArgs) - -client :: CertificateStore -> [Z.Credential] -> NS.HostName - -> NS.ServiceName -> IO () -client cStore creds host port = do - Z.connect csettings host port $ \(ctx,_) -> do - T.sendData ctx "GET / HTTP/1.0\r\n\r\n" - consume ctx B.putStr >> putStrLn "" - where - csettings = Z.makeClientSettings creds (Just host) cStore - --- | Repeatedly receive data from the given 'T.Context' until exhausted, --- performing the given action on each received chunk. -consume :: T.Context -> (B.ByteString -> IO ()) -> IO () -consume ctx k = do - mbs <- Z.recv ctx - case mbs of - Nothing -> return () - Just bs -> k bs >> consume ctx k - - -main :: IO () -main = do - args <- getArgs - case getOpt RequireOrder options args of - (actions, [hostname,port], _) -> do - opts <- foldl (>>=) (return defaultOptions) actions - cStore <- case optCACert opts of - Nothing -> getSystemCertificateStore - Just ca -> return $ makeCertificateStore [ca] - let cred = Z.Credential <$> optClientCert opts - <*> optClientKey opts - <*> pure [] - client cStore (maybeToList cred) hostname port - (_,_,msgs) -> do - pn <- getProgName - let header = "Usage: " <> pn <> " [OPTIONS] HOSTNAME PORT" - error $ concat msgs ++ usageInfo header options - --------------------------------------------------------------------------------- --- The boring stuff below is related to command line parsing - -data Options = Options - { optClientCert :: Maybe X509 - , optClientKey :: Maybe T.PrivateKey - , optCACert :: Maybe X509 - } deriving (Show) - -defaultOptions :: Options -defaultOptions = Options - { optClientCert = Nothing - , optClientKey = Nothing - , optCACert = Nothing - } - -options :: [OptDescr (Options -> IO Options)] -options = - [ Option [] ["cert"] (OptArg readClientCert "FILE") "Client certificate" - , Option [] ["key"] (OptArg readClientKey "FILE") "Client private key" - , Option [] ["cacert"] (OptArg readCACert "FILE") "CA certificate" - ] - - -readClientCert :: Maybe FilePath -> Options -> IO Options -readClientCert Nothing opt = return opt -readClientCert (Just arg) opt = do - cert <- TE.fileReadCertificate arg - return $ opt { optClientCert = Just cert } - -readClientKey :: Maybe FilePath -> Options -> IO Options -readClientKey Nothing opt = return opt -readClientKey (Just arg) opt = do - key <- TE.fileReadPrivateKey arg - return $ opt { optClientKey = Just key } - -readCACert :: Maybe FilePath -> Options -> IO Options -readCACert Nothing opt = return opt -readCACert (Just arg) opt = do - cert <- TE.fileReadCertificate arg - return $ opt { optCACert = Just cert } - diff --git a/examples/tls-echo.hs b/examples/tls-echo.hs deleted file mode 100644 --- a/examples/tls-echo.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - -module Main (main) where - -import Control.Applicative -import qualified Data.ByteString.Char8 as B -import Data.Certificate.X509 (X509) -import Data.Char (toUpper) -import Data.Monoid ((<>)) -import qualified Network.Simple.TCP.TLS as Z -import qualified Network.Socket as NS -import qualified Network.TLS as T -import Network.TLS.Extra as TE -import System.Console.GetOpt -import System.Environment (getProgName, getArgs) -import qualified Data.CertificateStore as C - -server :: Z.Credential -> Z.HostPreference -> NS.ServiceName - -> Maybe C.CertificateStore -> IO () -server cred hp port mcs = do - let ss = Z.makeServerSettings cred mcs - Z.serve ss hp port $ \(ctx,caddr) -> do - putStrLn $ show caddr <> " joined." - consume ctx $ Z.send ctx . B.map toUpper - putStrLn $ show caddr <> " quit." - where - --- | Repeatedly receive data from the given 'T.Context' until exhausted, --- performing the given action on each received chunk. -consume :: T.Context -> (B.ByteString -> IO ()) -> IO () -consume ctx k = do - mbs <- Z.recv ctx - case mbs of - Nothing -> return () - Just bs -> k bs >> consume ctx k - - -main :: IO () -main = do - args <- getArgs - case getOpt RequireOrder options args of - (actions, [hostname,port], _) -> do - opts <- foldl (>>=) (return defaultOptions) actions - let !cred = Z.Credential (optServerCert opts) (optServerKey opts) [] - server cred (Z.Host hostname) port - (C.makeCertificateStore . pure <$> optCACert opts) - (_,_,msgs) -> do - pn <- getProgName - let header = "Usage: " <> pn <> " [OPTIONS] HOSTNAME PORT" - error $ concat msgs ++ usageInfo header options - --------------------------------------------------------------------------------- --- The boring stuff below is related to command line parsing - -data Options = Options - { optServerCert :: X509 - , optServerKey :: T.PrivateKey - , optCACert :: Maybe X509 - } deriving (Show) - -defaultOptions :: Options -defaultOptions = Options - { optServerCert = error "Missing optServerCert" - , optServerKey = error "Missing optServerKey" - , optCACert = Nothing - } - -options :: [OptDescr (Options -> IO Options)] -options = - [ Option [] ["cert"] (ReqArg readServerCert "FILE") "Server certificate" - , Option [] ["key"] (ReqArg readServerKey "FILE") "Server private key" - , Option [] ["cacert"] (OptArg readCACert "FILE") - "CA certificate to verify a client certificate, if given" - ] - -readServerCert :: FilePath -> Options -> IO Options -readServerCert arg opt = do - cert <- TE.fileReadCertificate arg - return $ opt { optServerCert = cert } - -readServerKey :: FilePath -> Options -> IO Options -readServerKey arg opt = do - key <- TE.fileReadPrivateKey arg - return $ opt { optServerKey = key } - -readCACert :: Maybe FilePath -> Options -> IO Options -readCACert Nothing opt = return opt -readCACert (Just arg) opt = do - cert <- TE.fileReadCertificate arg - return $ opt { optCACert = Just cert } - diff --git a/network-simple-tls.cabal b/network-simple-tls.cabal --- a/network-simple-tls.cabal +++ b/network-simple-tls.cabal @@ -1,5 +1,5 @@ name: network-simple-tls -version: 0.1.0.1 +version: 0.1.1.0 synopsis: Simple interface to TLS secured network sockets. description: Simple interface to TLS secured network sockets. homepage: https://github.com/k0001/network-simple-tls @@ -32,29 +32,4 @@ ghc-options: -Wall -O2 ghc-prof-options: -prof -fprof-auto-top - - - ------------------------------------------------------------------------- --- Examples. All built when the 'examples' flag is given. - -flag examples - description: Build examples - default: False - -executable network-simple-tls-example-https-client - if !flag(examples) - buildable: False - hs-source-dirs: examples - main-is: https-client.hs - build-depends: base, bytestring, network-simple-tls, network, - tls-extra, tls, certificate - -executable network-simple-tls-example-echo - if !flag(examples) - buildable: False - hs-source-dirs: examples - main-is: tls-echo.hs - build-depends: base, bytestring, network-simple-tls, network, - tls-extra, tls, certificate diff --git a/src/Network/Simple/TCP/TLS.hs b/src/Network/Simple/TCP/TLS.hs --- a/src/Network/Simple/TCP/TLS.hs +++ b/src/Network/Simple/TCP/TLS.hs @@ -21,6 +21,7 @@ , makeServerSettings , updateServerParams , serverParams + -- * Client side , connect -- ** Client TLS Settings @@ -29,17 +30,25 @@ , getDefaultClientSettings , updateClientParams , clientParams + -- * Credentials , Credential(Credential) , credentialToCertList + -- * Utils , recv , send + -- * Low level support , connectTls , acceptTls , useTls , useTlsThenCloseFork + + -- * Note to Windows users + -- $windows-users + , NS.withSocketsDo + -- * Exports , S.HostPreference(..) ) where @@ -63,6 +72,32 @@ import System.Certificate.X509 (getSystemCertificateStore) import System.IO (IOMode(ReadWriteMode)) + +-------------------------------------------------------------------------------- +-- $windows-users +-- +-- If you are running Windows, then you /must/ call 'NS.withSocketsDo', just +-- once, right at the beginning of your program. That is, change your program's +-- 'main' function from: +-- +-- @ +-- main = do +-- print \"Hello world\" +-- -- rest of the program... +-- @ +-- +-- To: +-- +-- @ +-- main = 'NS.withSocketsDo' $ do +-- print \"Hello world\" +-- -- rest of the program... +-- @ +-- +-- If you don't do this, your networking code won't work and you will get many +-- unexpected errors at runtime. If you use an operating system other than +-- Windows then you don't need to do this, but it is harmless to do it, so it's +-- recommended that you do for portability reasons. --------------------------------------------------------------------------------