network-simple-tls 0.1.0.1 → 0.1.1.0
raw patch · 5 files changed
+37/−217 lines, 5 filesdep −network-simple-tlsdep ~basedep ~bytestringdep ~certificatePVP ok
version bump matches the API change (PVP)
Dependencies removed: network-simple-tls
Dependency ranges changed: base, bytestring, certificate, network, tls, tls-extra
API changes (from Hackage documentation)
+ Network.Simple.TCP.TLS: withSocketsDo :: IO a -> IO a
Files
- PEOPLE +1/−0
- examples/https-client.hs +0/−99
- examples/tls-echo.hs +0/−92
- network-simple-tls.cabal +1/−26
- src/Network/Simple/TCP/TLS.hs +35/−0
PEOPLE view
@@ -5,3 +5,4 @@ Renzo Carbonara Vincent Hanquez Joseph Abrahamson+Gabriel Gonzalez
− examples/https-client.hs
@@ -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 }-
− examples/tls-echo.hs
@@ -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 }-
network-simple-tls.cabal view
@@ -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
src/Network/Simple/TCP/TLS.hs view
@@ -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. --------------------------------------------------------------------------------