Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-platform
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
15
Issues
15
List
Boards
Labels
Service Desk
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-platform
Compare Revisions
master...ssl
Source
ssl
Select Git revision
...
Target
master
Select Git revision
Compare
Commits (1)
Add Crypto.SSL
· 1087dcc7
Camil Staps
authored
Mar 11, 2017
1087dcc7
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
426 additions
and
2 deletions
+426
-2
src/cdeps/Makefile
src/cdeps/Makefile
+1
-1
src/cdeps/cryptossl.c
src/cdeps/cryptossl.c
+20
-0
src/libraries/OS-Independent/Crypto/SSL.dcl
src/libraries/OS-Independent/Crypto/SSL.dcl
+10
-0
src/libraries/OS-Independent/Crypto/SSL.icl
src/libraries/OS-Independent/Crypto/SSL.icl
+285
-0
tests/.gitignore
tests/.gitignore
+1
-0
tests/common/Makefile
tests/common/Makefile
+1
-1
tests/common/ssltest.icl
tests/common/ssltest.icl
+107
-0
tests/imports_common.icl
tests/imports_common.icl
+1
-0
No files found.
src/cdeps/Makefile
View file @
1087dcc7
CC
=
gcc
OBJS
:=
bsearch.o systemsignal.o systemprocess.o WCsubst.o
OBJS
:=
bsearch.o
cryptossl.o
systemsignal.o systemprocess.o WCsubst.o
all
:
$(OBJS)
...
...
src/cdeps/cryptossl.c
0 → 100644
View file @
1087dcc7
#include <openssl/ssl.h>
#include <openssl/ocsp.h>
int
SSL_CTX_set_verify_help
(
SSL_CTX
*
ctx
,
int
mode
)
{
SSL_CTX_set_verify
(
ctx
,
mode
,
NULL
);
return
1
;
}
int
X509_VERIFY_PARAM_set_hostflags_help
(
X509_VERIFY_PARAM
*
param
,
unsigned
int
flags
)
{
X509_VERIFY_PARAM_set_hostflags
(
param
,
flags
);
return
1
;
}
int
SSL_CTX_set_verify_depth_help
(
SSL_CTX
*
ctx
,
int
depth
)
{
SSL_CTX_set_verify_depth
(
ctx
,
depth
);
return
1
;
}
src/libraries/OS-Independent/Crypto/SSL.dcl
0 → 100644
View file @
1087dcc7
definition
module
Crypto
.
SSL
from
Data
.
Error
import
::
MaybeError
from
System
.
_Pointer
import
::
Pointer
::
SSLContext
(:==
Pointer
)
initSSL
::
!
String
!
Int
!*
World
->
*(!
MaybeError
String
SSLContext
,
!*
World
)
writeSSL
::
!
String
!
SSLContext
!*
World
->
(!
MaybeError
String
(),
*
World
)
readAllSSL
::
!
SSLContext
!*
World
->
*(!
MaybeError
String
String
,
!*
World
)
src/libraries/OS-Independent/Crypto/SSL.icl
0 → 100644
View file @
1087dcc7
implementation
module
Crypto
.
SSL
import
StdEnv
import
Data
.
Error
import
Data
.
Func
import
System
.
FilePath
import
System
.
_Pointer
import
code
from
"cryptossl."
// Linux / mac:
import
code
from
library
"-lcrypto"
import
code
from
library
"-lssl"
::
SSLContext
:==
Pointer
::
SSLMethod
:==
Pointer
::
SSLOption
:==
Int
::
SSLCTX
:==
Pointer
::
BIO
:==
Pointer
// See: https://wiki.openssl.org/index.php/SSL/TLS_Client
initSSL
::
!
String
!
Int
!*
World
->
*(!
MaybeError
String
SSLContext
,
!*
World
)
initSSL
host
port
w
#!
(_,
w
)
=
OPENSSL_init_ssl
0
0
w
#!
(
meth
,
w
)
=
TLS_method
w
|
meth
==
0
=
(
Error
"TLS_method failed"
,
w
)
#!
(
ctx
,
w
)
=
SSL_CTX_new
meth
w
|
ctx
==
0
=
(
Error
"SSL_CTX_new failed"
,
w
)
#!
(
prm
,
w
)
=
SSL_CTX_get0_param
ctx
w
#!
(_,
w
)
=
X509_VERIFY_PARAM_set_hostflags
prm
X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS
w
#!
w
=
X509_VERIFY_PARAM_set1_host
prm
host
w
#!
w
=
SSL_CTX_set_verify
ctx
SSL_VERIFY_PEER
w
#!
(_,
w
)
=
SSL_CTX_set_verify_depth
ctx
4
w
// NB: the below would enable CRL checking. However, we would still need a
// way to actually fetch CRLs, and ideally cache them. Because this is
// currently not implemented, CRL checking is disabled.
//#! (prm,w) = X509_VERIFY_PARAM_new w
//#! (_,w) = X509_VERIFY_PARAM_set_flags prm X509_V_FLAG_CRL_CHECK w
//#! (str,w) = SSL_CTX_get_cert_store ctx w
//#! (_,w) = X509_STORE_set1_param str prm w
// TODO: eventually, we might enable certificate transparency checking here.
// However, this requires OpenSSL to be bundled with ct_log_list.cnf, which it is currently not in
// major linux distributions. For this reason the check is currently disabled. For details, see:
// https://www.certificate-transparency.org/certificate-transparency-in-openssl
//#! (res,w) = SSL_CTX_enable_ct ctx SSL_CT_VALIDATION_STRICT w
//| res <> 1 = (Error "SSL_CTX_enable_ct failed", w)
#!
w
=
SSL_CTX_set_options
ctx
[
SSL_OP_NO_SSLv2
,
SSL_OP_NO_SSLv3
,
SSL_OP_NO_COMPRESSION
]
w
#!
(
res
,
w
)
=
SSL_CTX_load_verify_locations_file
ctx
"/etc/ssl/certs/ca-certificates.crt"
w
|
res
<>
1
=
(
Error
"SSL_CTX_load_verify_locations_file failed"
,
w
)
#!
(
web
,
w
)
=
BIO_new_ssl_connect
ctx
w
|
web
==
0
=
(
Error
"BIO_new_ssl_connect failed"
,
w
)
#!
(
res
,
w
)
=
BIO_set_conn_hostname
web
host
port
w
|
res
<>
1
=
(
Error
"BIO_set_conn_hostname failed"
,
w
)
#!
(
ssl
,
w
)
=
BIO_get_ssl
web
w
|
ssl
==
0
=
(
Error
"BIO_get_ssl failed"
,
w
)
#!
(
res
,
w
)
=
SSL_set_cipher_list
ssl
"HIGH:!aNULL:!kRSA:!PSK:!SRP:!MD5:!RC4:!SHA1:!SHA256:!SHA384:!DH"
w
|
res
<>
1
=
(
Error
"SSL_set_cipher_list failed"
,
w
)
#!
(
res
,
w
)
=
SSL_set_tlsext_host_name
ssl
host
w
|
res
<>
1
=
(
Error
"SSL_set_tlsext_host_name failed"
,
w
)
#!
(
res
,
w
)
=
BIO_do_connect
web
w
|
res
<>
1
=
(
Error
"BIO_do_connect failed"
,
w
)
#!
(
res
,
w
)
=
BIO_do_handshake
web
w
|
res
<>
1
=
(
Error
"BIO_do_handshake failed"
,
w
)
|
otherwise
=
(
Ok
web
,
w
)
where
OPENSSL_init_ssl
::
!
Int
!
Pointer
!*
World
->
*(!
Int
,
!*
World
)
OPENSSL_init_ssl
_
_
w
=
code {
ccall
OPENSSL_init_ssl
"Ip:I:A"
}
writeSSL
::
!
String
!
SSLContext
!*
World
->
(!
MaybeError
String
(),
*
World
)
writeSSL
data
ctx
w
#
(
res
,
w
)
=
BIO_puts
ctx
data
w
|
res
==
size
data
=
(
Ok
(),
w
)
|
res
<
0
=
(
Error
"writeSSL: an error occurred"
,
w
)
|
res
==
0
=
(
Error
"writeSSL: could not write data"
,
w
)
=
(
Error
(
"writeSSL: only "
+++
toString
res
+++
" bytes could be written"
),
w
)
read_buffer
::
String
read_buffer
=:
createArray
READ_SIZE
'\0'
READ_SIZE
=
1536
readAllSSL
::
!
SSLContext
!*
World
->
*(!
MaybeError
String
String
,
!*
World
)
readAllSSL
bio
w
#!
read_buffer
=
array_ptr
read_buffer
+
IF_INT_64_OR_32
24
12
#!
(
n
,
w
)
=
BIO_read
bio
read_buffer
READ_SIZE
w
#!
(
r
,
w
)
=
BIO_test_flags
bio
BIO_FLAGS_SHOULD_RETRY
w
#!
(
s
,
w
)
=
(
derefString
read_buffer
,
w
)
#!
s
=
s
%
(
0
,
n
-1
)
|
n
<
0
|
r
==
0
=
(
Error
"readAllSSL: BIO_read failed"
,
w
)
|
otherwise
=
readAllSSL
bio
w
|
n
==
0
=
(
Ok
s
,
w
)
#!
(
rest
,
w
)
=
readAllSSL
bio
w
|
isError
rest
=
(
rest
,
w
)
=
(
Ok
(
s
+++
fromOk
rest
),
w
)
// TODO: remove concatenation
where
array_ptr
::
!
String
->
Pointer
array_ptr
_
=
code {
push_a_b
0
pop_a
1
}
TLS_method
::
!*
World
->
*(!
SSLMethod
,
!*
World
)
TLS_method
w
=
code {
ccall
TLS_method
":p:A"
}
SSL_CTX_new
::
!
SSLMethod
!*
World
->
*(!
SSLCTX
,
!*
World
)
SSL_CTX_new
m
w
=
code {
ccall
SSL_CTX_new
"p:p:A"
}
SSL_CTX_get0_param
::
!
SSLCTX
!*
World
->
*(!
Pointer
,
!*
World
)
SSL_CTX_get0_param
ctx
w
=
code {
ccall
SSL_CTX_get0_param
"p:p:A"
}
X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS
:==
0x4
X509_VERIFY_PARAM_set_hostflags
::
!
Pointer
!
Int
!*
World
->
*(!
Int
,
!*
World
)
X509_VERIFY_PARAM_set_hostflags
param
flags
w
=
code {
ccall
X509_VERIFY_PARAM_set_hostflags_help
"pI:I:A"
}
X509_VERIFY_PARAM_set1_host
::
!
Pointer
!
String
!*
World
->
*
World
X509_VERIFY_PARAM_set1_host
param
s
w
=
snd
(
set
param
(
packString
s
)
0
w
)
where
set
::
!
Pointer
!
String
!
Int
!*
World
->
*(!
Int
,
!*
World
)
set
param
s
len
w
=
code {
ccall
X509_VERIFY_PARAM_set1_host
"psI:I:A"
}
SSL_CTX_get_cert_store
::
!
SSLCTX
!*
World
->
*(!
Pointer
,
!*
World
)
SSL_CTX_get_cert_store
ctx
w
=
code {
ccall
SSL_CTX_get_cert_store
"p:p:A"
}
X509_STORE_set1_param
::
!
Pointer
!
Pointer
!*
World
->
*(!
Int
,
!*
World
)
X509_STORE_set1_param
store
param
w
=
code {
ccall
X509_STORE_set1_param
"pp:I:A"
}
X509_VERIFY_PARAM_new
::
!*
World
->
*(!
Pointer
,
!*
World
)
X509_VERIFY_PARAM_new
w
=
code {
ccall
X509_VERIFY_PARAM_new
":p:A"
}
X509_V_FLAG_CRL_CHECK
:==
0x4
X509_VERIFY_PARAM_set_flags
::
!
Pointer
!
Int
!*
World
->
*(!
Int
,
!*
World
)
X509_VERIFY_PARAM_set_flags
param
flags
w
=
code {
ccall
X509_VERIFY_PARAM_set_flags
"pI:I:A"
}
SSL_VERIFY_PEER
:==
0x01
SSL_CTX_set_verify
::
!
SSLCTX
!
Int
!*
World
->
*
World
SSL_CTX_set_verify
ctx
mode
w
=
snd
(
set_verify
ctx
mode
w
)
where
set_verify
::
!
SSLCTX
!
Int
/*!Pointer*/
!*
World
->
*(!
Int
,
!*
World
)
set_verify
ctx
mode
/*callback*/
w
=
code {
ccall
SSL_CTX_set_verify_help
"pI:I:A"
}
SSL_CTX_set_verify_depth
::
!
SSLCTX
!
Int
!*
World
->
*(!
Int
,
!*
World
)
SSL_CTX_set_verify_depth
ctx
depth
w
=
code {
ccall
SSL_CTX_set_verify_depth_help
"pI:I:A"
}
SSL_CTX_load_verify_locations_file
::
!
SSLCTX
!
FilePath
!*
World
->
*(!
Int
,
!*
World
)
SSL_CTX_load_verify_locations_file
ctx
file
w
=
load_verify_locations
ctx
(
packString
file
)
0
w
where
load_verify_locations
::
!
SSLCTX
!
String
!
Pointer
!*
World
->
*(!
Int
,
!*
World
)
load_verify_locations
ctx
file
dir
w
=
code {
ccall
SSL_CTX_load_verify_locations
"psp:I:A"
}
SSL_CT_VALIDATION_STRICT
:==
1
SSL_CTX_enable_ct
::
!
SSLCTX
!
Int
!*
World
->
*(!
Int
,
!*
World
)
SSL_CTX_enable_ct
ctx
setting
w
=
code {
ccall
SSL_CTX_enable_ct
"pI:I:A"
}
SSL_OP_NO_COMPRESSION
:==
0x00020000
SSL_OP_NO_SSLv2
:==
0x01000000
SSL_OP_NO_SSLv3
:==
0x02000000
SSL_CTX_set_options
::
!
SSLCTX
[
SSLOption
]
*
World
->
*
World
SSL_CTX_set_options
ctx
opts
w
=
snd
$
SSL_CTX_ctrl
ctx
SSL_CTRL_OPTIONS
(
foldr
(
bitor
)
0
opts
)
0
w
SSL_CTRL_OPTIONS
:==
32
SSL_CTX_ctrl
::
!
SSLCTX
!
Int
!
Int
!
Pointer
!*
World
->
*(!
Int
,
!*
World
)
SSL_CTX_ctrl
ctx
cmd
larg
parg
w
=
code {
ccall
SSL_CTX_ctrl
"pIpp:p:A"
}
SSL_set_cipher_list
::
!
Pointer
!
String
!*
World
->
*(!
Int
,
!*
World
)
SSL_set_cipher_list
ssl
list
w
=
set_cipher_list
ssl
(
packString
list
)
w
where
set_cipher_list
::
!
Pointer
!
String
!*
World
->
*(!
Int
,
!*
World
)
set_cipher_list
ssl
list
w
=
code {
ccall
SSL_set_cipher_list
"ps:I:A"
}
SSL_set_tlsext_host_name
::
!
Pointer
!
String
!*
World
->
*(!
Int
,
!*
World
)
SSL_set_tlsext_host_name
ssl
host
w
=
SSL_ctrl_string
ssl
SSL_CTRL_SET_TLSEXT_HOSTNAME
TLSEXT_NAMETYPE_host_name
host
w
where
TLSEXT_NAMETYPE_host_name
=
0
SSL_CTRL_SET_TLSEXT_HOSTNAME
:==
55
SSL_ctrl_string
::
!
Pointer
!
Int
!
Int
!
String
!*
World
->
*(!
Int
,
!*
World
)
SSL_ctrl_string
ssl
cmd
larg
parg
w
=
call
ssl
cmd
/*(size parg)*/
larg
(
packString
parg
)
w
where
call
::
!
Pointer
!
Int
!
Int
!
String
!*
World
->
*(!
Int
,
!*
World
)
call
ssl
cmd
larg
parg
w
=
code {
ccall
SSL_ctrl
"pIps:p:A"
}
BIO_new_ssl_connect
::
!
SSLCTX
!*
World
->
*(!
BIO
,
*
World
)
BIO_new_ssl_connect
ctx
w
=
code {
ccall
BIO_new_ssl_connect
"p:p:A"
}
BIO_set_conn_hostname
::
!
BIO
!
String
!
Int
!*
World
->
*(!
Int
,
!*
World
)
BIO_set_conn_hostname
bio
host
port
w
=
BIO_ctrl_string
bio
BIO_C_SET_CONNECT
0
(
host
+++
":"
+++
toString
port
)
w
BIO_C_GET_SSL
:==
110
BIO_get_ssl
::
!
BIO
!*
World
->
*(!
Pointer
,
!*
World
)
BIO_get_ssl
bio
w
=
ctrl
bio
BIO_C_GET_SSL
0
w
where
ctrl
::
!
BIO
!
Int
!
Int
!*
World
->
*(!
Pointer
,
!*
World
)
ctrl
bio
cmd
arg
w
=
code {
ccall
BIO_ctrl
"pIp:Vp:A"
}
BIO_do_connect
:==
BIO_do_handshake
BIO_do_handshake
::
!
BIO
!*
World
->
*(!
Int
,
!*
World
)
BIO_do_handshake
bio
w
=
BIO_ctrl_ptr
bio
BIO_C_DO_STATE_MACHINE
0
0
w
BIO_C_DO_STATE_MACHINE
:==
101
BIO_ctrl_ptr
::
!
BIO
!
Int
!
Int
!
Pointer
!*
World
->
*(!
Int
,
!*
World
)
BIO_ctrl_ptr
bio
cmd
larg
parg
w
=
code {
ccall
BIO_ctrl
"pIpp:p:A"
}
BIO_C_SET_CONNECT
:==
100
BIO_ctrl_string
::
!
BIO
!
Int
!
Int
!
String
!*
World
->
*(!
Int
,
!*
World
)
BIO_ctrl_string
bio
cmd
larg
parg
w
=
call
bio
cmd
larg
(
packString
parg
)
w
where
call
::
!
BIO
!
Int
!
Int
!
String
!*
World
->
*(!
Int
,
!*
World
)
call
bio
cmd
larg
parg
w
=
code {
ccall
BIO_ctrl
"pIps:p:A"
}
BIO_puts
::
!
BIO
!
String
!*
World
->
(!
Int
,
!*
World
)
BIO_puts
bio
s
w
=
puts
bio
(
packString
s
)
w
where
puts
::
!
BIO
!
String
!*
World
->
*(!
Int
,
!*
World
)
puts
bio
s
w
=
code {
ccall
BIO_puts
"ps:I:A"
}
BIO_read
::
!
BIO
!
Pointer
!
Int
!*
World
->
*(!
Int
,
!*
World
)
BIO_read
bio
p
n
w
=
code {
ccall
BIO_read
"ppI:I:A"
}
BIO_FLAGS_SHOULD_RETRY
:==
0x08
BIO_test_flags
::
!
BIO
!
Int
!*
World
->
*(!
Int
,
!*
World
)
BIO_test_flags
bio
f
w
=
code {
ccall
BIO_test_flags
"pI:I:A"
}
tests/.gitignore
View file @
1087dcc7
common/commentstest
common/gentest
common/snappytest
common/ssltest
common/systemprocesstest
common/tartest
...
...
tests/common/Makefile
View file @
1087dcc7
...
...
@@ -26,7 +26,7 @@ COCLLIBS:=\
-I
$(COCLPATH)
/main
\
-I
$(COCLPATH)
/main/Unix
BINARIES
:=
commentstest gentest snappytest systemprocesstest tartest
BINARIES
:=
commentstest gentest snappytest s
sltest s
ystemprocesstest tartest
RUN_BINARIES
:=
$(
addprefix
run_,
$(BINARIES)
)
all
:
$(RUN_BINARIES)
...
...
tests/common/ssltest.icl
0 → 100644
View file @
1087dcc7
module
ssltest
import
StdEnv
import
StdMaybe
import
Crypto
.
SSL
import
Data
.
Error
import
Data
.
Func
import
Internet
.
HTTP
import
System
.
CommandLine
Start
w
=
seqSt
(\(
host
,
port
,
expected
)
w
#
(_,
w
)
=
fclose
(
stderr
<<<
host
<<<
"... "
)
w
#
(
mbErr
,
w
)
=
test
host
port
expected
w
|
isError
mbErr
->
setReturnCode
1
(
snd
(
fclose
(
stderr
<<<
fromError
mbErr
<<<
"
\n
"
)
w
))
->
snd
(
fclose
(
stderr
<<<
"ok.
\n
"
)
w
))
tests
w
where
// See https://badssl.com/dashboard/
tests
=
[
(
"badssl.com"
,
443
,
Ok
200
)
// Certificate validation (high risk)
,
(
"expired.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"wrong.host.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"self-signed.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"untrusted-root.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
// Interception certificates (high risk)
,
(
"superfish.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"edellroot.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"dsdtestprovider.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"preact-cli.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"webpack-dev-server.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
// Broken cryptography (medium risk)
,
(
"sha1-intermediate.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"rc4.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"rc4-md5.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"dh480.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"dh512.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"dh1024.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"null.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
// Legacy cryptography (moderate risk)
,
(
"tls-v1-0.badssl.com"
,
1010
,
Error
"BIO_do_connect failed"
)
,
(
"tls-v1-1.badssl.com"
,
1011
,
Error
"BIO_do_connect failed"
)
,
(
"cbc.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"3des.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
,
(
"dh2048.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
// Domain security policies
// , ("revoked.badssl.com", 443, Error "BIO_do_connect failed") // Revocation is not checked; see initSSL for explanation
// , ("pinning-test.badssl.com", 443, Error "BIO_do_connect failed") // TODO: this test fails for unknown reasons
,
(
"invalid-expected-sct.badssl.com"
,
443
,
Error
"BIO_do_connect failed"
)
// , ("no-sct.badssl.com", 443, Error "BIO_do_connect failed") // Certificate transparency is not enabled yet; see initSSL for explanation
// Secure (uncommon)
,
(
"1000-sans.badssl.com"
,
443
,
Ok
200
)
// , ("10000-sans.badssl.com", 443, Ok 200) // not supported but uncommon, don't care
,
(
"sha384.badssl.com"
,
443
,
Ok
200
)
,
(
"sha512.badssl.com"
,
443
,
Ok
200
)
,
(
"rsa8192.badssl.com"
,
443
,
Ok
200
)
// , ("no-subject.badssl.com", 443, Ok 200) // not supported but uncommon, don't care
// , ("no-common-name.badssl.com", 443, Ok 200) // not supported but uncommon, don't care
// , ("incomplete-chain.badssl.com", 443, Ok 200) // not supported but uncommon, don't care
// Secure (common)
,
(
"tls-v1-2.badssl.com"
,
1012
,
Ok
200
)
,
(
"sha256.badssl.com"
,
443
,
Ok
200
)
,
(
"rsa2048.badssl.com"
,
443
,
Ok
200
)
,
(
"ecc256.badssl.com"
,
443
,
Ok
200
)
,
(
"ecc384.badssl.com"
,
443
,
Ok
200
)
,
(
"extended-validation.badssl.com"
,
443
,
Ok
200
)
,
(
"mozilla-modern.badssl.com"
,
443
,
Ok
200
)
]
test
::
!
String
!
Int
!(
MaybeError
String
Int
)
!*
World
->
(!
MaybeError
String
(),
!*
World
)
test
host
port
expected
w
#!
(
mbCtx
,
w
)
=
initSSL
host
port
w
|
isError
mbCtx
=
(
check
mbCtx
,
w
)
#!
ctx
=
fromOk
mbCtx
#!
(
mbErr
,
w
)
=
writeSSL
(
toString
req
)
ctx
w
|
isError
mbErr
=
(
check
mbErr
,
w
)
#!
(
mbResp
,
w
)
=
readAllSSL
ctx
w
|
isError
mbResp
=
(
check
mbResp
,
w
)
#!
mbResp
=
parseResponse
(
fromOk
mbResp
)
|
isNone
mbResp
=
(
Error
"failed to parse HTTP response"
,
w
)
|
isError
expected
=
(
Error
(
"missed error: "
+++
fromError
expected
),
w
)
#!
{
HTTPResponse
|
rsp_code
}
=
fromJust
mbResp
|
rsp_code
<>
fromOk
expected
=
(
Error
(
"unexpected HTTP status code "
+++
toString
rsp_code
+++
"; expected "
+++
toString
(
fromOk
expected
)),
w
)
=
(
Ok
(),
w
)
where
req
=
{
newHTTPRequest
&
req_path
=
"/"
,
server_name
=
host
,
server_port
=
port
}
check
(
Error
e
)
=
case
expected
of
Ok
_
->
Error
(
"unexpected error: "
+++
e
)
Error
exp
|
e
==
exp
->
Ok
()
|
otherwise
->
Error
(
"unexpected error '"
+++
e
+++
"'; expected '"
+++
exp
+++
"'"
)
tests/imports_common.icl
View file @
1087dcc7
...
...
@@ -69,6 +69,7 @@ import qualified Control.Monad.Trans
import
qualified
Control
.
Monad
.
Writer
import
qualified
Crypto
.
Hash
.
MD5
import
qualified
Crypto
.
Hash
.
SHA1
import
qualified
Crypto
.
SSL
import
qualified
Data
.
Array
import
qualified
Data
.
Bifunctor
import
qualified
Data
.
CircularStack
...
...