Haskell - TLS ping-pong multi- client and server

Files

user@personal:~/.../tls-ping-pong$ ll -R
.:
total 40K
drwxr-xr-x 2 user user 4.0K Jul  7 17:06 bin/
drwxr-xr-x 2 user user  12K Jul  7 17:07 log/
drwxr-xr-x 2 user user 4.0K Jul  7 17:05 src/
drwxr-xr-x 2 user user 4.0K Jul  7 02:25 tls/
-rwxr-xr-x 1 user user  245 Jul  7 13:57 build.bash*
-rwxr-xr-x 1 user user  134 Jul  7 16:43 many.clients.tls.bash*
-rw-r--r-- 1 user user 1.6K Jul  7 16:55 package.yaml
-rw-r--r-- 1 user user   71 Jul  7 14:20 stack.yaml

./bin:
total 14M
-rwxr-xr-x 1 user user 7.1M Jul  7 17:06 client*
-rwxr-xr-x 1 user user 7.0M Jul  7 17:06 server*

./log:
total 0

./src:
total 12K
-rwxr-xr-x 1 user user 4.4K Jul  7 17:05 Client.hs*
-rwxr-xr-x 1 user user 3.6K Jul  7 16:59 Server.hs*

./tls:
total 12K
-rwxr-xr-x 1 user user 568 Jul  7 02:22 00_generate_rca.bash*
-rwxr-xr-x 1 user user 772 Jul  7 02:25 01_generate_crt.bash*
-rw-r--r-- 1 user user 375 Jul  7 02:24 example.conf

Code Snippets

src/Client.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
#!/usr/bin/env stack
{- stack
   --resolver lts-11.7
   --install-ghc
   runghc
   --package bytestring
   --package network
   --package time
   --package data-default-class
   --package tls
   --package x509
   --package x509-store
   --package x509-validation
   --
-}
--   -Wall -Werror

-- Issue with stack: Version 1.7.1
-- Git revision 681c800873816c022739ca7ed14755e85a579565 x86_64 hpack-0.28.2
-- the following flags after -- aren't read anymore and are just sent as extra
-- arguments which are caught by getArgs. Therefore, they are outcommented

--------------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------

module Main (main) where

--------------------------------------------------------------------------------

import           Control.Exception
  ( IOException
  , try
  )
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.Maybe
  ( fromJust
  , fromMaybe
  , listToMaybe
  )
import           Data.Time
  ( defaultTimeLocale
  , formatTime
  , getCurrentTime
  )
import           Data.Word
  ( Word8
  )
import qualified Data.X509                  as X509
import           Data.X509.CertificateStore
  ( readCertificateStore
  )
import qualified Data.X509.Validation       as X509
import           Data.Default.Class
  ( def
  )
import           Network.Socket             hiding
  ( recv
  , send
  )
import qualified Network.TLS                as T
import qualified Network.TLS.Extra          as TE
import           System.Environment
  ( getArgs
  )

--------------------------------------------------------------------------------

tlsPort
  :: IO PortNumber

iso8601
  :: IO String

recv
  :: T.Context
  -> IO (Either IOException BS.ByteString)
  
send
  :: T.Context
  -> [ BS.ByteString ]
  -> IO (Either IOException ())

ping
  :: T.Context
  -> IO ()

client
  :: IO ()

main
  :: IO ()

--------------------------------------------------------------------------------

main =
  client

--------------------------------------------------------------------------------

tlsPort =
  getArgs >>= pure . fromMaybe 8443 . listToMaybe . (map read) 

iso8601 =
  -- https://hackage.haskell.org/package/time-1.9.1/docs/Data-Time-Format.html
  getCurrentTime >>= pure . (formatTime defaultTimeLocale "%FT%T%0QZ")
          
recv ctx =
  try $ T.recvData ctx

send ctx bs =
  try $ T.sendData ctx $ L8.fromChunks $ bs

ping ctx = 
  do
    req <- send ctx [ "ping" ]
    case Right () ==  req of
      False -> T.contextClose ctx
      True  -> 
        do
          tsping <- iso8601
          putStrLn $ tsping ++ " | Client | Ping"
          res <- recv ctx
          case Right "pong" == res of
            False -> T.contextClose ctx
            True  ->
              do
                tspong <- iso8601
                putStrLn $ tspong ++ " | Server | Pong"
                ping ctx

client =
  do
    port <- tlsPort
    x509 <- cacs
    sock <- socket AF_INET Stream 0
    ____ <- connect sock $ SockAddrInet port (tupleToHostAddress host)

    putStrLn $ ("Connected to: " ++) $ name
    
    ctx <- T.contextNew sock $ para x509
    ___ <- T.handshake ctx
    
    ping ctx
      where
        cacs = readCertificateStore "../tls/root.ca.crt" >>= pure . fromJust
        host = (127, 0, 0, 1) :: (Word8, Word8, Word8, Word8)
        name = "localhost" :: HostName
        para x509 =
          ( T.defaultParamsClient name BS.empty )
          { T.clientSupported =
            def
            { T.supportedCiphers  = TE.ciphersuite_strong
            , T.supportedVersions = [ T.TLS12 ]
            }
          , T.clientShared =
            def
            { T.sharedCAStore = x509
            }
          , T.clientHooks = hook
          }
        hook =
          -- Disable checkLeafV3 when testing wit local created CAs
          -- github.com/vincenthz/hs-tls/issues/154#issuecomment-268083940
          def
          { T.onServerCertificate = leaf
          }
        leaf =
          X509.validate
          X509.HashSHA256
          X509.defaultHooks
          $ X509.defaultChecks { T.checkLeafV3 = False }

src/Server.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
#!/usr/bin/env stack
{- stack
   --resolver lts-11.7
   --install-ghc
   runghc
   --package bytestring
   --package network
   --package data-default-class
   --package tls
   --
-}
--   -Wall -Werror

-- Issue with stack: Version 1.7.1
-- Git revision 681c800873816c022739ca7ed14755e85a579565 x86_64 hpack-0.28.2
-- the following flags after -- aren't read anymore and are just sent as extra
-- arguments which are caught by getArgs. Therefore, they are outcommented

--------------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------

module Main (main) where

--------------------------------------------------------------------------------

import           Control.Exception
  ( IOException
  , try
  )
import           Control.Concurrent
  ( forkIO
  )
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.Maybe
  ( fromMaybe
  , listToMaybe
  )
import           Data.Default.Class
  ( def
  )
import           Network.Socket             hiding
  ( recv
  , send
  )
import qualified Network.TLS                as T
import qualified Network.TLS.Extra          as TE
import           System.Environment
  ( getArgs
  )

--------------------------------------------------------------------------------

tlsPort
  :: IO PortNumber

recv
  :: T.Context
  -> IO (Either IOException BS.ByteString)
  
send
  :: T.Context
  -> [ BS.ByteString ]
  -> IO (Either IOException ())

pong
  :: T.Context
  -> IO ()

spawn
  :: (Socket, SockAddr)
  -> T.Credentials
  -> IO ()

loop
  :: Socket
  -> Either String T.Credential
  -> IO ()

server
  :: IO ()

main
  :: IO ()

--------------------------------------------------------------------------------

main =
  server

--------------------------------------------------------------------------------

tlsPort =
  getArgs >>= pure . fromMaybe 8443 . listToMaybe . (map read) 

recv ctx =
  try $ T.recvData ctx

send ctx bs =
  try $ T.sendData ctx $ L8.fromChunks $ bs

pong ctx =
  do
    res <- recv ctx
    case Right "ping" == res of
      False -> T.contextClose ctx
      True  ->
        do
          req <- send ctx $ [ "pong" ]
          case Right () == req of
            False -> T.contextClose ctx
            True  -> pong ctx

spawn (sock, _) creds =
  do
    ctx <- T.contextNew sock $ para creds
    ___ <- T.handshake  ctx
    pong ctx
  where
    para x509 =
      def
      { T.serverWantClientCert = False
      , T.serverShared         = shared
      , T.serverSupported      = supported
      }
      where
        shared =
          def
          { T.sharedCredentials = x509
          }
        supported =
          def
          { T.supportedVersions = [ T.TLS12 ]
          , T.supportedCiphers  = ciphers
          }
        ciphers =
          [ TE.cipher_AES128_SHA1
          , TE.cipher_AES256_SHA1
          , TE.cipher_RC4_128_MD5
          , TE.cipher_RC4_128_SHA1
          ]

loop sock (Right creds) =
  do
    conn <- accept $ sock
    putStrLn $ ("Connected to: " ++) $ show $ snd $ conn
    ____ <- forkIO $ spawn conn $ T.Credentials [creds]
    loop sock $ Right creds
loop ____ (Left msg) =
  putStrLn $ msg 

server =
  do
    port <- tlsPort
    x509 <- T.credentialLoadX509 "../tls/localhost.crt" "../tls/localhost.key"

    sock <- socket AF_INET Stream 0
    ____ <- setSocketOption sock ReuseAddr 1
    ____ <- bind sock $ SockAddrInet port iNADDR_ANY
    ____ <- listen sock 256

    putStrLn $ "Listening on port " ++ show port

    loop sock x509

tls/00_generate_rca.bash

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#!/bin/bash

clear

# Clean before
find . -name 'root.ca.key' -delete
find . -name 'root.ca.crt' -delete

# Create Root CA

## Create Root Key

openssl \
    genrsa \
    -out \
    root.ca.key \
    2048
#    -des3 \ If you want a non password protected key just remove the -des3

## Create and self-sign the Root Certificate

openssl \
    req \
    -x509 \
    -new \
    -nodes \
    -key root.ca.key \
    -sha256 \
    -days 1024 \
    -out root.ca.crt \
    -config example.conf

## Reference
# - https://gist.github.com/fntlnz/cf14feb5a46b2eda428e000157447309

tls/01_generate_crt.bash

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#!/bin/bash

clear

# Clean before
find . -name 'localhost.key' -delete
find . -name 'localhost.csr' -delete
find . -name 'localhost.crt' -delete

# Create a certificate (Done for each server)

## Create the certificate key

openssl \
    genrsa \
    -out localhost.key \
    2048

## Create the signing request

openssl \
    req \
    -new \
    -key localhost.key \
    -out localhost.csr \
    -config example.conf

## Generate the certificate using the mydomain csr and key along with the CA
## Root key

openssl \
    x509 \
    -req \
    -in localhost.csr \
    -CA root.ca.crt \
    -CAkey root.ca.key \
    -CAcreateserial \
    -out localhost.crt \
    -days 500 \
    -sha256

## References
# - https://gist.github.com/fntlnz/cf14feb5a46b2eda428e000157447309

tls/example.conf

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
[req]
default_bits = 2048
prompt = no
default_md = sha256
req_extensions = req_ext
distinguished_name = dn
[dn]
C  = DK
ST = Copenhagen
L  = Valby
O  = SPISE MISU ApS
OU = Test
CN = localhost
emailAddress = johndoe@localhost
[req_ext]
subjectAltName = @alt_names
[alt_names]
DNS.1 = localhost

## Reference
# - https://gist.github.com/fntlnz/cf14feb5a46b2eda428e000157447309

stack.yaml

1
2
3
4
resolver: lts-11.7

## Reference
# - https://www.stackage.org/lts-11.7

package.yaml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
ghc-options:
## - GHC 8.2.2 Users Guide > 7. Using GHC > 7.2. Warnings and sanity-checking
##   * Base: https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/
##   * File: using-warnings.html#ghc-flag--Wall
## Warnings that are not enabled by -Wall:
- -Wall
- -Wincomplete-uni-patterns
- -Wincomplete-record-updates
- -Wmonomorphism-restriction
#- -Wimplicit-prelude
- -Wmissing-local-signatures
- -Wmissing-exported-signatures
#- -Wmissing-import-lists
- -Wmissing-home-modules
- -Widentities
- -Wredundant-constraints
## Allow instances to be created in other files (like in C .h/.c files)
- -Wno-orphans
## Makes any warning into a fatal error.
- -Werror

executables:
  client:
    dependencies:
      ## Date and time stamps
      - time
      ## x509 certificates, storage and validation
      - x509
      - x509-store
      - x509-validation
    main:
      src/Client.hs
    ghc-options:
      - -O2
  server:
    main:
      src/Server.hs
    ghc-options:
      - -O2
      - -threaded
      - -rtsopts
      - -with-rtsopts=-N
      # The -N flag built-in can be modified on runtime based on the system
      # hosting the binary for optimal performance:
      # hackage.haskell.org/package/base-4.11.1.0/docs/GHC-Conc.html
      # - getNumProcessors
      # hackage.haskell.org/package/base-4.11.1.0/docs/Control-Concurrent.html
      # - setNumCapabilities

# Stacks LTS resolver will ensure specific packages for deterministic builds
dependencies:
- base
## Byte strings
- bytestring
## Netork (sockets)
- network
## TLS/SSL protocol native implementation (Server and Client)
- data-default-class
- tls

build.bash

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/bin/bash

clear

# clear previous bin file
find ./bin -name 'server' -delete
find ./bin -name 'client' -delete

# local (static) compilation with stack 
stack install --local-bin-path ./bin

# clear .cabal file
find . -name '*.cabal' -delete

many.clients.tls.bash

1
2
3
4
5
6
7
8
9
10
#!/bin/bash

clear

cd bin

for i in $(seq -f "%05g" 1 64); do
    echo "Spawned client ID:" $i
    ./client > "../log/$i.txt" &
done

Output:

TLS

user@personal:~/.../tls-ping-pong/tls ./00_generate_rca.bash 
Generating RSA private key, 2048 bit long modulus
...+++
............+++
e is 65537 (0x010001)
user@personal:~/.../tls-ping-pong/tls$ ll root.ca.*
-rw-r--r-- 1 user user 1.3K Jul  7 17:45 root.ca.crt
-rw------- 1 user user 1.7K Jul  7 17:45 root.ca.key
user@personal:~/.../tls-ping-pong/tls ./01_generate_crt.bash
Generating RSA private key, 2048 bit long modulus
.......................................+++
.........................................+++
e is 65537 (0x010001)
Signature ok
subject=C  = DK, ST = Copenhagen, L = Valby, O = SPISE MISU ApS, OU = Test,
        CN = localhost, emailAddress = johndoe@localhost
Getting CA Private Key
user@personal:~/.../tls-ping-pong/tls$ ll localhost.*
-rw-r--r-- 1 user user 1.3K Jul  7 17:46 localhost.crt
-rw-r--r-- 1 user user 1.1K Jul  7 17:46 localhost.csr
-rw------- 1 user user 1.7K Jul  7 17:46 localhost.key

Server

user@personal:~/.../tls-ping-pong/bin$ ./server 
Listening on port 8443
Connected to: 127.0.0.1:42818
Connected to: 127.0.0.1:42820
Connected to: 127.0.0.1:42822
Connected to: 127.0.0.1:42824
Connected to: 127.0.0.1:42826
Connected to: 127.0.0.1:42828
Connected to: 127.0.0.1:42830
Connected to: 127.0.0.1:42832
Connected to: 127.0.0.1:42834
Connected to: 127.0.0.1:42836
Connected to: 127.0.0.1:42838
Connected to: 127.0.0.1:42840
Connected to: 127.0.0.1:42842
Connected to: 127.0.0.1:42844
Connected to: 127.0.0.1:42846
Connected to: 127.0.0.1:42848
Connected to: 127.0.0.1:42850
Connected to: 127.0.0.1:42852
Connected to: 127.0.0.1:42854
Connected to: 127.0.0.1:42856
Connected to: 127.0.0.1:42858
Connected to: 127.0.0.1:42860
Connected to: 127.0.0.1:42862
Connected to: 127.0.0.1:42864
Connected to: 127.0.0.1:42866
Connected to: 127.0.0.1:42868
Connected to: 127.0.0.1:42870
Connected to: 127.0.0.1:42872
Connected to: 127.0.0.1:42874
Connected to: 127.0.0.1:42876
Connected to: 127.0.0.1:42878
Connected to: 127.0.0.1:42880
Connected to: 127.0.0.1:42882
Connected to: 127.0.0.1:42884
Connected to: 127.0.0.1:42886
Connected to: 127.0.0.1:42888
Connected to: 127.0.0.1:42890
Connected to: 127.0.0.1:42892
Connected to: 127.0.0.1:42894
Connected to: 127.0.0.1:42896
Connected to: 127.0.0.1:42898
Connected to: 127.0.0.1:42900
Connected to: 127.0.0.1:42902
Connected to: 127.0.0.1:42904
Connected to: 127.0.0.1:42906
Connected to: 127.0.0.1:42908
Connected to: 127.0.0.1:42910
Connected to: 127.0.0.1:42912
Connected to: 127.0.0.1:42914
Connected to: 127.0.0.1:42916
Connected to: 127.0.0.1:42918
Connected to: 127.0.0.1:42920
Connected to: 127.0.0.1:42922
Connected to: 127.0.0.1:42924
Connected to: 127.0.0.1:42926
Connected to: 127.0.0.1:42928
Connected to: 127.0.0.1:42930
Connected to: 127.0.0.1:42932
Connected to: 127.0.0.1:42934
Connected to: 127.0.0.1:42936
Connected to: 127.0.0.1:42938
Connected to: 127.0.0.1:42940
Connected to: 127.0.0.1:42942
Connected to: 127.0.0.1:42944
^C
user@personal:~/.../tls-ping-pong/bin$

Client

user@personal:~/.../tls-ping-pong$ ./many.clients.tls.bash 
Spawned client ID: 00001
Spawned client ID: 00002
Spawned client ID: 00003
Spawned client ID: 00004
Spawned client ID: 00005
Spawned client ID: 00006
Spawned client ID: 00007
Spawned client ID: 00008
Spawned client ID: 00009
Spawned client ID: 00010
Spawned client ID: 00011
Spawned client ID: 00012
Spawned client ID: 00013
Spawned client ID: 00014
Spawned client ID: 00015
Spawned client ID: 00016
Spawned client ID: 00017
Spawned client ID: 00018
Spawned client ID: 00019
Spawned client ID: 00020
Spawned client ID: 00021
Spawned client ID: 00022
Spawned client ID: 00023
Spawned client ID: 00024
Spawned client ID: 00025
Spawned client ID: 00026
Spawned client ID: 00027
Spawned client ID: 00028
Spawned client ID: 00029
Spawned client ID: 00030
Spawned client ID: 00031
Spawned client ID: 00032
Spawned client ID: 00033
Spawned client ID: 00034
Spawned client ID: 00035
Spawned client ID: 00036
Spawned client ID: 00037
Spawned client ID: 00038
Spawned client ID: 00039
Spawned client ID: 00040
Spawned client ID: 00041
Spawned client ID: 00042
Spawned client ID: 00043
Spawned client ID: 00044
Spawned client ID: 00045
Spawned client ID: 00046
Spawned client ID: 00047
Spawned client ID: 00048
Spawned client ID: 00049
Spawned client ID: 00050
Spawned client ID: 00051
Spawned client ID: 00052
Spawned client ID: 00053
Spawned client ID: 00054
Spawned client ID: 00055
Spawned client ID: 00056
Spawned client ID: 00057
Spawned client ID: 00058
Spawned client ID: 00059
Spawned client ID: 00060
Spawned client ID: 00061
Spawned client ID: 00062
Spawned client ID: 00063
Spawned client ID: 00064
user@personal:~/.../tls-ping-pong$

Logs (output after 60 seconds)

user@personal:~/.../tls-ping-pong/log$ du -h --max-depth=1
25M	.
user@personal:~/.../tls-ping-pong/log$

user@personal:~/.../tls-ping-pong/log$ head 00042.txt 
Connected to: localhost
2018-07-07T15:07:01.478783000000Z | Client | Ping
2018-07-07T15:07:01.520860000000Z | Server | Pong
2018-07-07T15:07:01.520983000000Z | Client | Ping
2018-07-07T15:07:01.539070000000Z | Server | Pong
2018-07-07T15:07:01.539179000000Z | Client | Ping
2018-07-07T15:07:01.556006000000Z | Server | Pong
2018-07-07T15:07:01.556097000000Z | Client | Ping
2018-07-07T15:07:01.559951000000Z | Server | Pong
2018-07-07T15:07:01.560046000000Z | Client | Ping
user@personal:~/.../tls-ping-pong/log$ tail 00042.txt 
2018-07-07T15:07:59.994132000000Z | Server | Pong
2018-07-07T15:08:00.000799000000Z | Client | Ping
2018-07-07T15:08:00.000860000000Z | Server | Pong
2018-07-07T15:08:00.021029000000Z | Client | Ping
2018-07-07T15:08:00.021090000000Z | Server | Pong
2018-07-07T15:08:00.034311000000Z | Client | Ping
2018-07-07T15:08:00.035243000000Z | Server | Pong
2018-07-07T15:08:00.047954000000Z | Client | Ping
2018-07-07T15:08:00.057190000000Z | Server | Pong
2018-07-07T15:08:00.057244000000Z | Client | Ping
user@personal:~/tmp/haskell/tls-ping-pong/log$

user@personal:~/.../tls-ping-pong/log$ wc -l *
    8312 00001.txt
    8232 00002.txt
    8278 00003.txt
    8242 00004.txt
    8068 00005.txt
    8176 00006.txt
    8204 00007.txt
    8168 00008.txt
    8146 00009.txt
    8202 00010.txt
    8178 00011.txt
    8116 00012.txt
    8230 00013.txt
    8140 00014.txt
    8054 00015.txt
    8128 00016.txt
    7974 00017.txt
    8084 00018.txt
    8100 00019.txt
    8046 00020.txt
    8146 00021.txt
    8128 00022.txt
    8164 00023.txt
    8044 00024.txt
    7976 00025.txt
    8012 00026.txt
    8112 00027.txt
    8036 00028.txt
    7914 00029.txt
    7994 00030.txt
    8062 00031.txt
    7962 00032.txt
    8154 00033.txt
    8032 00034.txt
    7980 00035.txt
    8024 00036.txt
    7994 00037.txt
    8006 00038.txt
    7782 00039.txt
    7898 00040.txt
    7946 00041.txt
    7914 00042.txt
    7936 00043.txt
    7744 00044.txt
    7838 00045.txt
    7904 00046.txt
    7820 00047.txt
    7728 00048.txt
    7842 00049.txt
    7868 00050.txt
    7818 00051.txt
    7812 00052.txt
    7770 00053.txt
    7830 00054.txt
    7728 00055.txt
    7908 00056.txt
    7714 00057.txt
    7600 00058.txt
    7764 00059.txt
    7798 00060.txt
    7626 00061.txt
    7586 00062.txt
    7746 00063.txt
    7642 00064.txt
  510380 total
user@personal:~/.../tls-ping-pong/log$

References:

Hackage:

Blog: Mr. Mathiesen

Haskell - TLS ping-pong multi- client and server

Files

Code Snippets

src/Client.hs

src/Server.hs

tls/00_generate_rca.bash

tls/01_generate_crt.bash

tls/example.conf

stack.yaml

package.yaml

build.bash

many.clients.tls.bash

Output:

TLS

Server

Client

Logs (output after 60 seconds)

References: