mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
delete superfluous builtin-tests/*.u
files
This commit is contained in:
parent
f5d187ef84
commit
4289192d36
@ -1,107 +0,0 @@
|
||||
checkBytesII src larr rarr i =
|
||||
l = data.ByteArray.Raw.read8 larr i
|
||||
r = data.ByteArray.Raw.read8 rarr i
|
||||
if l == r
|
||||
then if i > 0 then checkBytesII src larr rarr (l-1) else pass src
|
||||
else let
|
||||
tl = Debug.evalToText l
|
||||
tr = Debug.evalToText r
|
||||
fail src ("`" ++ tl ++ "` is not equal to `" ++ tr ++ "`")
|
||||
|
||||
checkBytesMI src marr iarr i =
|
||||
l = mutable.ByteArray.Raw.read8 marr i
|
||||
r = data.ByteArray.Raw.read8 iarr i
|
||||
if l == r
|
||||
then if i > 0 then checkBytesMI src marr iarr (l-1) else pass src
|
||||
else let
|
||||
tl = Debug.evalToText l
|
||||
tr = Debug.evalToText r
|
||||
fail src ("`" ++ tl ++ "` is not equal to `" ++ tr ++ "`")
|
||||
|
||||
checkBytesMM src larr rarr i =
|
||||
l = mutable.ByteArray.Raw.read8 larr i
|
||||
r = mutable.ByteArray.Raw.read8 rarr i
|
||||
if l == r
|
||||
then if i > 0 then checkBytesMM src larr rarr (l-1) else pass src
|
||||
else let
|
||||
tl = Debug.evalToText l
|
||||
tr = Debug.evalToText r
|
||||
fail src ("`" ++ tl ++ "` is not equal to `" ++ tr ++ "`")
|
||||
|
||||
boxarrTests : '{IO,Exception,Tests} ()
|
||||
boxarrTests = do
|
||||
iarr = Scope.run do
|
||||
marr = Scope.Raw.array 1
|
||||
checkEqual "boxed array/msize" (Array.Raw.size marr) 1
|
||||
Array.Raw.write marr 0 "hello"
|
||||
checkEqual "boxed mut read/write" (Array.Raw.read marr 0) "hello"
|
||||
freeze marr 0 1
|
||||
checkEqual "boxed new/size" (Array.Raw.size iarr) 1
|
||||
checkEqual "boxed imm read/write" (Array.Raw.read iarr 0) "hello"
|
||||
|
||||
iarr2 = Scope.run do
|
||||
marr = Scope.Raw.array 1
|
||||
data.Array.Raw.copyTo! marr 0 iarr 0 1
|
||||
checkEqual "immuntable copyTo!" (Raw.read marr 0) "hello"
|
||||
marr2 = Scope.Raw.arrayOf "goodbye" 1
|
||||
mutable.Array.Raw.copyTo! marr2 0 marr 0 1
|
||||
checkEqual "mutable copyTo!" (Raw.read marr 0) "hello"
|
||||
freeze! marr2
|
||||
|
||||
checkEqual "boxed immutable copied" (Raw.read iarr2 0) "hello"
|
||||
|
||||
bs = Value.serialize (Value.value iarr2)
|
||||
match Value.deserialize bs with
|
||||
Left err -> fail "boxed serial" err
|
||||
Right v -> match Value.load v with
|
||||
Left missing -> fail "boxed serial" "missing deps"
|
||||
Right ia -> checkEqual "boxed serial" iarr2 ia
|
||||
|
||||
|
||||
bytearrTests : '{IO,Exception,Tests} ()
|
||||
bytearrTests = do
|
||||
iarr = ByteArray.Raw.new! 32 (marr -> let
|
||||
checkEqual "byte new/msize" (ByteArray.Raw.size marr) 32
|
||||
ByteArray.Raw.write64be marr 0 0xffffffff
|
||||
ByteArray.Raw.write32be marr 8 0xffff
|
||||
ByteArray.Raw.write16be marr 12 0xff
|
||||
ByteArray.Raw.write8 marr 14 0xf
|
||||
n64 = mutable.ByteArray.Raw.read64be marr 0
|
||||
n40 = mutable.ByteArray.Raw.read40be marr 0
|
||||
n32 = mutable.ByteArray.Raw.read32be marr 8
|
||||
n24 = mutable.ByteArray.Raw.read24be marr 8
|
||||
n16 = mutable.ByteArray.Raw.read16be marr 12
|
||||
n8 = mutable.ByteArray.Raw.read8 marr 14
|
||||
checkEqual "byte mut read/write 64" n64 0xffffffff
|
||||
checkEqual "byte mut read/write 40" n40 0xff
|
||||
checkEqual "byte mut read/write 32" n32 0xffff
|
||||
checkEqual "byte mut read/write 24" n24 0xff
|
||||
checkEqual "byte mut read/write 16" n16 0xff
|
||||
checkEqual "byte mut read/write 8" n8 0xf)
|
||||
checkEqual "byte new/size" (ByteArray.Raw.size iarr) 32
|
||||
n64 = data.ByteArray.Raw.read64be iarr 0
|
||||
n40 = data.ByteArray.Raw.read40be iarr 0
|
||||
n32 = data.ByteArray.Raw.read32be iarr 8
|
||||
n24 = data.ByteArray.Raw.read24be iarr 8
|
||||
n16 = data.ByteArray.Raw.read16be iarr 12
|
||||
n8 = data.ByteArray.Raw.read8 iarr 14
|
||||
checkEqual "byte imm read/write 64" n64 0xffffffff
|
||||
checkEqual "byte imm read/write 40" n40 0xff
|
||||
checkEqual "byte imm read/write 32" n32 0xffff
|
||||
checkEqual "byte imm read/write 24" n24 0xff
|
||||
checkEqual "byte imm read/write 16" n16 0xff
|
||||
checkEqual "byte imm read/write 8" n8 0xf
|
||||
|
||||
iarr2 = Scope.run do
|
||||
marr = Scope.Raw.byteArray 32
|
||||
data.ByteArray.Raw.copyTo! marr 0 iarr 0 32
|
||||
checkBytesMI "byte immutable copyTo!" marr iarr 31
|
||||
marr2 = Scope.Raw.byteArray 32
|
||||
mutable.ByteArray.Raw.copyTo! marr2 0 marr 0 32
|
||||
checkBytesMM "byte mutable copyTo!" marr2 marr 31
|
||||
freeze! marr2
|
||||
checkBytesII "byte immutable copied" iarr iarr2 31
|
||||
|
||||
array.tests = do
|
||||
!bytearrTests
|
||||
!boxarrTests
|
@ -1,203 +0,0 @@
|
||||
use base.Text toUtf8
|
||||
|
||||
bytes.tests = do
|
||||
!bytes.lit.tests
|
||||
!bytes.debug.tests
|
||||
!bytes.conversion.tests
|
||||
!bytes.eq.tests
|
||||
!bytes.ord.tests
|
||||
!bytes.ops.tests
|
||||
!bytes.gzip.compress.tests
|
||||
!bytes.gzip.decompress.tests
|
||||
!bytes.zlib.compress.tests
|
||||
!bytes.zlib.decompress.tests
|
||||
!bytes.toFromBases
|
||||
!bytes.decodeNats
|
||||
!bytes.encodeNats
|
||||
|
||||
bytes.lit.tests = do
|
||||
check "Bytes empty literal" do
|
||||
_ = 0xs
|
||||
true
|
||||
check "Bytes literal" do
|
||||
_ = 0xs68656c6c6f
|
||||
true
|
||||
|
||||
bytes.debug.tests = do
|
||||
checkEqual "Debug.evalToText on Bytes" (Debug.evalToText 0xs68656c6c6f) "0xs68656c6c6f"
|
||||
|
||||
bytes.conversion.tests = do
|
||||
use base Bytes.fromList Bytes.toList
|
||||
checkEqual "Bytes.fromList: empty" (Bytes.fromList []) Bytes.empty
|
||||
checkEqual "Bytes.fromList: non empty" (Bytes.fromList [104, 101, 108, 108, 111]) 0xs68656c6c6f
|
||||
check "Bytes.fromList: invalid" do
|
||||
match catch '(Bytes.fromList [104, 500]) with
|
||||
Left _ -> true
|
||||
Right _ -> false
|
||||
|
||||
checkEqual "Bytes.toList: empty" (Bytes.toList Bytes.empty) []
|
||||
checkEqual "Bytes.toList: non empty" (Bytes.toList 0xs68656c6c6f) [104, 101, 108, 108, 111]
|
||||
|
||||
check "fromUtf8: invalid" do
|
||||
match catch '(Text.fromUtf8 0xsfc80808080af) with
|
||||
Left _ -> true
|
||||
Right _ -> false
|
||||
|
||||
checkEqual "fromUtf8" (Text.fromUtf8 0xs68656c6c6f) "hello"
|
||||
checkEqual "toUtf8" (Text.toUtf8 "hello") 0xs68656c6c6f
|
||||
|
||||
loremIpsum = """
|
||||
In Unison, since definitions are identified by a content hash,
|
||||
arbitrary computations can just be moved from one location to
|
||||
another, with missing dependencies deployed on the fly.
|
||||
|
||||
The basic protocol is something like: the sender ships the bytecode
|
||||
tree to the recipient, who inspects the bytecode for any hashes it's
|
||||
missing. If it already has all the hashes, it can run the
|
||||
computation; otherwise, it requests the ones it's missing and the
|
||||
sender syncs them on the fly. They'll be cached for next time.
|
||||
|
||||
Of course, there's a lot of engineering that goes into making this
|
||||
work nicely, but the basic idea is simple and robust.
|
||||
|
||||
This ability to relocate arbitrary computations subsumes the more
|
||||
limited notions of code deployment, remote procedure calls, and more,
|
||||
and lets us build powerful distributed computing components as
|
||||
ordinary Unison libraries.
|
||||
"""
|
||||
checkEqual "ut8 roundTrip" (fromUtf8 (toUtf8 loremIpsum)) loremIpsum
|
||||
|
||||
bytes.eq.tests = do
|
||||
checkEqual "Bytes equality: empty" 0xs 0xs
|
||||
checkEqual "Bytes equality: non empty" 0xs0102 0xs0102
|
||||
check "Bytes inequality: non empty (1)" do 0xs0102 !== 0xs010203
|
||||
check "Bytes inequality: non empty (2)" do 0xs010203 !== 0xs0102
|
||||
check "Bytes inequality: non empty (3)" do 0xs0102 !== 0xs0103
|
||||
check "Bytes inequality: empty" do 0xs0102 !== 0xs
|
||||
checkEqual "Bytes equality: composite" (Some [0xs010203, 0xs040506]) (Some [0xs010203, 0xs040506])
|
||||
check "Bytes inequality: composite" do (Some [0xs010203, 0xs040506]) !== (Some [0xs010203, 0xs68656c6c6f])
|
||||
|
||||
bytes.ord.tests = do
|
||||
checkEqual "Bytes ordering (1)" (Universal.compare 0xs01 0xs) +1
|
||||
checkEqual "Bytes ordering (2)" (Universal.compare 0xs 0xs01) -1
|
||||
checkEqual "Bytes ordering (3)" (Universal.compare 0xs0100 0xs01) +1
|
||||
checkEqual "Bytes ordering (4)" (Universal.compare 0xs02 0xs0102) +1
|
||||
checkEqual "Bytes ordering (5)" (Universal.compare 0xs0103 0xs0102) +1
|
||||
checkEqual "Bytes ordering (6)" (Universal.compare 0xs010203 0xs010203) +0
|
||||
|
||||
|
||||
bytes.ops.tests = do
|
||||
checkEqual "Bytes.flatten" (Bytes.flatten 0xs68656c6c6f) 0xs68656c6c6f
|
||||
|
||||
checkEqual "Bytes.++" (0xs ++ 0xs0102 ++ 0xs0304 ++ 0xs) 0xs01020304
|
||||
|
||||
checkEqual "Bytes.take (1)" (Bytes.take 0 0xs010203) 0xs
|
||||
checkEqual "Bytes.take (2)" (Bytes.take 2 0xs010203) 0xs0102
|
||||
checkEqual "Bytes.take (3)" (Bytes.take 3 0xs010203) 0xs010203
|
||||
checkEqual "Bytes.take (4)" (Bytes.take 100 0xs010203) 0xs010203
|
||||
checkEqual "Bytes.take (5)" (Bytes.take 3 0xs) 0xs
|
||||
|
||||
checkEqual "Bytes.drop (1)" (Bytes.drop 0 0xs010203) 0xs010203
|
||||
checkEqual "Bytes.drop (2)" (Bytes.drop 2 0xs010203) 0xs03
|
||||
checkEqual "Bytes.drop (3)" (Bytes.drop 3 0xs010203) 0xs
|
||||
checkEqual "Bytes.drop (4)" (Bytes.drop 100 0xs010203) 0xs
|
||||
checkEqual "Bytes.drop (5)" (Bytes.drop 3 0xs) 0xs
|
||||
|
||||
checkEqual "Bytes.size (1)" (Bytes.size 0xs) 0
|
||||
checkEqual "Bytes.size (2)" (Bytes.size 0xs010203) 3
|
||||
|
||||
checkEqual "Bytes.at (1)" (Bytes.at 0 0xs010203) (Some 1)
|
||||
checkEqual "Bytes.at (2)" (Bytes.at 2 0xs010203) (Some 3)
|
||||
checkEqual "Bytes.at (3)" (Bytes.at 1 0xs) None
|
||||
checkEqual "Bytes.at (4)" (Bytes.at 5 0xs010203) None
|
||||
|
||||
checkEqual "Bytes.indexOf (1)" (Bytes.indexOf 0xs 0xs0102030304) (Some 0)
|
||||
checkEqual "Bytes.indexOf (2)" (Bytes.indexOf 0xs03 0xs0102030304) (Some 2)
|
||||
checkEqual "Bytes.indexOf (3)" (Bytes.indexOf 0xs0304 0xs0102030304) (Some 3)
|
||||
checkEqual "Bytes.indexOf (3)" (Bytes.indexOf 0xs020304 0xs0102030304) None
|
||||
|
||||
-- Haskell and Racket produce slightly different byte output
|
||||
-- for gzip compress (in the header, racket reports the OS as "unix"
|
||||
-- while Haskell for some reason claims to be Acorn RISCOS),
|
||||
-- so we can't compare gzip.compress to the actual byte output.
|
||||
-- We'll have to settle for testing the round-trip.
|
||||
bytes.gzip.compress.tests = do
|
||||
checkEqual "gzip empty" (gzip.decompress (gzip.compress (toUtf8 ""))) (Right (toUtf8 ""))
|
||||
checkEqual "gzip hello folks" (gzip.decompress (gzip.compress (toUtf8 "hello folks"))) (Right (toUtf8 "hello folks"))
|
||||
|
||||
bytes.gzip.decompress.tests = do
|
||||
checkEqual "gunzip empty" (gzip.decompress 0xs1f8b080000000000001303000000000000000000) (Right (toUtf8 ""))
|
||||
checkEqual "gunzip hello folks" (gzip.decompress 0xs1f8b0800000000000013cb48cdc9c95748cbcfc92e0600cd32e08a0b000000) (Right (toUtf8 "hello folks"))
|
||||
|
||||
bytes.zlib.compress.tests = do
|
||||
checkEqual "zlib empty" (zlib.compress (toUtf8 "")) 0xs789c030000000001
|
||||
checkEqual "zlib hello folks" (zlib.compress (toUtf8 "hello folks")) 0xs789ccb48cdc9c95748cbcfc92e060019b10454
|
||||
|
||||
bytes.zlib.decompress.tests = do
|
||||
checkEqual "zlib inflate empty" (zlib.decompress 0xs789c030000000001) (Right (toUtf8 ""))
|
||||
checkEqual "zlib inflate hello folks" (zlib.decompress 0xs789ccb48cdc9c95748cbcfc92e060019b10454) (Right (toUtf8 "hello folks"))
|
||||
|
||||
checkLeft : Text -> Either a b ->{Tests} ()
|
||||
checkLeft msg a1 =
|
||||
match a1 with
|
||||
Left _ -> Tests.pass msg
|
||||
Right _ ->
|
||||
Debug.trace "value" a1
|
||||
Tests.fail msg "not Left"
|
||||
|
||||
bytes.toFromBases = do
|
||||
checkEqual "base16 empty" (Bytes.toBase16 (toUtf8 "")) 0xs
|
||||
checkEqual "from base16 empty" (Bytes.fromBase16 0xs) (Right 0xs)
|
||||
checkEqual "base16 hello" (Bytes.toBase16 (toUtf8 "hello")) (toUtf8 "68656c6c6f")
|
||||
checkEqual "from base16 hello" (Bytes.fromBase16 (toUtf8 "68656c6c6f")) (Right (toUtf8 "hello"))
|
||||
|
||||
checkEqual "base32 hello" (Bytes.toBase32 (toUtf8 "hello")) (toUtf8 "NBSWY3DP")
|
||||
checkEqual "from base32 hello" (Bytes.fromBase32 (toUtf8 "NBSWY3DP")) (Right (toUtf8 "hello"))
|
||||
|
||||
checkEqual "base64 hello" (Bytes.toBase64 (toUtf8 "hello")) (toUtf8 "aGVsbG8=")
|
||||
checkEqual "from base64 hello" (Bytes.fromBase64 (toUtf8 "aGVsbG8=")) (Right (toUtf8 "hello"))
|
||||
|
||||
checkEqual "base64Url hello" (toBase64UrlUnpadded (toUtf8 "hello")) (toUtf8 "aGVsbG8")
|
||||
checkEqual "from base64Url hello" (fromBase64UrlUnpadded (toUtf8 "aGVsbG8")) (Right (toUtf8 "hello"))
|
||||
|
||||
-- false ones
|
||||
checkLeft "from base16 fail non-utf8" (Bytes.fromBase16 0xsaaaa)
|
||||
checkLeft "from base32 fail non-utf8" (Bytes.fromBase32 0xsaaaa)
|
||||
checkLeft "from base64 fail non-utf8" (Bytes.fromBase64 0xsaaaa)
|
||||
checkLeft "from base64Url fail non-utf8" (fromBase64UrlUnpadded 0xsaaaa)
|
||||
|
||||
-- NOTE: the haskell implementation doesn't reject these invocations,
|
||||
-- even though though they are invalid :(. It just returns the same
|
||||
-- bytes that it received, confusingly.
|
||||
-- checkLeft "from base16 fail" (Bytes.fromBase16 (toUtf8 "aaaa"))
|
||||
-- checkLeft "from base64 fail" (Bytes.fromBase64 (toUtf8 "aaaa"))
|
||||
-- checkLeft "from base64Url fail" (fromBase64UrlUnpadded (toUtf8 "aaaa"))
|
||||
checkLeft "from base32 fail" (Bytes.fromBase32 (toUtf8 "aaaa"))
|
||||
|
||||
bytes.decodeNats = do
|
||||
checkEqual "decodeNat16be 1" (base.Bytes.decodeNat16be 0xs0001aa) (Some (1, 0xsaa))
|
||||
checkEqual "decodeNat16be 10000" (base.Bytes.decodeNat16be 0xs2710bb) (Some (10000, 0xsbb))
|
||||
checkEqual "decodeNat16le 1" (base.Bytes.decodeNat16le 0xs0100cc) (Some (1, 0xscc))
|
||||
checkEqual "decodeNat16le 10000" (base.Bytes.decodeNat16le 0xs1027dd) (Some (10000, 0xsdd))
|
||||
checkEqual "decodeNat32be 1" (base.Bytes.decodeNat32be 0xs00000001) (Some (1, 0xs))
|
||||
checkEqual "decodeNat32be 1000000000" (base.Bytes.decodeNat32be 0xs3b9aca00) (Some (1000000000, 0xs))
|
||||
checkEqual "decodeNat32le 1" (base.Bytes.decodeNat32le 0xs01000000) (Some (1, 0xs))
|
||||
checkEqual "decodeNat32le 1000000000" (base.Bytes.decodeNat32le 0xs00ca9a3b) (Some (1000000000, 0xs))
|
||||
checkEqual "decodeNat64be 1" (base.Bytes.decodeNat64be 0xs0000000000000001) (Some (1, 0xs))
|
||||
checkEqual "decodeNat64be 10000000000000000" (base.Bytes.decodeNat64be 0xs002386f26fc10000) (Some (10000000000000000, 0xs))
|
||||
checkEqual "decodeNat64le 1" (base.Bytes.decodeNat64le 0xs0100000000000000) (Some (1, 0xs))
|
||||
checkEqual "decodeNat64le 10000000000000000" (base.Bytes.decodeNat64le 0xs0000c16ff2862300) (Some (10000000000000000, 0xs))
|
||||
|
||||
bytes.encodeNats = do
|
||||
checkEqual "encodeNat16be 1" (base.Bytes.encodeNat16be 1) 0xs0001
|
||||
checkEqual "encodeNat16be 10000" (base.Bytes.encodeNat16be 10000) 0xs2710
|
||||
checkEqual "encodeNat16le 1" (base.Bytes.encodeNat16le 1) 0xs0100
|
||||
checkEqual "encodeNat16le 10000" (base.Bytes.encodeNat16le 10000) 0xs1027
|
||||
checkEqual "encodeNat32be 1" (base.Bytes.encodeNat32be 1) 0xs00000001
|
||||
checkEqual "encodeNat32be 1000000000" (base.Bytes.encodeNat32be 1000000000) 0xs3b9aca00
|
||||
checkEqual "encodeNat32le 1" (base.Bytes.encodeNat32le 1) 0xs01000000
|
||||
checkEqual "encodeNat32le 1000000000" (base.Bytes.encodeNat32le 1000000000) 0xs00ca9a3b
|
||||
checkEqual "encodeNat64be 1" (base.Bytes.encodeNat64be 1) 0xs0000000000000001
|
||||
checkEqual "encodeNat64be 10000000000000000" (base.Bytes.encodeNat64be 10000000000000000) 0xs002386f26fc10000
|
||||
checkEqual "encodeNat64le 1" (base.Bytes.encodeNat64le 1) 0xs0100000000000000
|
||||
checkEqual "encodeNat64le 10000000000000000" (base.Bytes.encodeNat64le 10000000000000000) 0xs0000c16ff2862300
|
@ -1,31 +0,0 @@
|
||||
|
||||
codelookup.links =
|
||||
[ termLink data.Map.adjust
|
||||
, termLink data.Map.alter
|
||||
, termLink data.Map.contains
|
||||
, termLink data.Map.delete
|
||||
, termLink data.Map.difference
|
||||
, termLink data.List.any
|
||||
, termLink data.List.apply
|
||||
, termLink data.List.compare
|
||||
, termLink data.List.contains
|
||||
, termLink data.List.count
|
||||
, termLink data.List.diagonal
|
||||
, termLink data.List.distinct
|
||||
, termLink data.NatSet.alter
|
||||
, termLink data.NatSet.any
|
||||
, termLink data.NatSet.empty
|
||||
, termLink data.NatSet.filter
|
||||
, termLink data.Tuple.at1
|
||||
, termLink data.Tuple.at2
|
||||
, termLink data.Tuple.at3
|
||||
, termLink data.Tuple.bimap
|
||||
, termLink data.Tuple.mapLeft
|
||||
, termLink data.graph.SCC.map
|
||||
]
|
||||
|
||||
codelookup.tests : '{Tests,IO} ()
|
||||
codelookup.tests = do
|
||||
foreach codelookup.links (l -> match Code.lookup l with
|
||||
None -> fail "codelookup" ("missing code for: " ++ toText l)
|
||||
Some _ -> pass ("codelookup " ++ toText l))
|
@ -1,161 +0,0 @@
|
||||
concurrency.tests = do
|
||||
!simpleRefTest
|
||||
!simpleRefTestScope
|
||||
!ticketTest
|
||||
!casTest
|
||||
!promiseSequentialTest
|
||||
!promiseConcurrentTest
|
||||
!forkKillTest
|
||||
!tryEvalForkTest
|
||||
!tryEvalKillTest
|
||||
!fullTest
|
||||
|
||||
simpleRefTest = do
|
||||
r = IO.ref 0
|
||||
Ref.write r 1
|
||||
i = Ref.read r
|
||||
Ref.write r 2
|
||||
j = Ref.read r
|
||||
Ref.write r 5
|
||||
checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5)
|
||||
|
||||
simpleRefTestScope = do
|
||||
Scope.run do
|
||||
r = Scope.ref 0
|
||||
Ref.write r 1
|
||||
i = Ref.read r
|
||||
Ref.write r 2
|
||||
j = Ref.read r
|
||||
Ref.write r 5
|
||||
checkEqual "Ref read-write" (i, j, Ref.read r) (1, 2, 5)
|
||||
|
||||
ticketTest = do
|
||||
r = IO.ref 3
|
||||
t = Ref.readForCas r
|
||||
v = Ticket.read t
|
||||
checkEqual "Ticket contains the Ref value" v 3
|
||||
|
||||
casTest = do
|
||||
ref = IO.ref 0
|
||||
ticket = Ref.readForCas ref
|
||||
v1 = Ref.cas ref ticket 5
|
||||
check "CAS is successful is there were no conflicting writes" 'v1
|
||||
Ref.write ref 10
|
||||
v2 = Ref.cas ref ticket 15
|
||||
check "CAS fails when there was an intervening write" '(not v2)
|
||||
|
||||
promiseSequentialTest = do
|
||||
use Nat eq
|
||||
use Promise read write
|
||||
p = !Promise.new
|
||||
v0 = Promise.tryRead p
|
||||
checkEqual "Promise should be empty when created" v0 None
|
||||
Promise.write_ p 0
|
||||
v1 = read p
|
||||
checkEqual "Promise should read a value that's been written" v1 0
|
||||
Promise.write_ p 1
|
||||
v2 = read p
|
||||
checkEqual "Promise can only be written to once" v2 v1
|
||||
v3 = Promise.tryRead p
|
||||
checkEqual "Once the Promise is full, tryRead is the same as read" v3 (Some v2)
|
||||
|
||||
millis = 1000
|
||||
sleep_ n = unsafeRun! do sleepMicroseconds n
|
||||
|
||||
promiseConcurrentTest = do
|
||||
use Nat eq
|
||||
use concurrent fork
|
||||
p = !Promise.new
|
||||
_ = fork do
|
||||
sleep_ (200 * millis)
|
||||
Promise.write p 5
|
||||
v = Promise.read p
|
||||
checkEqual "Reads awaits for completion of the Promise" v 5
|
||||
|
||||
kill_ t = unsafeRun! do concurrent.kill t
|
||||
|
||||
forkKillTest = do
|
||||
ref = IO.ref "initial"
|
||||
thread = fork do
|
||||
sleep_ (400 * millis)
|
||||
Ref.write ref "done"
|
||||
sleep_ (200 * millis)
|
||||
kill_ thread
|
||||
sleep_ (300 * millis)
|
||||
v = Ref.read ref
|
||||
checkEqual "Thread was killed" v "initial"
|
||||
|
||||
tryEvalForkTest = do
|
||||
ref = IO.ref "initial"
|
||||
t = fork do
|
||||
match catchAll do sleep_ (400 * millis) with
|
||||
Left _ -> ()
|
||||
Right _ -> unsafeRun! do Ref.write ref "finished"
|
||||
sleep_ (500 * millis)
|
||||
v = Ref.read ref
|
||||
checkEqual "tryEval is a no-op on success" v "finished"
|
||||
|
||||
tryEvalKillTest = do
|
||||
ref = IO.ref "initial"
|
||||
t = fork do
|
||||
match catchAll do sleep_ (400 * millis) with
|
||||
Left (Failure typ msg a) -> unsafeRun! do Ref.write ref msg
|
||||
Right _ -> unsafeRun! do Ref.write ref "finished"
|
||||
sleep_ (200 * millis)
|
||||
kill_ t
|
||||
sleep_ (300 * millis)
|
||||
v = Ref.read ref
|
||||
checkEqual "Thread was killed, with finalisers" v "thread killed"
|
||||
|
||||
atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} ()
|
||||
atomicUpdate ref f =
|
||||
ticket = Ref.readForCas ref
|
||||
value = f (Ticket.read ticket)
|
||||
if Ref.cas ref ticket value then () else atomicUpdate ref f
|
||||
|
||||
spawnN : Nat -> '{IO} a ->{IO} [a]
|
||||
spawnN n fa =
|
||||
use Nat eq -
|
||||
use concurrent fork
|
||||
|
||||
go i acc =
|
||||
if eq i 0
|
||||
then acc
|
||||
else
|
||||
value = !Promise.new
|
||||
_ = fork do Promise.write value !fa
|
||||
go (i - 1) (acc :+ value)
|
||||
|
||||
map Promise.read (go n [])
|
||||
|
||||
fullTest = do
|
||||
use Nat * + eq -
|
||||
|
||||
numThreads = 100
|
||||
iterations = 100
|
||||
expected = numThreads * iterations
|
||||
|
||||
state = IO.ref 0
|
||||
thread n =
|
||||
if eq n 0
|
||||
then ()
|
||||
else
|
||||
atomicUpdate state (v -> v + 1)
|
||||
thread (n - 1)
|
||||
ignore (spawnN numThreads '(thread iterations))
|
||||
result = Ref.read state
|
||||
checkEqual "The state of the counter is consistent " result expected
|
||||
|
||||
concurrency.interpreter.only = Tests.main do
|
||||
ref = IO.ref None
|
||||
t = fork do
|
||||
match catchAll do sleep_ (400 * millis) with
|
||||
Left (Failure f _ _) -> unsafeRun! do Ref.write ref (Some f)
|
||||
_ -> ()
|
||||
sleep_ (200 * millis)
|
||||
kill_ t
|
||||
sleep_ (300 * millis)
|
||||
v = Ref.read ref
|
||||
expected = Some (typeLink ThreadKilledFailure)
|
||||
checkEqual "Thread killed, finalisers with typeLink" v expected
|
||||
|
@ -1,280 +0,0 @@
|
||||
|
||||
io.tests = Tests.main do
|
||||
!test_getFileSize
|
||||
!test_getFileSize_err
|
||||
!test_getFileTimestamp
|
||||
!test_getFileTimestamp_err
|
||||
!io.test.seek.absolute
|
||||
!io.test.seek.relative
|
||||
!io.test.getLine
|
||||
!io.test.getsetBuffering
|
||||
!io.test_getEcho
|
||||
!io.test_getArgs
|
||||
!io.test_getEnv
|
||||
!io.test.getRandomBytes
|
||||
!io.test_getSomeBytes
|
||||
!io.test_getChar
|
||||
!io.test_getCurrentDirectory
|
||||
!io.test_createTempDirectory
|
||||
!io.test_renameFile
|
||||
!io.test_isFileOpen
|
||||
!io.test_ready
|
||||
!io.test_now
|
||||
!io.test_isSeekable
|
||||
!io.test_handlePosition
|
||||
!io.test_renameDirectory
|
||||
!io.test_setCurrentDirectory
|
||||
|
||||
rm_if_exists fp =
|
||||
if FilePath.exists fp
|
||||
then
|
||||
if isDirectory fp then
|
||||
removeDirectory fp
|
||||
else
|
||||
removeFile fp
|
||||
else
|
||||
()
|
||||
|
||||
|
||||
testFile = do
|
||||
fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
|
||||
rm_if_exists fp
|
||||
fp
|
||||
|
||||
io.test_isSeekable = do
|
||||
fp = !testFile
|
||||
fhandle = open fp Write
|
||||
checkEqual "isSeekable file" true (isSeekable fhandle)
|
||||
|
||||
io.test_handlePosition = do
|
||||
fp = !testFile
|
||||
writeFile fp "123456"
|
||||
fhandle = open fp Read
|
||||
checkEqual "handlePosition initial" 0 (position fhandle)
|
||||
_ = getBytes fhandle 2
|
||||
checkEqual "handlePosition" 2 (position fhandle)
|
||||
|
||||
|
||||
io.test_deprecated_systemTimeMicroseconds = do
|
||||
match !systemTimeMicroseconds with
|
||||
micro ->
|
||||
if micro Int.> +10 then
|
||||
Tests.pass "!systemTimeMicroseconds"
|
||||
else
|
||||
Tests.fail "!systemTimeMicroseconds" "systemTime is too small"
|
||||
|
||||
io.test_deprecated_systemTime = do
|
||||
match !systemTime with
|
||||
EpochTime seconds ->
|
||||
if seconds > 10 then
|
||||
Tests.pass "!systemTime"
|
||||
else
|
||||
Tests.fail "!systemTime" "systemTime is too small"
|
||||
|
||||
io.test_now = do
|
||||
match !now with
|
||||
Instant a b ->
|
||||
if a Int.> +10 then
|
||||
Tests.pass "!now"
|
||||
else
|
||||
Tests.fail "!now" "now is too small"
|
||||
|
||||
|
||||
io.test_createTempDirectory = do
|
||||
tmp = (createTempDirectory (FilePath "prefix-"))
|
||||
match tmp with
|
||||
FilePath text -> if Text.contains "/prefix-" text then
|
||||
if exists tmp then
|
||||
removeDirectory tmp
|
||||
Tests.pass "Tmp directory exists and contains prefix-"
|
||||
else
|
||||
Tests.fail "Tmp directory doesn't exist" text
|
||||
else
|
||||
Tests.fail "Tmp directory doesn't contain prefix-" text
|
||||
|
||||
io.test_isFileOpen = do
|
||||
fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
|
||||
fhandle = open fp Write
|
||||
open1 = isOpen fhandle
|
||||
Handle.close fhandle
|
||||
open2 = isOpen fhandle
|
||||
rm_if_exists fp
|
||||
checkEqual "opened handle is open" open1 true
|
||||
checkEqual "closed handle is not open" open2 false
|
||||
|
||||
io.test_ready = do
|
||||
fp = !testFile
|
||||
_ = writeFile fp "What"
|
||||
fhandle = open fp Read
|
||||
ready1 = ready fhandle
|
||||
checkEqual "handle with text ready is ready" ready1 true
|
||||
|
||||
join fp text =
|
||||
FilePath (FilePath.toText fp ++ "/" ++ text)
|
||||
|
||||
io.test_renameDirectory = do
|
||||
td = join !getTempDirectory "unison-dir"
|
||||
rd = join !getTempDirectory "unison-dir-rename"
|
||||
rm_if_exists td
|
||||
rm_if_exists rd
|
||||
createDirectory td
|
||||
contents = "a file contents"
|
||||
_ = writeFile (join td "hello") contents
|
||||
renameDirectory td rd
|
||||
got = (getText (open (join rd "hello") Read))
|
||||
rm_if_exists td
|
||||
rm_if_exists rd
|
||||
checkEqual "renameFile" contents got
|
||||
|
||||
io.test_renameFile = do
|
||||
fp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test")
|
||||
rmp = FilePath ((FilePath.toText !getTempDirectory) ++ "/unison-test-renamed")
|
||||
rm_if_exists fp
|
||||
rm_if_exists rmp
|
||||
contents = "a file contents"
|
||||
_ = writeFile fp contents
|
||||
renameFile fp rmp
|
||||
got = (getText (open rmp Read))
|
||||
rm_if_exists fp
|
||||
rm_if_exists rmp
|
||||
checkEqual "renameFile" contents got
|
||||
|
||||
writeFile fp txt =
|
||||
fh = open fp Write
|
||||
putText fh txt
|
||||
close fh
|
||||
|
||||
test_getFileSize = do
|
||||
fp = !testFile
|
||||
_ = writeFile fp "What"
|
||||
fs = (FilePath.getSize fp)
|
||||
checkEqual "Get file size should work" fs 4
|
||||
removeFile fp
|
||||
|
||||
test_getFileSize_err = do
|
||||
expectError' "File size of missing file" ["does not exist", "cannot get size"] '(FilePath.getSize !testFile)
|
||||
|
||||
test_getFileTimestamp = do
|
||||
time = secondsSinceEpoch !now
|
||||
fp = !testFile
|
||||
_ = writeFile fp "What"
|
||||
ts = match FilePath.getTimestamp fp with Instant i _ -> i
|
||||
after = secondsSinceEpoch !now
|
||||
use Int - +
|
||||
-- allow slip of up to a second
|
||||
if ts < (time - +1) then
|
||||
Tests.fail "File timestamp is too early" ((Int.toText ts) ++ " vs " ++ (Int.toText after))
|
||||
else if ts > (after + +1) then
|
||||
Tests.fail "File timestamp is too late" ((Int.toText ts) ++ " vs " ++ (Int.toText after))
|
||||
else
|
||||
Tests.pass "File timestamp is reasonable"
|
||||
|
||||
test_getFileTimestamp_err = do
|
||||
expectError' "File timestamp of missing file" ["does not exist", "error getting"] '(FilePath.getTimestamp !testFile)
|
||||
|
||||
io.test_setCurrentDirectory = do
|
||||
prev = !getCurrentDirectory
|
||||
setCurrentDirectory (FilePath "/")
|
||||
new = !getCurrentDirectory
|
||||
setCurrentDirectory prev
|
||||
match new with
|
||||
FilePath text -> checkEqual "Current directory set & get" "/" text
|
||||
|
||||
io.test_getCurrentDirectory = do
|
||||
match !getCurrentDirectory with
|
||||
FilePath text -> if Text.startsWith "/" text then
|
||||
Tests.pass "Current directory starts with /"
|
||||
else
|
||||
Tests.fail "Current directory doesn't start with /" text
|
||||
|
||||
seekFile = do
|
||||
fp = !testFile
|
||||
_ = writeFile fp "0123456789"
|
||||
open fp Read
|
||||
|
||||
io.test.seek.absolute = do
|
||||
h = !seekFile
|
||||
seek h AbsoluteSeek +4
|
||||
seek h AbsoluteSeek +2
|
||||
got = getText h
|
||||
checkEqual "AbsoluteSeek" got "23456789"
|
||||
|
||||
io.test.seek.relative = do
|
||||
h = !seekFile
|
||||
seek h AbsoluteSeek +2
|
||||
seek h RelativeSeek +2
|
||||
got = getText h
|
||||
checkEqual "RelativeSeek" got "456789"
|
||||
seek h RelativeSeek -2
|
||||
got2 = getText h
|
||||
checkEqual "RelativeSeek" got2 "89"
|
||||
|
||||
io.test.seek.fromEnd = do
|
||||
h = !seekFile
|
||||
seek h SeekFromEnd -6
|
||||
seek h SeekFromEnd -4
|
||||
got = getText h
|
||||
checkEqual "SeekFromEnd" got "6789"
|
||||
|
||||
io.test.getLine = do
|
||||
fp = !testFile
|
||||
_ = writeFile fp "one\ntwo\nthree"
|
||||
h = open fp Read
|
||||
one = Handle.getLine h
|
||||
two = Handle.getLine h
|
||||
three = Handle.getLine h
|
||||
checkEqual "getLine 1" one "one"
|
||||
checkEqual "getLine 2" two "two"
|
||||
checkEqual "getLine 3" three "three"
|
||||
|
||||
io.test.getsetBuffering = do
|
||||
prev = getBuffering stdOut
|
||||
setBuffering stdOut BlockBuffering
|
||||
bf = getBuffering stdOut
|
||||
setBuffering stdOut LineBuffering
|
||||
b2 = getBuffering stdOut
|
||||
setBuffering stdOut NoBuffering
|
||||
b3 = getBuffering stdOut
|
||||
setBuffering stdOut prev
|
||||
checkEqual "Block" bf BlockBuffering
|
||||
checkEqual "Line" b2 LineBuffering
|
||||
checkEqual "No" b3 NoBuffering
|
||||
|
||||
is_a_tty = do
|
||||
exitCode = call "test" ["-t", "0"]
|
||||
exitCode == 0
|
||||
|
||||
io.test_getEcho = do
|
||||
if is_a_tty () then
|
||||
prev = getEcho stdIn
|
||||
setEcho stdIn false
|
||||
checkEqual "echo turned off" (getEcho stdIn) false
|
||||
setEcho stdIn true
|
||||
checkEqual "echo turned back on" (getEcho stdIn) true
|
||||
setEcho stdIn prev
|
||||
else
|
||||
()
|
||||
|
||||
io.test_getArgs = do
|
||||
checkEqual "cli args" !getArgs []
|
||||
|
||||
io.test_getEnv = do
|
||||
checkEqual "HOME env variable" (startsWith "/" (getEnv "HOME")) true
|
||||
|
||||
io.test.getRandomBytes = do
|
||||
bs = IO.randomBytes 10
|
||||
checkEqual "get 10 random bytes" 10 (base.Bytes.size bs)
|
||||
|
||||
io.test_getChar = do
|
||||
fp = !testFile
|
||||
_ = writeFile fp "oón"
|
||||
h = open fp Read
|
||||
checkEqual "get char" (getChar h) ?o
|
||||
checkEqual "get a complicated char" (getChar h) ?ó
|
||||
|
||||
io.test_getSomeBytes = do
|
||||
fp = !testFile
|
||||
_ = writeFile fp "one\ntwo\nthree"
|
||||
h = open fp Read
|
||||
one = getSomeBytes h 3
|
||||
checkEqual "get some bytes" one (toUtf8 "one")
|
@ -1,58 +0,0 @@
|
||||
|
||||
linkstuff.termlinks =
|
||||
[ termLink data.Map.adjust
|
||||
, termLink data.Map.alter
|
||||
, termLink data.Map.contains
|
||||
, termLink data.Map.delete
|
||||
, termLink data.Map.difference
|
||||
, termLink data.List.any
|
||||
, termLink data.List.apply
|
||||
, termLink data.List.compare
|
||||
, termLink data.List.contains
|
||||
, termLink data.List.count
|
||||
, termLink data.List.diagonal
|
||||
, termLink data.List.distinct
|
||||
, termLink data.NatSet.alter
|
||||
, termLink data.NatSet.any
|
||||
, termLink data.NatSet.empty
|
||||
, termLink data.NatSet.filter
|
||||
, termLink data.Tuple.at1
|
||||
, termLink data.Tuple.at2
|
||||
, termLink data.Tuple.at3
|
||||
, termLink data.Tuple.bimap
|
||||
, termLink data.Tuple.mapLeft
|
||||
, termLink data.graph.SCC.map
|
||||
]
|
||||
|
||||
linkstuff.typelinks =
|
||||
[ typeLink data.Map
|
||||
, typeLink Nat
|
||||
, typeLink Char
|
||||
, typeLink data.List
|
||||
, typeLink data.NatSet
|
||||
, typeLink data.Tuple
|
||||
]
|
||||
|
||||
linkstuff.tmlpairs =
|
||||
flatMap (l -> map (r -> (l,r)) termlinks) termlinks
|
||||
|
||||
linkstuff.tylpairs =
|
||||
flatMap (l -> map (r -> (l,r)) typelinks) typelinks
|
||||
|
||||
linkstuff.tests : '{Tests,IO} ()
|
||||
linkstuff.tests = do
|
||||
use Universal gteq
|
||||
if all (cases (l,r) -> (l === r) || (l !== r)) tmlpairs
|
||||
then pass "term link equality"
|
||||
else fail "term link equality" ""
|
||||
if all (cases (l,r) -> (l === r) || (l !== r)) tylpairs
|
||||
then pass "type link equality"
|
||||
else fail "type link equality" ""
|
||||
|
||||
if all (cases (l,r) -> gteq l r || gteq r l) tmlpairs
|
||||
then pass "term link comparison"
|
||||
else fail "term link comparison" ""
|
||||
if all (cases (l,r) -> gteq l r || gteq r l) tylpairs
|
||||
then pass "type link comparison"
|
||||
else fail "type link comparison" ""
|
||||
|
@ -1,143 +0,0 @@
|
||||
list.tests = do
|
||||
!list.lit.tests
|
||||
!list.eq.tests
|
||||
!list.ord.tests
|
||||
!list.ops.tests
|
||||
!list.matching.tests
|
||||
|
||||
list.lit.tests = do
|
||||
check "List empty literal" do
|
||||
_ = []
|
||||
true
|
||||
check "List literal" do
|
||||
_ = [1, 2, 3]
|
||||
true
|
||||
|
||||
list.eq.tests = do
|
||||
checkEqual "List equality: empty" [] []
|
||||
checkEqual "List equality: non empty" [1, 2] [1, 2]
|
||||
check "List inequality: non empty (1)" do [1, 2] !== [1, 2, 3]
|
||||
check "List inequality: non empty (2)" do [1, 2, 3] !== [1, 2]
|
||||
check "List inequality: non empty (3)" do [1, 2] !== [1, 3]
|
||||
check "List inequality: empty" do [1, 2] !== []
|
||||
checkEqual "List equality: composite" (Some [Some 1, Some 2]) (Some [Some 1, Some 2])
|
||||
check "List inequality: composite" do (Some [Some 1, Some 2]) !== (Some [Some 1, Some 3])
|
||||
|
||||
list.ord.tests = do
|
||||
checkEqual "List ordering (1)" (Universal.compare [1] []) +1
|
||||
checkEqual "List ordering (2)" (Universal.compare [] [1]) -1
|
||||
checkEqual "List ordering (3)" (Universal.compare [1, 0] [1]) +1
|
||||
checkEqual "List ordering (4)" (Universal.compare [2] [1, 2]) +1
|
||||
checkEqual "List ordering (5)" (Universal.compare [1, 3] [1, 2]) +1
|
||||
checkEqual "List.ordering (6)" (Universal.compare [1, 2, 3] [1, 2, 3]) +0
|
||||
|
||||
list.ops.tests = do
|
||||
checkEqual "List.cons" (1 +: (2 +: (3 +: []))) [1, 2, 3]
|
||||
checkEqual "List.snoc" ([] :+ 1 :+ 2 :+ 3) [1, 2, 3]
|
||||
checkEqual "List.++" ([] ++ [1, 2] ++ [3, 4] ++ []) [1, 2, 3, 4]
|
||||
|
||||
checkEqual "List.take (1)" (List.take 0 [1,2,3]) []
|
||||
checkEqual "List.take (2)" (List.take 2 [1,2,3]) [1,2]
|
||||
checkEqual "List.take (3)" (List.take 3 [1,2,3]) [1,2,3]
|
||||
checkEqual "List.take (4)" (List.take 100 [1,2,3]) [1,2,3]
|
||||
checkEqual "List.take (5)" (List.take 3 []) []
|
||||
|
||||
checkEqual "List.drop (1)" (List.drop 0 [1,2,3]) [1,2,3]
|
||||
checkEqual "List.drop (2)" (List.drop 2 [1,2,3]) [3]
|
||||
checkEqual "List.drop (3)" (List.drop 3 [1,2,3]) []
|
||||
checkEqual "List.drop (4)" (List.drop 100 [1,2,3]) []
|
||||
checkEqual "List.drop (5)" (List.drop 3 []) []
|
||||
|
||||
checkEqual "List.size (1)" (List.size []) 0
|
||||
checkEqual "List.size (2)" (List.size [1,2,3]) 3
|
||||
|
||||
checkEqual "List.at (1)" (List.at 0 [1,2,3]) (Some 1)
|
||||
checkEqual "List.at (2)" (List.at 2 [1,2,3]) (Some 3)
|
||||
checkEqual "List.at (3)" (List.at 1 []) None
|
||||
checkEqual "List.at (4)" (List.at 5 [1,2,3]) None
|
||||
|
||||
list.matching.tests = do
|
||||
use Optional Some None
|
||||
|
||||
lenLit = cases
|
||||
[] -> 0
|
||||
[_] -> 1
|
||||
[_, _] -> 2
|
||||
[_, _, _] -> 3
|
||||
_ -> bug "no"
|
||||
|
||||
checkEqual "length matching: literal (1)" (lenLit []) 0
|
||||
checkEqual "length matching: literal (2)" (lenLit [5]) 1
|
||||
checkEqual "length matching: literal (3)" (lenLit [5, 6]) 2
|
||||
checkEqual "length matching: literal (4)" (lenLit [5, 6, 7]) 3
|
||||
|
||||
lenCons = cases
|
||||
[] -> 0
|
||||
_ +: (_ +: t) -> 2 + lenCons t
|
||||
_ +: t -> 1 + lenCons t
|
||||
|
||||
checkEqual "length: cons matching" (lenCons [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15]) 15
|
||||
|
||||
lenSnoc = cases
|
||||
[] -> 0
|
||||
t :+ _ -> 1 + lenSnoc t
|
||||
|
||||
checkEqual "length: snoc matching" (lenSnoc [1, 2, 3, 4, 5, 6, 7, 8]) 8
|
||||
|
||||
lenConcat1 = cases
|
||||
[] -> 0
|
||||
[_] ++ tail -> 1 + lenConcat1 tail
|
||||
|
||||
checkEqual "length: ++ prefix matching" (lenConcat1 [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]) 11
|
||||
|
||||
lenConcat2 = cases
|
||||
[] -> 0
|
||||
prefix ++ [_] -> 1 + lenConcat2 prefix
|
||||
|
||||
checkEqual "length: ++ suffix matching" (lenConcat2 [1, 2, 3, 4, 5]) 5
|
||||
|
||||
head = cases
|
||||
h +: _ -> Some h
|
||||
_ -> None
|
||||
|
||||
checkEqual "cons matching: empty" (head []) None
|
||||
checkEqual "cons matching: non empty" (head [1, 2, 3]) (Some 1)
|
||||
|
||||
firstTwo = cases
|
||||
x +: (y +: _) -> Some (x, y)
|
||||
_ -> None
|
||||
|
||||
checkEqual "two cons matching (1)" (firstTwo []) None
|
||||
checkEqual "two cons matching (2)" (firstTwo [1]) None
|
||||
checkEqual "two cons matching (3)" (firstTwo [1, 2, 3]) (Some (1, 2))
|
||||
|
||||
lastTwo = cases
|
||||
_ :+ x :+ y -> Some (x, y)
|
||||
_ -> None
|
||||
|
||||
checkEqual "two snoc matching (1)" (lastTwo []) None
|
||||
checkEqual "two snoc matching (2)" (lastTwo [1]) None
|
||||
checkEqual "two snoc matching (3)" (lastTwo [1, 2, 3]) (Some (2, 3))
|
||||
|
||||
middle = cases
|
||||
[_] ++ m ++ [_] -> Some m
|
||||
_ -> None
|
||||
|
||||
checkEqual "middle matching (1)" (middle []) None
|
||||
checkEqual "middle matching (2)" (middle [1, 2]) (Some [])
|
||||
checkEqual "middle matching (3)" (middle [1, 2, 3, 4, 5, 6]) (Some [2, 3, 4, 5])
|
||||
|
||||
middleNel = cases
|
||||
[_] ++ (h +: t) ++ [_] -> Some (h, t)
|
||||
_ -> None
|
||||
|
||||
checkEqual "middle matching with non-empty list (1)" (middleNel []) None
|
||||
checkEqual "middle matching with non-empty list (2)" (middleNel [1, 2]) None
|
||||
checkEqual "middle matching with non-empty list (3)" (middleNel [1, 2, 3, 4, 5, 6]) (Some (2, [3, 4, 5]))
|
||||
|
||||
splitAtFour : [a] -> ([a], [a])
|
||||
splitAtFour l = match l with
|
||||
[a] ++ x@(b +: (c +: y@([] :+ d))) ++ tail -> ([a, b, c, d], tail)
|
||||
_ -> (l, [])
|
||||
|
||||
checkEqual "Complex matching" (splitAtFour [1, 2, 3, 4, 5, 6, 7]) ([1, 2, 3, 4], [5, 6, 7])
|
@ -1,69 +0,0 @@
|
||||
|
||||
closeEnough a1 a2 =
|
||||
(Float.abs (a1 - a2)) < 0.00001
|
||||
|
||||
Tests.checkCloseEnough : Text -> Float -> Float ->{Tests} ()
|
||||
Tests.checkCloseEnough msg a1 a2 =
|
||||
if closeEnough a1 a2 then
|
||||
Tests.pass msg
|
||||
else
|
||||
Tests.fail msg "not close enough"
|
||||
|
||||
math.tests = do
|
||||
checkCloseEnough "sin 0" (sin 0.0) 0.0
|
||||
checkCloseEnough "sin pi/2" (sin (pi / 2.0)) 1.0
|
||||
checkCloseEnough "cos 0" (cos 0.0) 1.0
|
||||
checkCloseEnough "cos pi" (cos pi) -1.0
|
||||
checkCloseEnough "cosh pi" (cosh pi) 11.591953275521519
|
||||
checkCloseEnough "sinh pi/2" (sinh (pi / 2.0)) 2.3012989023072947
|
||||
checkCloseEnough "addf" (1.2 + 3.4) 4.6
|
||||
checkCloseEnough "asin 1.0" (asin 1.0) 1.5707963267948966
|
||||
checkCloseEnough "asinh 1.0" (asinh 1.0) 0.881373587019543
|
||||
checkCloseEnough "atan 1.0" (atan 1.0) 0.7853981633974483
|
||||
checkCloseEnough "atan2 1.0 2.0" (atan2 1.0 2.0) 0.46364760900080615
|
||||
checkCloseEnough "atanh 0.5" (atanh 0.5) 0.5493061443340549
|
||||
checkCloseEnough "tan 0.5" (tan 0.5) 0.5463024898437905
|
||||
checkCloseEnough "tanh 0.5" (tanh 0.5) 0.46211715726000974
|
||||
checkCloseEnough "ceiling 0.1" (ceiling 0.1) 1.0
|
||||
checkCloseEnough "ceiling 0.9" (ceiling 0.9) 1.0
|
||||
checkCloseEnough "floor 0.9" (floor 0.9) 0.0
|
||||
checkCloseEnough "floor 1.9" (floor 1.9) 1.0
|
||||
checkCloseEnough "rndf" (round 1.9) 2.0
|
||||
checkCloseEnough "divf" (1.2 / 3.4) 0.35294117647058826
|
||||
checkEqual "maxf" (Float.max 1.2 1.23) 1.23
|
||||
checkEqual "minf" (Float.min 1.2 1.23) 1.2
|
||||
checkCloseEnough "mulf" (1.1 Float.* 2.2) 2.42
|
||||
checkEqual "muli" (+4 Int.* +2) +8
|
||||
checkEqual "powi" (Int.pow +2 3) +8
|
||||
checkEqual "pown" (Nat.pow 2 3) 8
|
||||
checkCloseEnough "powf" (Float.pow 2.0 3.0) 8.0
|
||||
checkEqual "ntof" (Nat.toFloat 23) 23.0
|
||||
checkEqual "negi" (Int.negate +23) -23
|
||||
checkEqual "divi" (10 / 4) 2
|
||||
checkEqual "eqlf" (1.1 == 1.1) true
|
||||
checkEqual "eqlf" (1.1 == 1.2) false
|
||||
checkEqual "leqi" (-1 <= +1) true
|
||||
checkEqual "leqn" (1 <= 2) true
|
||||
checkEqual "subi" (+4 - +3) +1
|
||||
checkEqual "signum" (signum -2) -1
|
||||
checkEqual "signum" (signum +2) +1
|
||||
checkEqual "signum" (signum +0) +0
|
||||
checkCloseEnough "logf" (Float.log 10.0) 2.302585092994046
|
||||
checkCloseEnough "logb" (Float.logBase 2.0 256.0) 8.0
|
||||
checkEqual "decn" (Nat.decrement 10) 9
|
||||
checkEqual "deci" (Int.decrement +10) +9
|
||||
checkEqual "inci" (Int.increment +10) +11
|
||||
checkEqual "incn" (Nat.increment 10) 11
|
||||
checkCloseEnough "expf" (Float.exp 2.0) 7.3890560989306
|
||||
|
||||
checkEqual "TZRO +0" (Int.trailingZeros +0) 64
|
||||
checkEqual "TZRO +1" (Int.trailingZeros +1) 0
|
||||
checkEqual "TZRO +16777216" (Int.trailingZeros +16777216) 24
|
||||
checkEqual "TZRO 2^59" (Int.trailingZeros (Int.pow +2 59)) 59
|
||||
checkEqual "POPC +16777215" (Int.popCount +16777215) 24
|
||||
checkEqual "POPC +5" (Int.popCount +5) 2
|
||||
checkEqual "POPC -5" (Int.popCount -5) 63
|
||||
checkEqual "POPC -1" (Int.popCount -1) 64
|
||||
checkEqual "POPC -1234567891" (Int.popCount -1234567891) 52
|
||||
checkEqual "POPC -1111111111" (Int.popCount -1111111111) 50
|
||||
|
@ -1,60 +0,0 @@
|
||||
|
||||
sandbox.check ok name a k =
|
||||
match Value.validateSandboxed ok (value a) with
|
||||
Left _ -> Tests.fail name "unknown dependencies"
|
||||
Right [] -> k true
|
||||
Right _ -> k false
|
||||
|
||||
sandbox.checkSafe name a =
|
||||
sandbox.check [] name a cases
|
||||
true -> Tests.pass (name ++ " safe")
|
||||
false -> Tests.fail name "unexpectedly unsafe"
|
||||
|
||||
sandbox.checkUnsafe name a =
|
||||
sandbox.check [] name a cases
|
||||
true -> Tests.fail name "unexpectedly safe"
|
||||
false -> Tests.pass (name ++ " unsafe")
|
||||
|
||||
sandbox.checkAllowed name ok a =
|
||||
sandbox.check ok name a cases
|
||||
true -> Tests.pass (name ++ " allowed")
|
||||
false -> Tests.fail name "unexpected disallowed"
|
||||
|
||||
sandbox.directory =
|
||||
"unison-src/transcripts-using-base/serialized-cases/"
|
||||
|
||||
sandbox.file = FilePath (directory ++ "case-04.v4.ser")
|
||||
|
||||
sandbox.open1 = do
|
||||
_ = FilePath.open (FilePath "hello")
|
||||
()
|
||||
|
||||
sandbox.open2 = do
|
||||
!open1
|
||||
|
||||
serial.checkLoaded : '{IO, Tests, Exception} ()
|
||||
serial.checkLoaded = do
|
||||
input = FilePath.readFile sandbox.file
|
||||
match fromBase32 input with
|
||||
Left msg -> raiseFailure msg input
|
||||
Right bs ->
|
||||
(deps, v) = loadValueBytes bs
|
||||
|
||||
_ = cache_ deps
|
||||
match Value.load v with
|
||||
Left l -> raiseFailure "value missing deps" l
|
||||
Right (f, _) -> checkUnsafe "loaded" f
|
||||
|
||||
sandbox.tests = do
|
||||
checkSafe "5" 5
|
||||
checkSafe "5.0" 5.0
|
||||
checkSafe "\"\"" ""
|
||||
checkSafe "0xs1337" 0xs1337
|
||||
checkSafe "List.map" List.map
|
||||
checkUnsafe "FilePath.open" FilePath.open
|
||||
checkUnsafe "sandbox.open1" sandbox.open1
|
||||
checkUnsafe "sandbox.open2" sandbox.open2
|
||||
checkUnsafe "Code.cache_" Code.cache_
|
||||
checkAllowed "FilePath.open" [termLink FilePath.open.impl] FilePath.open
|
||||
checkAllowed "Code.cache_" [termLink Code.cache_] Code.cache_
|
||||
!checkLoaded
|
@ -1,139 +0,0 @@
|
||||
serial.directory =
|
||||
FilePath "unison-src/transcripts-using-base/serialized-cases/"
|
||||
|
||||
(<+>) : FilePath -> FilePath -> FilePath
|
||||
(<+>) = cases (FilePath l), (FilePath r) -> FilePath (l ++ r)
|
||||
|
||||
serial.availableCases : '{IO,Exception} [Text]
|
||||
serial.availableCases _ =
|
||||
use List map
|
||||
p = cases (FilePath nm) -> contains ".ser" nm
|
||||
slice = cases (FilePath nm) ->
|
||||
Text.take (Text.size nm - 7) nm
|
||||
-- caseNums = ["00", "01", "02", "03"]
|
||||
caseNums = ["00", "02", "04"]
|
||||
files = map (n -> FilePath ("case-" ++ n ++ ".v4.ser")) caseNums
|
||||
map slice (filter p files)
|
||||
|
||||
serial.gen : Nat -> Nat -> (Nat, Nat)
|
||||
serial.gen seed k =
|
||||
c = 1
|
||||
a = 22695477
|
||||
m = shiftLeft 1 32
|
||||
s = mod (a * seed + c) m
|
||||
mask = shiftLeft 1 (Nat.min 14 k)
|
||||
(mod (shiftRight s 15) mask, s)
|
||||
|
||||
|
||||
serial.shuffle : Nat -> [a] -> [a]
|
||||
serial.shuffle =
|
||||
pick acc seed = cases
|
||||
l | List.size l <= 1 -> acc ++ l
|
||||
| otherwise -> match gen seed (size l) with
|
||||
(k, seed) -> match (take k l, drop k l) with
|
||||
(pre, x +: post) -> pick (acc :+ x) seed (pre ++ post)
|
||||
(pre, []) -> pick acc seed pre
|
||||
|
||||
pick []
|
||||
|
||||
serial.checkCodeRoundtrip : Code ->{Exception,Tests,IO} Boolean
|
||||
serial.checkCodeRoundtrip code0 =
|
||||
match Code.deserialize (Code.serialize code0) with
|
||||
Left err -> raiseFailure ("could not roundrip code: " ++ err) code0
|
||||
Right code1 -> code0 === code1
|
||||
|
||||
serial.loadValueBytes :
|
||||
base.Bytes ->{Exception,IO} ([(Link.Term, Code)], reflection.Value)
|
||||
serial.loadValueBytes bs = match Value.deserialize bs with
|
||||
Left err ->
|
||||
raiseFailure ("could not deserialize value: " ++ err) bs
|
||||
Right sv ->
|
||||
if Value.serialize sv === bs then ()
|
||||
else raiseFailure "reserialized bytes did not match" bs
|
||||
match Value.load sv with
|
||||
Left l -> raiseFailure "could not load value" ()
|
||||
Right v -> v
|
||||
|
||||
serial.readFile : FilePath -> base.Bytes
|
||||
serial.readFile fp =
|
||||
h = FilePath.open fp Read
|
||||
read acc =
|
||||
if isEOF h
|
||||
then
|
||||
close h
|
||||
acc
|
||||
else read (acc ++ getBytes h 1024)
|
||||
read 0xs
|
||||
|
||||
checkCached name = cases
|
||||
[] -> pass (name ++ " code cached")
|
||||
(ln, co0) +: rest -> match Code.lookup ln with
|
||||
None -> fail name "code cache missing"
|
||||
Some co1
|
||||
| co0 === co1 -> checkCached name rest
|
||||
| otherwise -> fail name "code cache mismatch"
|
||||
|
||||
serial.loadSelfContained : Text -> FilePath ->{IO, Tests, Exception} a
|
||||
serial.loadSelfContained name path =
|
||||
input = readFile path
|
||||
match fromBase32 input with
|
||||
Left msg -> raiseFailure msg input
|
||||
Right bs ->
|
||||
(deps, v) = loadValueBytes bs
|
||||
|
||||
if List.all (checkCodeRoundtrip << at2) deps
|
||||
then pass (name ++ " code roundtrip")
|
||||
else fail name "code roundtrip"
|
||||
|
||||
if Value.serialize (Value.value (deps, v)) === bs
|
||||
then pass (name ++ " value roundtrip")
|
||||
else fail name "value roundtrip"
|
||||
|
||||
match validateLinks deps with
|
||||
Left [] -> fail name "validateLinks: empty Left"
|
||||
Left _ -> fail name "validateLinks: couldn't rehash"
|
||||
Right [] -> pass (name ++ " links validated")
|
||||
Right _ -> fail name "failed link validation"
|
||||
|
||||
match cache_ deps with
|
||||
[] -> ()
|
||||
miss -> raiseFailure "code missing deps" miss
|
||||
|
||||
checkCached name deps
|
||||
match Value.load v with
|
||||
Left l -> raiseFailure "value missing deps" l
|
||||
Right x -> x
|
||||
|
||||
serial.runTestCase : Text ->{Tests,IO} ()
|
||||
serial.runTestCase name =
|
||||
sfile = directory <+> FilePath (name ++ ".v4.ser")
|
||||
ofile = directory <+> FilePath (name ++ ".out")
|
||||
hfile = directory <+> FilePath (name ++ ".v4.hash")
|
||||
|
||||
handle
|
||||
p@(f, i) = loadSelfContained name sfile
|
||||
o = fromUtf8 (readFile ofile)
|
||||
h = readFile hfile
|
||||
|
||||
if toBase32 (crypto.hash Sha3_512 p) === h
|
||||
then pass (name ++ " hash matches")
|
||||
else fail name "hash mismatch"
|
||||
|
||||
if f i === o
|
||||
then pass (name ++ "value matches")
|
||||
else fail name "output mismatch"
|
||||
with cases
|
||||
{ x } -> x
|
||||
{ raise f -> _ } -> exception ("test failure: " ++ name) f
|
||||
|
||||
serial.tests : '{Tests,IO} ()
|
||||
serial.tests = do
|
||||
handle
|
||||
l = !availableCases
|
||||
m = shiftLeft 1 32
|
||||
seed = mod (toRepresentation !systemTimeMicroseconds) m
|
||||
cs = shuffle seed l
|
||||
List.map runTestCase cs
|
||||
with cases
|
||||
{x} -> ()
|
||||
{raise f -> k} -> exception "failed to load test cases" f
|
@ -1,51 +0,0 @@
|
||||
|
||||
shouldFail fn =
|
||||
result = catchAll fn
|
||||
isLeft result
|
||||
|
||||
tcp.tests = do
|
||||
-- TODO: Enable this once scheme output correctly escapes \r
|
||||
-- check "connects to example.com" tcp.example.com
|
||||
check "rejects invalid port" do shouldFail do Socket.client (HostName "example.com") (Port "what")
|
||||
check "no send after close" do shouldFail do
|
||||
socket = Socket.client (HostName "example.com") (Port "80")
|
||||
Socket.close socket
|
||||
Socket.send socket (toUtf8 "GET /index.html HTTP/1.0\r\n\r\n")
|
||||
check "no send on listener" do shouldFail do
|
||||
match Socket.server None (Port "0") with
|
||||
BoundServerSocket socket -> Socket.send socket (toUtf8 "what")
|
||||
!testServerAndClient
|
||||
|
||||
tcp.example.com = do
|
||||
socket = Socket.client (HostName "example.com") (Port "80")
|
||||
Socket.send socket (toUtf8 "GET /index.html HTTP/1.0\r\nHost: example.com\r\n\r\n")
|
||||
response = Socket.receive socket
|
||||
Socket.close socket
|
||||
contains "HTTP/1.0 200 OK" (base.Text.fromUtf8 response)
|
||||
|
||||
testServerAndClient = do
|
||||
setup = catchAll do
|
||||
socket = Socket.listen (server None (Port "0"))
|
||||
port = match socket with ListeningServerSocket sock -> Socket.port sock
|
||||
(socket, port)
|
||||
|
||||
match setup with
|
||||
Left exn ->
|
||||
Tests.fail "Unable to bind and listen on a socket" (Debug.evalToText exn)
|
||||
Right (socket, port) ->
|
||||
serve = do
|
||||
sock = Socket.accept socket
|
||||
data = Socket.receive sock
|
||||
Socket.send sock (toUtf8 "from server")
|
||||
base.Text.fromUtf8 data
|
||||
|
||||
serveResult = !Promise.new
|
||||
_ = fork do Promise.write serveResult (catchAll serve)
|
||||
|
||||
data = catchAll do
|
||||
clientSocket = Socket.client (HostName "localhost") (Port (Nat.toText port))
|
||||
Socket.send clientSocket (toUtf8 "from client")
|
||||
base.Text.fromUtf8 (Socket.receive clientSocket)
|
||||
|
||||
checkEqual "Server received data" (Promise.read serveResult) (Right "from client")
|
||||
checkEqual "Client received data" data (Right "from server")
|
@ -1,58 +0,0 @@
|
||||
|
||||
unique ability Tests where
|
||||
pass : Text -> ()
|
||||
fail : Text -> Text -> ()
|
||||
exception : Text -> Failure -> ()
|
||||
|
||||
Tests.check : Text -> '{g, Exception} Boolean ->{g, Tests} ()
|
||||
Tests.check msg b =
|
||||
match catch b with
|
||||
Left e -> exception msg e
|
||||
Right true -> pass msg
|
||||
Right false -> fail msg ""
|
||||
|
||||
Tests.checkEqual : Text -> a -> a ->{Tests} ()
|
||||
Tests.checkEqual msg a1 a2 =
|
||||
match catch '(a1 === a2) with
|
||||
Left e -> exception msg e
|
||||
Right true -> pass msg
|
||||
Right false ->
|
||||
fail msg (Debug.evalToText a1 ++ " is not equal to: " ++ Debug.evalToText a2)
|
||||
|
||||
Tests.main : '{IO,Exception,Tests} () -> '{IO,Exception} ()
|
||||
Tests.main suite = do
|
||||
if Tests.run suite then ()
|
||||
else bug "test suite failed"
|
||||
|
||||
Tests.run : '{IO,Exception,Tests} () ->{IO,Exception} Boolean
|
||||
Tests.run suite =
|
||||
use Nat +
|
||||
h passed failed = cases
|
||||
{ _ } -> (passed, failed)
|
||||
{ pass msg -> k } ->
|
||||
printLine (" ✅ " ++ msg)
|
||||
handle !k with h (passed + 1) failed
|
||||
{ fail msg reason -> k } ->
|
||||
printLine (" 🆘 " ++ msg ++ " " ++ reason)
|
||||
handle !k with h passed (failed + 1)
|
||||
{ exception msg failure@(Failure _ cause payload) -> k} ->
|
||||
printLine (" 💥 " ++ msg ++ " " ++ cause)
|
||||
handle !k with h passed (failed + 1)
|
||||
|
||||
printLine ""
|
||||
printLine "*** Test suite ***"
|
||||
printLine ""
|
||||
|
||||
(passed, failed) = handle !suite with h 0 0
|
||||
|
||||
printLine ""
|
||||
printLine ""
|
||||
printLine "Summary of results:"
|
||||
printLine ""
|
||||
|
||||
if failed == 0 then
|
||||
printLine (" ✅✅✅ " ++ Nat.toText passed ++ " PASSED")
|
||||
else
|
||||
printLine (" 🆘🆘🆘 " ++ Nat.toText failed ++ " FAILED, "
|
||||
++ Nat.toText passed ++ " passed")
|
||||
failed == 0
|
@ -1,5 +0,0 @@
|
||||
tests.interpreter.only : '{IO,Exception} ()
|
||||
tests.interpreter.only = Tests.main do
|
||||
!text.interpreter.only
|
||||
!concurrency.interpreter.only
|
||||
!io.test.seek.fromEnd
|
@ -1,5 +0,0 @@
|
||||
tests.jit.only : '{IO,Exception} ()
|
||||
tests.jit.only = Tests.main do
|
||||
check "example jit-only test" do true
|
||||
!tls.cert.codec
|
||||
!tls.private.codec
|
@ -1,67 +0,0 @@
|
||||
tests : '{IO,Exception} ()
|
||||
tests = Tests.main do
|
||||
!math.tests
|
||||
!io.tests
|
||||
!tls.tests
|
||||
!crypto.hash.tests
|
||||
!murmur.hash.tests
|
||||
!hmac.tests
|
||||
!concurrency.tests
|
||||
!tcp.tests
|
||||
!serial.tests
|
||||
-- TODO add test assert on message and value for both bug and todo
|
||||
check "bug is caught" do isLeft (catchAll do bug ())
|
||||
!list.tests
|
||||
!text.tests
|
||||
!bytes.tests
|
||||
!array.tests
|
||||
!codelookup.tests
|
||||
!sandbox.tests
|
||||
!linkstuff.tests
|
||||
|
||||
murmur.hash.tests = do
|
||||
targets =
|
||||
[ 3616548711131950114
|
||||
, 1208954131003843843
|
||||
, 664611890102475300
|
||||
, 6714987116946118165
|
||||
, 16299576272983505103
|
||||
, 4073299915095202490
|
||||
, 12366602710912766676
|
||||
, 7206684309820213116
|
||||
, 18221756083322989289
|
||||
, 15843896009975349171
|
||||
]
|
||||
process i t =
|
||||
name = "murmurHash " ++ toText i
|
||||
checkEqual name (murmurHash i) t
|
||||
List.foreach_ (uncurry process) <| List.zip (List.range 0 10) targets
|
||||
|
||||
crypto.hash.tests = do
|
||||
hash alg = hashBytes alg (toUtf8 "")
|
||||
tag name = name ++ " hashBytes"
|
||||
[
|
||||
("Md5", Md5, 0xsd41d8cd98f00b204e9800998ecf8427e),
|
||||
("Sha1", Sha1, 0xsda39a3ee5e6b4b0d3255bfef95601890afd80709),
|
||||
("Sha2_256", Sha2_256, 0xse3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855),
|
||||
("Sha2_512", Sha2_512, 0xscf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e),
|
||||
("Sha3_256", Sha3_256, 0xsa7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a),
|
||||
("Sha3_512", Sha3_512, 0xsa69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26),
|
||||
("Blake2s_256", Blake2s_256, 0xs69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9),
|
||||
("Blake2b_256", Blake2b_256, 0xs0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8),
|
||||
("Blake2b_512", Blake2b_512, 0xs786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce)
|
||||
] |> List.foreach_ cases (name, alg, res) -> checkEqual (tag name) (hash alg) res
|
||||
|
||||
hmac.tests = do
|
||||
hmac alg = hmacBytes alg (toUtf8 "key") (toUtf8 "")
|
||||
tag name = name ++ " hmacBytes"
|
||||
[
|
||||
("Sha1", Sha1, 0xsf42bb0eeb018ebbd4597ae7213711ec60760843f),
|
||||
("Sha2_256", Sha2_256, 0xs5d5d139563c95b5967b9bd9a8c9b233a9dedb45072794cd232dc1b74832607d0),
|
||||
("Sha2_512", Sha2_512, 0xs84fa5aa0279bbc473267d05a53ea03310a987cecc4c1535ff29b6d76b8f1444a728df3aadb89d4a9a6709e1998f373566e8f824a8ca93b1821f0b69bc2a2f65e),
|
||||
("Sha3_256", Sha3_256, 0xs74f3c030ecc36a1835d04a333ebb7fce2688c0c78fb0bcf9592213331c884c75),
|
||||
("Sha3_512", Sha3_512, 0xs7539119b6367aa902bdc6f558d20c906d6acbd4aba3fd344eb08b0200144a1fa453ff6e7919962358be53f6db2a320d1852c52a3dea3e907070775f7a91f1282),
|
||||
("Blake2s_256", Blake2s_256, 0xs67148074efc0f6741b474ef81c4d98d266e880d372fe723d2569b1d414d234be),
|
||||
("Blake2b_256", Blake2b_256, 0xs4224e1297e51239a642e21f756bde2785716f872298178180d7f3d1d36a5e4e4),
|
||||
("Blake2b_512", Blake2b_512, 0xs019fe04bf010b8d72772e6b46897ecf74b4878c394ff2c4d5cfa0b7cc9bbefcb28c36de23cef03089db9c3d900468c89804f135e9fdef7ec9b3c7abe50ed33d3)
|
||||
] |> List.foreach_ cases (name, alg, res) -> checkEqual (tag name) (hmac alg) res
|
@ -1,246 +0,0 @@
|
||||
text.tests = do
|
||||
!text.lit.tests
|
||||
!text.eq.tests
|
||||
!text.ord.tests
|
||||
!text.ops.tests
|
||||
!text.conversion.tests
|
||||
!text.debug.tests
|
||||
!text.matching.tests
|
||||
!char.class.tests
|
||||
|
||||
text.interpreter.only = do
|
||||
!text.term.tests
|
||||
|
||||
text.lit.tests = do
|
||||
check "Text empty literal" do
|
||||
_ = ""
|
||||
true
|
||||
check "Text literal" do
|
||||
_ = "foo"
|
||||
true
|
||||
|
||||
text.eq.tests = do
|
||||
check "Text equality: empty" do "" Text.== ""
|
||||
check "Text equality: non empty" do "foo" Text.== "foo"
|
||||
check "Text inequality: empty (1)" do not ("foo" Text.== "")
|
||||
check "Text inequality: empty (2)" do not ("" Text.== "foo")
|
||||
check "Text inequality: non empty" do not ("foo" Text.== "bar")
|
||||
checkEqual "Universal equality with Text: empty" "" ""
|
||||
checkEqual "Universal equality with Text: non empty" "foo" "foo"
|
||||
check "Universal inequality with Text: empty (1)" do "foo" !== ""
|
||||
check "Universal inequality with Text: empty (2)" do "" !== "foo"
|
||||
check "Universal inequality with Text: non empty" do "foo" !== "bar"
|
||||
checkEqual "Universal equality with Text: composite" (Some ["foo", "bar"]) (Some ["foo", "bar"])
|
||||
check "Universal inequality with Text: composite" do (Some ["foo", "bar"]) !== (Some ["foo", "baz"])
|
||||
|
||||
text.ord.tests = do
|
||||
check "Text ordering (1)" do "a" > ""
|
||||
check "Text ordering (2)" do "" < "a"
|
||||
check "Text ordering (3)" do "ba" > "b"
|
||||
check "Text ordering (4)" do "b" > "ab"
|
||||
check "Text ordering (5)" do "ac" > "ab"
|
||||
|
||||
checkEqual "Universal ordering with Text (1)" (Universal.compare "a" "") +1
|
||||
checkEqual "Universal ordering with Text (2)" (Universal.compare "" "a") -1
|
||||
checkEqual "Universal ordering with Text (3)" (Universal.compare "ba" "b") +1
|
||||
checkEqual "Universal ordering with Text (4)" (Universal.compare "b" "ab") +1
|
||||
checkEqual "Universal ordering with Text (5)" (Universal.compare "ac" "ab") +1
|
||||
checkEqual "Universal ordering with Text (6)" (Universal.compare "abc" "abc") +0
|
||||
|
||||
text.ops.tests = do
|
||||
checkEqual "Text.++" ("" ++ "ab" ++ "cd" ++ "") "abcd"
|
||||
|
||||
checkEqual "Text.take (1)" (Text.take 0 "abc") ""
|
||||
checkEqual "Text.take (2)" (Text.take 2 "abc") "ab"
|
||||
checkEqual "Text.take (3)" (Text.take 3 "abc") "abc"
|
||||
checkEqual "Text.take (4)" (Text.take 100 "abc") "abc"
|
||||
checkEqual "Text.take (5)" (Text.take 3 "") ""
|
||||
|
||||
checkEqual "Text.drop (1)" (Text.drop 0 "abc") "abc"
|
||||
checkEqual "Text.drop (2)" (Text.drop 2 "abc") "c"
|
||||
checkEqual "Text.drop (3)" (Text.drop 3 "abc") ""
|
||||
checkEqual "Text.drop (4)" (Text.drop 100 "abc") ""
|
||||
checkEqual "Text.drop (5)" (Text.drop 3 "") ""
|
||||
|
||||
checkEqual "Text.size (1)" (Text.size "") 0
|
||||
checkEqual "Text.size (2)" (Text.size "abc") 3
|
||||
|
||||
checkEqual "Text.uncons (1)" (Text.uncons "") None
|
||||
checkEqual "Text.uncons (2)" (Text.uncons "a") (Some (?a, ""))
|
||||
checkEqual "Text.uncons (3)" (Text.uncons "abc") (Some (?a, "bc"))
|
||||
|
||||
checkEqual "Text.unsnoc (1)" (Text.unsnoc "") None
|
||||
checkEqual "Text.unsnoc (2)" (Text.unsnoc "a") (Some ("", ?a))
|
||||
checkEqual "Text.unsnoc (3)" (Text.unsnoc "abc") (Some ("ab", ?c))
|
||||
|
||||
checkEqual "Text.repeat (1)" (Text.repeat 0 "") ""
|
||||
checkEqual "Text.repeat (2)" (Text.repeat 3 "") ""
|
||||
checkEqual "Text.repeat (3)" (Text.repeat 0 "abc") ""
|
||||
checkEqual "Text.repeat (3)" (Text.repeat 10 "xy-") "xy-xy-xy-xy-xy-xy-xy-xy-xy-xy-"
|
||||
|
||||
checkEqual "Text.reverse (1)" (Text.reverse "") ""
|
||||
checkEqual "Text.reverse (2)" (Text.reverse "abc") "cba"
|
||||
checkEqual -- The string is long enough to test the chunking structure
|
||||
"Text.reverse (3)"
|
||||
(Text.reverse (Text.repeat 256 "abc" ++ Text.repeat 256 "def" ++ Text.repeat 42 "ghi"))
|
||||
(Text.repeat 42 "ihg" ++ Text.repeat 256 "fed" ++ Text.repeat 256 "cba")
|
||||
|
||||
checkEqual "Text.toUppercase (1)" (Text.toUppercase "") ""
|
||||
checkEqual "Text.toUppercase (2)" (Text.toUppercase "abcABC123{({})}.") "ABCABC123{({})}."
|
||||
|
||||
checkEqual "Text.toLowercase (1)" (Text.toLowercase "") ""
|
||||
checkEqual "Text.toLowercase (2)" (Text.toLowercase "abcABC123{({})}.") "abcabc123{({})}."
|
||||
|
||||
checkEqual "Text.indexOf (1)" (Text.indexOf "" "hello") (Some 0)
|
||||
checkEqual "Text.indexOf (2)" (Text.indexOf "l" "hello") (Some 2)
|
||||
checkEqual "Text.indexOf (3)" (Text.indexOf "lo" "hello") (Some 3)
|
||||
checkEqual "Text.indexOf (3)" (Text.indexOf "elo" "hello") None
|
||||
|
||||
text.conversion.tests = do
|
||||
checkEqual "Nat.toText (1)" (Nat.toText 0) "0"
|
||||
checkEqual "Nat.toText (2)" (Nat.toText 10) "10"
|
||||
checkEqual "Nat.toText (3)" (Nat.toText 1039) "1039"
|
||||
checkEqual "Nat.fromText (1)" (Nat.fromText "0") (Some 0)
|
||||
checkEqual "Nat.fromText (2)" (Nat.fromText "a8f9djasdlfkj") None
|
||||
checkEqual "Nat.fromText (3)" (Nat.fromText "3940") (Some 3940)
|
||||
checkEqual "Nat.fromText (4)" (Nat.fromText "-3940") None
|
||||
checkEqual "Nat.fromText (5)" (Nat.fromText "1000000000000000000000000000") None
|
||||
checkEqual "Nat.fromText (6)" (Nat.fromText "1.5") None
|
||||
checkEqual "Nat <-> Text roundtrip (1)" (Nat.fromText (Nat.toText 123)) (Some 123)
|
||||
|
||||
checkEqual "Int.toText (1)" (Int.toText +0) "0"
|
||||
checkEqual "Int.toText (2)" (Int.toText +10) "10"
|
||||
checkEqual "Int.toText (3)" (Int.toText -1039) "-1039"
|
||||
checkEqual "Int.fromText (1)" (Int.fromText "+0") (Some +0)
|
||||
checkEqual "Int.fromText (2)" (Int.fromText "a8f9djasdlfkj") None
|
||||
checkEqual "Int.fromText (3)" (Int.fromText "3940") (Some +3940)
|
||||
checkEqual "Int.fromText (3)" (Int.fromText "-3940") (Some -3940)
|
||||
checkEqual "Int.fromText (4)" (Int.fromText "1000000000000000000000000000") None
|
||||
checkEqual "Int.fromText (5)" (Int.fromText "-1000000000000000000000000000") None
|
||||
checkEqual "Int.fromText (6)" (Int.fromText "1.5") None
|
||||
checkEqual "Int <-> Text roundtrip (1)" (Int.fromText (Int.toText +123)) (Some +123)
|
||||
checkEqual "Int <-> Text roundtrip (2)" (Int.fromText (Int.toText -123)) (Some -123)
|
||||
|
||||
checkEqual "Float.toText" (Float.toText 1.1) "1.1"
|
||||
checkEqual "Float.fromText (1)" (Float.fromText "1.5") (Some 1.5)
|
||||
checkEqual "Float.fromText (2)" (Float.fromText "Hello world!") None
|
||||
|
||||
checkEqual "Char.toText" (Char.toText ?a) "a"
|
||||
|
||||
checkEqual "Text.toCharList: empty" (Text.toCharList "") []
|
||||
checkEqual "Text.toCharList non empty" (Text.toCharList "abc") [?a, ?b, ?c]
|
||||
checkEqual "Text.fromCharList: empty" (Text.fromCharList []) ""
|
||||
checkEqual "Text.fromCharList: non empty" (Text.fromCharList [?a, ?b, ?c]) "abc"
|
||||
|
||||
checkEqual "Text ut8 roundTrip" (fromUtf8 (toUtf8 "Hello, World!")) "Hello, World!"
|
||||
|
||||
text.debug.tests = do
|
||||
checkEqual "Debug.evalToText (1)" (Debug.evalToText 3) "3"
|
||||
checkEqual "Debug.evalToText (2)" (Debug.evalToText "hello") "\"hello\""
|
||||
|
||||
catchMsg p = match catchAll p with
|
||||
Left (Failure tl msg v) -> msg
|
||||
_ -> "Success!"
|
||||
|
||||
checkEqual "bug (1)" (catchMsg do bug 3) "builtin.bug"
|
||||
checkEqual "bug (2)" (catchMsg do bug "hello") "builtin.bug"
|
||||
checkEqual "todo (1)" (catchMsg do todo 3) "builtin.todo"
|
||||
checkEqual "todo (2)" (catchMsg do todo "hello") "builtin.todo"
|
||||
|
||||
check "Debug.trace" do
|
||||
Debug.trace "First message " 3
|
||||
Debug.trace "Second message" "hello"
|
||||
true
|
||||
|
||||
checkEqual "Debug.watch" (Debug.watch "Watch" 3) 3
|
||||
|
||||
text.term.tests = do
|
||||
check "Link.Term.toText works for ability constructors" do
|
||||
match catchAll '(Link.Term.toText (termLink abort)) with
|
||||
Left f -> false
|
||||
Right _ -> true
|
||||
|
||||
text.matching.tests = do
|
||||
check "String literal matching: empty" do
|
||||
match "" with
|
||||
"" -> true
|
||||
_ -> false
|
||||
|
||||
check "String literal matching: non empty" do
|
||||
match "example" with
|
||||
"example" -> true
|
||||
_ -> false
|
||||
|
||||
check "String literal matching: default" do
|
||||
match "example" with
|
||||
"" -> false
|
||||
_ -> true
|
||||
|
||||
use Pattern many or run isMatch capture join replicate
|
||||
use Text.patterns literal digit letter anyChar space punctuation notCharIn charIn charRange notCharRange eof
|
||||
|
||||
checkEqual "Pattern api (1)" (run digit "1abc") (Some ([], "abc"))
|
||||
checkEqual "Pattern api (2)" (run (many letter) "abc11234abc") (Some ([], "11234abc"))
|
||||
checkEqual "Pattern api (3)" (run (literal "abc") "abc") (Some ([], ""))
|
||||
checkEqual "Pattern api (4)" (run (many punctuation) "!!!!,,,...") (Some ([], ""))
|
||||
checkEqual "Pattern api (5)" (run (charIn [?0,?1]) "0") (Some ([], ""))
|
||||
checkEqual "Pattern api (6)" (run (notCharIn [?0,?1]) "0") None
|
||||
checkEqual "Pattern api (7)" (run (many (notCharIn [?0,?1])) "asjdfskdfjlskdjflskdjf011") (Some ([], "011"))
|
||||
checkEqual "Pattern api (8)" (run (capture (many digit)) "11234abc") (Some (["11234"], "abc"))
|
||||
checkEqual "Pattern api (9)" (run (join [many space, capture (many anyChar)]) " abc123") (Some (["abc123"], ""))
|
||||
checkEqual "Pattern api (10)" (run (join [capture digit, capture digit]) "12abc") (Some (["1", "2"], "abc"))
|
||||
checkEqual "Pattern api (11)" (run (capture (many (charRange ?a ?z))) "hi123") (Some (["hi"], "123"))
|
||||
checkEqual "Pattern api (12)" (run (capture (many (notCharRange ?, ?,))) "abc123,") (Some (["abc123"], ","))
|
||||
checkEqual "Pattern api (13)" (run (capture (many (notCharIn [?,,]))) "abracadabra,123") (Some (["abracadabra"], ",123"))
|
||||
checkEqual "Pattern api (14)" (run (capture (many (or digit letter))) "11234abc,remainder") (Some (["11234abc"], ",remainder"))
|
||||
checkEqual "Pattern api (15)" (run (replicate 0 1 patterns.letter) "123") (Some ([], "123"))
|
||||
checkEqual "Pattern api (16)" (run (capture (replicate 5 7 patterns.digit)) "1234567,abc") (Some (["1234567"], ",abc"))
|
||||
checkEqual "Pattern api (17)" (run (capture (replicate 4 4 patterns.letter)) "aaaab123") (Some (["aaaa"], "b123"))
|
||||
checkEqual "Pattern api (18)" (run (capture (replicate 1 5 (or digit letter))) "1a2ba aaa") (Some (["1a2ba"], " aaa"))
|
||||
checkEqual "Pattern api (19)" (run (capture (replicate 0 1 (join [literal "a", literal "b"]))) "ac") (Some ([""], "ac"))
|
||||
checkEqual "Pattern api (20)" (run (join [many letter, eof]) "aaaaabbbb") (Some ([], ""))
|
||||
checkEqual "Pattern api (21)" (run (join [many letter, eof]) "aaaaabbbb1") None
|
||||
checkEqual "Pattern api (22)" (isMatch (join [many letter, eof]) "aaaaabbbb") true
|
||||
checkEqual "Pattern api (23)" (isMatch (join [many letter, eof]) "aaaaabbbb1") false
|
||||
checkEqual "Pattern api (24)" (isMatch (join [literal "abra", many (literal "cadabra")]) "abracadabracadabra") true
|
||||
checkEqual "Pattern api (25)"
|
||||
(run (captureAs "goodbye" (literal "hello")) "hello")
|
||||
(Some (["goodbye"], ""))
|
||||
|
||||
char.class.tests = do
|
||||
check "Char.Class: any" do Char.Class.is Class.any ?a
|
||||
check "Char.Class: any (2)" do Pattern.isMatch (Text.patterns.char Class.any) "a"
|
||||
|
||||
c: Nat -> Char
|
||||
c n = Char.fromNat.impl n
|
||||
|
||||
run class y n =
|
||||
ok = Char.Class.is class
|
||||
ok' = Pattern.isMatch (Text.patterns.char class) << Char.toText
|
||||
ok y && not (ok n) && ok' y && not (ok' n)
|
||||
|
||||
check "Char.Class.alphanumeric (1)" do run Char.Class.alphanumeric ?a ?-
|
||||
check "Char.Class.alphanumeric (2)" do run Char.Class.alphanumeric ?3 ?-
|
||||
check "Char.Class.upper" do run Char.Class.upper ?A ?c
|
||||
check "Char.Class.lower" do run Char.Class.lower ?a ?C
|
||||
check "Char.Class.number" do run Char.Class.number ?3 ?z
|
||||
check "Char.Class.punctuation" do run Char.Class.punctuation ?! ?p
|
||||
check "Char.Class.symbol" do run Char.Class.symbol ?£ ?s
|
||||
check "Char.Class.letter" do run Char.Class.letter ?l ?3
|
||||
check "Char.Class.whitespace" do run Char.Class.whitespace ?\s ?f
|
||||
check "Char.Class.control" do run Char.Class.control (c 20) ?f
|
||||
check "Char.Class.printable" do run Char.Class.printable ?f (c 20)
|
||||
check "Char.Class.mark" do run Char.Class.mark (c 769) ?f
|
||||
check "Char.Class.separator" do run Char.Class.separator (c 160) ?f
|
||||
|
||||
check "Char.Class.not" do run (Char.Class.not Char.Class.letter) ?3 ?c
|
||||
check "Char.Class.and" do run (Char.Class.and (Char.Class.printable) (Char.Class.whitespace)) ?\s ?a
|
||||
check "Char.Class.or (1)" do run (Char.Class.or (Char.Class.letter) (Char.Class.number)) ?3 ?!
|
||||
check "Char.Class.or (2)" do run (Char.Class.or (Char.Class.letter) (Char.Class.number)) ?a ?!
|
||||
check "Char.Class.range (1)" do run (Char.Class.range ?a ?c) ?a ?d
|
||||
check "Char.Class.range (2)" do run (Char.Class.range ?a ?c) ?b ?d
|
||||
check "Char.Class.range (3)" do run (Char.Class.range ?a ?c) ?c ?d
|
||||
check "Char.Class.range (4)" do run (Char.Class.range ?a (Optional.getOrBug "testing non-literal chars" (List.head (Text.toCharList "c")))) ?c ?d
|
||||
check "Char.Class.anyOf (1)" do run (Char.Class.anyOf [?a, ?b, ?c]) ?a ?d
|
||||
check "Char.Class.anyOf (2)" do run (Char.Class.anyOf [?a, ?b, ?c]) ?b ?d
|
||||
check "Char.Class.anyOf (3)" do run (Char.Class.anyOf [?a, ?b, ?c]) ?c ?d
|
@ -1,81 +0,0 @@
|
||||
|
||||
-- more complex certificate scenario, with a root CA,
|
||||
-- an intermediate CA, and a website (registered as "example.com")
|
||||
|
||||
-- more complex certificate scenario, with a root CA,
|
||||
-- an intermediate CA, and a website (registered as "example.com")
|
||||
|
||||
siteKey = "-----BEGIN PRIVATE KEY-----\nMIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQC/gjZrabSInd+J\n+lZmWW/qdDGRrMFyzE2n2rTfZ0ueszZb9lTZIHl4xPsN1hvP/wd48Dy+t9Dmp3LH\npxPVT7LXPGiTgkmQzaRwPa1cos6FYwbRb2lC7GnT9BueXNUvl5DhyHsl+E4DDRwL\nb51GYRiCouSqDuuMLSAA2nVD/8AHwYRAQciaShji6EShJPpFaipq5A20Vp8tW509\nlaRqSYbRbLUsiiboisrOV1600vyxCQUT9MyRwqEm25mrNeuf7fKSdhRmhjSBGBZ7\nHT12OxuPqpl5b0TroTZRBQfFUnM1kCvZS/uK+SvWm8C9/nUzS0z0xum2XS08c1VG\nbTxZMF6zAgMBAAECggEAWDm0uGdKNGYGxZn+k8hANtKww1vDAw/79ohbK1B7FfGZ\n6WPiUuUTEQAuaIFq7reeyahjU7l7E8ewqSnfiTXePiomQ06SdZNHXi4L39FhMzIb\nwgCBjcM8PdkHoD1EOVip9lpV4Xgy+FThxqL04ad5kzVYAsA846cmRz5dJ6Z64RcJ\npGdxENMGqfOKPf4ZJMaU3J7zqlyWaixWG1p0mU079LjMsumCHhE9QJ6XIStgf+RE\nhe+U6UVPE0v+zxrSCrfLpFzuEeNONsl91umxcabV9C0sohd0o7LsEZgj1u62HWSx\nXUnuCE/zbWvkPF8jAUebYfOE9bxW86O0PLCffawCAQKBgQDlJ0CDEaOfb9j+okkq\n5AfDzV7Ci3yR9CVktWeH1vLHhaui507wTL1vs5pyhjZ+bs63zt58uLHMKJtKmX37\nA0UnpCVHg+BYV/UzLhFZGtXxzbABPosdfJ/+M+cYXDyQ68dleAU6DB+2b1FCbzwq\nDu8Wmnn5E0g8P3HROPEgIIPZ4wKBgQDV8eyaqU+V1D64e98BapyntRgUrc0oKdu6\n10Sh5wdWrnpguKEw2K/0zBZlVUEtK812BL9CNNMIm8zXDBMY24ZHo8NH8Y8z/G/o\nC7pJVNAjbHu9rglE6f0mtdcSa4F9yx37rfeRLgKZ628+nFSucgGdyL3BNiG40rlG\ndRd6qKLA8QKBgHPQDLixV4Ki4oZ+un/k00/QIY4tNP4G6Ecnr3Vl2zmfgwlH4gts\nnWkw2mP7FNt9YRhggu2B4soN0742KQeNtYu9V+H28pFzkscVB0uDVpFopQVb+K8k\nZy/wR2F2bF3J6/KKYAngSr7HL8hls4CGH6vK0s5hQmbAoeNd5e+Yv0qFAoGAQkuZ\nGcPlWXRPizM3Q2UZ7g37zEyfChcOc7NJHTJN39ppKZeMu2op/B1Rw0zLyYeNP0jx\nSz67NiuxKeIf+M/tqD1iweRkj6Nlue4IZ7jUVmXDYl+Pl786JsiqQJb3pVdPjzG1\nSVOMks2Vxz0CMJw7S/1sb3aqtG734pFeGTAwXsECgYAX5Fpbqwi0N26jkCSa4oYy\nKxVO0DfAcA51oYaQ/Pwreq1zOKv1xL2b6EeNmtSVvCSr7Ee8cBsPG+gPF3OJACQQ\navwixN1uJhO9nDrSgTcLCZzLPT/GIOjOTBIR1dlQg76+CkCdjc/Ip4opLoSn8cP1\nTAlVfAt2xOabNxk0gFEDpg==\n-----END PRIVATE KEY-----\n"
|
||||
-- site certificate, example.com
|
||||
siteCert = "-----BEGIN CERTIFICATE-----\nMIIEWDCCAkCgAwIBAgIBATANBgkqhkiG9w0BAQsFADBCMQswCQYDVQQGEwJVUzEL\nMAkGA1UECBMCTU8xDzANBgNVBAoTBkV4Um9vdDEVMBMGA1UEAxMMaW50ZXJtZWRp\nYXRlMB4XDTIzMDMyNzE1MDQ0NloXDTMwMDYyODE1MDQ0NlowNTELMAkGA1UEBhMC\nVVMxEDAOBgNVBAoMB0V4YW1wbGUxFDASBgNVBAMMC2V4YW1wbGUuY29tMIIBIjAN\nBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAv4I2a2m0iJ3fifpWZllv6nQxkazB\ncsxNp9q032dLnrM2W/ZU2SB5eMT7DdYbz/8HePA8vrfQ5qdyx6cT1U+y1zxok4JJ\nkM2kcD2tXKLOhWMG0W9pQuxp0/QbnlzVL5eQ4ch7JfhOAw0cC2+dRmEYgqLkqg7r\njC0gANp1Q//AB8GEQEHImkoY4uhEoST6RWoqauQNtFafLVudPZWkakmG0Wy1LIom\n6IrKzldetNL8sQkFE/TMkcKhJtuZqzXrn+3yknYUZoY0gRgWex09djsbj6qZeW9E\n66E2UQUHxVJzNZAr2Uv7ivkr1pvAvf51M0tM9Mbptl0tPHNVRm08WTBeswIDAQAB\no2YwZDAdBgNVHQ4EFgQUS34Lu4VpXUCCre6QxCAZdyAzgN4wHwYDVR0jBBgwFoAU\n27OdzRI7IREkMewS5n+F4ovzl/4wEgYDVR0TAQH/BAgwBgEB/wIBADAOBgNVHQ8B\nAf8EBAMCAYYwDQYJKoZIhvcNAQELBQADggIBAGBkXgWoAzum/f/VgJWKPt8Bo9Dy\nLYjckSbaQcw0YmgXLzJn71QTD+jvSbGRT2tYSkgCVOlVLzHV6mtgC/tR7gfKWmkx\nEhnTdzGQ3G/y03+c2newwkDrvT35/4BLlsrJv/19/LIc6OJ0/BJOBIeb4dZGmo2N\nH0qgIvjpuV9BAzwc7euENob0K2jkhFTUi5WmXMBzT2besc1T9iGz0wUpn5osGc/7\nCVcEPdvrwOLfi7jqhxC7tTzbZO8qu7MmmqaSx4UbDVM84652HTbDpSbEeHeD122D\nJcAFE8ouoDKRttxk+N9yT6lBzJIV8UmkabDiymceQ8fmh2CsIog/aodskLszcUHL\nlqc2KOAe6qVEc+vVLBj3/Duqy7F+Z0f/S/s1hbRawW95bJJJOFhHW5wErCPlKH0O\ndzNxC/mmAEuf39JAm9K1Pbi4dr92rck8C9llp/xyUUT7gIkZx562RmkBftcf3+29\nQe7MJGTHHN1FXfVK/F7C6pFeSVogeR28klCnD2LnrFFvdFtLa9uht2o82dPXN88B\nDMVCPgP1hUvXWkPEdKol69zMxQf8GANHWLGpJaoqcsVGmwHaitpeCMCwrtDi0Y91\nvrL+QoXpJPd5FaDdQHo+Pln7O6hU6euzVibi9WdAFxs1w/neWhyzJbUcJZ70aHPM\n77PNweTWNCaNkP+Y\n-----END CERTIFICATE-----"
|
||||
-- intermediate certificate
|
||||
intermediateCert = "-----BEGIN CERTIFICATE-----\nMIIFXTCCA0WgAwIBAgIBATANBgkqhkiG9w0BAQsFADA6MQ0wCwYDVQQDEwRyb290\nMQ8wDQYDVQQKEwZFeFJvb3QxCzAJBgNVBAYTAlVTMQswCQYDVQQIEwJNTzAeFw0y\nMzAzMjcxNTAxMTNaFw0zMDA2MjgxNTAxMTNaMEIxCzAJBgNVBAYTAlVTMQswCQYD\nVQQIEwJNTzEPMA0GA1UEChMGRXhSb290MRUwEwYDVQQDEwxpbnRlcm1lZGlhdGUw\nggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCuBOyOUa/oleaNPAZ0qVS9\nYABi+FNeflM7dmRMIq01m8qiIaVV9dNl4jgHYMq7iBhZU+re1hFq1J+d4wDMctDj\nH8KreEmOSYiAqI9n4/g//Y5z+QeMEcIjqppyVCVQqvXOYzvHHS/bvObKF2cs+FRc\nURWIXM99D7/IgqiyGilhjWLqd8pLOWs58MjZyEBdJlS7NTFJDFKsK8EvrPMwVVx6\nVUZaCJyTdK0ZtbA/eNEJk76LTSA9+WqIbDqrWjhP3j0DVg9CdFCJvvdiSNHpw8W8\nCC3V1r3+J8rK9zSYYmV6Yvn1sDVJX2CnPvnFJrjsGiROpzwd5zo3K190shjAAsHG\ngJokSahQtwKVz8vaCLb/hIGPa1GWonSTqaNCcWI3pH9GWuZXFVFxuw/FNDmUU9eN\ndMxXTx64huX+FpDx5NZYre9W/Gb0VYIPRdVF/vWswmW1i1Zz9NZrP00X9IRFimjM\nOHVwJ1NaTnGzg/uu8SbzKc9pc+zocdJwMqiwICHbcIN4JTDYwDsbTS/moJUk+oJw\n5OiL1KZQ4HoTCJpmx1nVZocMVQuajEILyEDiRF3h670TNNnkfoFcPnM293IMWPwX\neC5MoADlpzMpTeHcdlkIkgw9/1ainOGYa1B+1d7/V07Tfq2nOKQUY/4Z/WeLEhPm\nfjF9C333Yz6MLlGN8DMKawIDAQABo2YwZDAdBgNVHQ4EFgQU27OdzRI7IREkMewS\n5n+F4ovzl/4wHwYDVR0jBBgwFoAUY2dM5JVlK9JVFFb3mZrJXd1YO8owEgYDVR0T\nAQH/BAgwBgEB/wIBADAOBgNVHQ8BAf8EBAMCAYYwDQYJKoZIhvcNAQELBQADggIB\nACkow/OmLPd2DzrsBhDvlGQ29ZYKuvGCVFlT0PSWFbu+5DD2HFrKffaBTeuEAY2k\n3d8HJE7CtyxOSl5vFDSfr9si4EmvFeWN0d+2n3AGLUxxC18XsW6ctTnQkpvcOMEk\nm9Opu6q4JNWP+iWle9U3+RC8suotWc1trGBk1y7yHfFmqim1aoxygS1xUpo1j/8L\n+W00sxprog48E0tQ2/AML+yKmXwt5QapO3e0UIoOkYaSyapk+K3KymvCFmwsU/7Q\n0+KJBiCS4HXUFe5iWpnoCuLL18o1gO6LPW9nBB6EIKnmcsZNt/Z9KRMoQeBS+eRY\nGOxxJwdyzDJAFEKPhIO4xrZtG505Ea73nm6NqoRYUERLDBUFY1BnECcBKqSZmmVi\n4zNQj5d6sevliLx/V3LDa/BPkHjDalHgZxEEkTCGfppTYC5oAB4eOwJWhpM+n2gM\n18gmbmN7ECUWw9jvQrKMGepp4s9ggtf6gyqqCvMtfP9i25OGX860VcvxCV7yqjjh\n58Nwkn5WK9ZnUXZLb9h34KjKenxzlXad+j761OpQ3fh9DuK1H0EmdrkPgnHCUT+3\nEWM+rtnhl/XAZ453InJXdG0yiGgM0uoXDHi8iuVaBkOiY27e6jg9LPg6zq3Kju6C\nVzlYLIwqPf6AAPL+ugUbnH/zNfy6JXdDlufQ/ZcFLjLj\n-----END CERTIFICATE-----"
|
||||
-- root (self-signed) certificate
|
||||
rootCert = "-----BEGIN CERTIFICATE-----\nMIIFSjCCAzKgAwIBAgIJAJBvc61E2pT1MA0GCSqGSIb3DQEBCwUAMDoxDTALBgNV\nBAMTBHJvb3QxDzANBgNVBAoTBkV4Um9vdDELMAkGA1UEBhMCVVMxCzAJBgNVBAgT\nAk1PMB4XDTIzMDMyNzE1MDA0OVoXDTMzMDMyNDE1MDA0OVowOjENMAsGA1UEAxME\ncm9vdDEPMA0GA1UEChMGRXhSb290MQswCQYDVQQGEwJVUzELMAkGA1UECBMCTU8w\nggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDOeole9DHTycMh669FgRUw\ngch3RAb3TPhN9mwEnnIb7WhaUU+wltpImedYbUBrh89w+eF34OZ3yIXvdpKv3ihI\na8ucZDCGJK4mPw0UKLfBoplGM0u+eXMFQsX08OvZmGf1kTkIlhOkSpIwZK8N1Dn8\nVmOs1t1xSdxecJ8cc+3IE25qCRE66x0g175XkoZ0At5M2ZlzWBP00H2N1cXpXbIb\nZ7IdsMRtI00WI3f/MMFasFhTO9c/8iRNjLsoCuOIUDjy8m4AGX0tPmV6FQV6WMNA\ng+6U+rkWo4wdxbQhAbfMQHIU9wm0Tj0lXAh7ma3zlIbaZjG6EEZWGUOedknf+IfO\n2VGR3T9WoTyfNGIOqBHtKhDiB0PcPa5mw+KsN1UycFvIxH6aJkXq04nnnZkNEFNd\n7F0jhPt6O0K14y08yEmZqT1HJQCHQdEierDQo+u7R0sJ4zTlDxogvVyftPWtgXYk\nd6OfWgS1Qk/qRrtRnLtf13dkv0ia7Ndr2Ua5j4T80StIxyoFNUKHOelep7iO33E7\nHjCcuNVPdeOZSmLzUjwu5DSKQnHyHXlIrktgPNDTAzhx2WGr84Fs4jMKXrntjRM2\n7P0k/70ZUM7R5jbgVvnTQAl7y5+oWWySw7Oigrme0PDP0ZESVMeNl1NcxnqtLO8l\nbaVTVFtB/dz3VP1J0om51QIDAQABo1MwUTAdBgNVHQ4EFgQUY2dM5JVlK9JVFFb3\nmZrJXd1YO8owHwYDVR0jBBgwFoAUY2dM5JVlK9JVFFb3mZrJXd1YO8owDwYDVR0T\nAQH/BAUwAwEB/zANBgkqhkiG9w0BAQsFAAOCAgEAYd0hcSjSBhUCdibKdLbzglyq\nSYeQlSEuqmeNQDpDVbnWTsPK+LQ66Nj1kAuITWdpdn9wnA1Gp2P45PR1sc7d1eI6\nj4NvoOQMSwZtxt+3+ZncZMBf96VZwdX5v3ydk3pZy0KhwiKI/aaHRU5WneibLs+F\nisBUlUNolALPMgmV47gN/jlGqZRrHi1cOZVLs10q9p5TMEm1JuFOAjk3RINo2EzE\nz3oA4CtC+8wmKi0SqvQF1wxV1fJXh4oTXYCaq6feFBsTqUYpA9GjciYH4h/Ihe2/\nSBhBXSYXcMdamglZwsKnVZ7zqkhJlARQC0NnSwmVK4B6vIlm0ImEcsRFwo/6xmML\nZu8EQAu7h3cSS6p9ghHqeuKgEltiiNVCvJim/9R6Z9DjdVQJnPnDtTofKoCkmgVE\nFe7hGIKdrFmP0zKRPAiUuaHLDsvayUUsFAgc3bGr8YPPTwCtk5RlRAdwofsliAN0\n5FIkDM2ftCc1Kh4mE3HBoB5JYhH9WqhoeDlCpp242RxiVVsmgPxkGaEIzL7Q0/X8\nIFrhTaIWPPsF9PJtwswEePGO56tIXaQTV9ct3vfYIxrJp+iG11wqRn8FgFset17V\n/MMsxyRqBDCznAykoViCFrfolZpjcdtVr/m9vVhR4YkUZlG8VDi7BTD6AaDEBkOM\nImFGWriD+Irt4Ubr/D4=\n-----END CERTIFICATE-----"
|
||||
-- root key
|
||||
rootKey = "-----BEGIN RSA PRIVATE KEY-----\nMIIJJwIBAAKCAgEAznqJXvQx08nDIeuvRYEVMIHId0QG90z4TfZsBJ5yG+1oWlFP\nsJbaSJnnWG1Aa4fPcPnhd+Dmd8iF73aSr94oSGvLnGQwhiSuJj8NFCi3waKZRjNL\nvnlzBULF9PDr2Zhn9ZE5CJYTpEqSMGSvDdQ5/FZjrNbdcUncXnCfHHPtyBNuagkR\nOusdINe+V5KGdALeTNmZc1gT9NB9jdXF6V2yG2eyHbDEbSNNFiN3/zDBWrBYUzvX\nP/IkTYy7KArjiFA48vJuABl9LT5lehUFeljDQIPulPq5FqOMHcW0IQG3zEByFPcJ\ntE49JVwIe5mt85SG2mYxuhBGVhlDnnZJ3/iHztlRkd0/VqE8nzRiDqgR7SoQ4gdD\n3D2uZsPirDdVMnBbyMR+miZF6tOJ552ZDRBTXexdI4T7ejtCteMtPMhJmak9RyUA\nh0HRInqw0KPru0dLCeM05Q8aIL1cn7T1rYF2JHejn1oEtUJP6ka7UZy7X9d3ZL9I\nmuzXa9lGuY+E/NErSMcqBTVChznpXqe4jt9xOx4wnLjVT3XjmUpi81I8LuQ0ikJx\n8h15SK5LYDzQ0wM4cdlhq/OBbOIzCl657Y0TNuz9JP+9GVDO0eY24Fb500AJe8uf\nqFlsksOzooK5ntDwz9GRElTHjZdTXMZ6rSzvJW2lU1RbQf3c91T9SdKJudUCAwEA\nAQKCAgAyZxstgLLBHllx6FSKxO3lP2kuI/8HU1Sxw1uu7Pax9owor/yiANEcM+WT\nYmf9V9O9omH1n4Li7qIzSGCaacKvmxDDBnoJ5N5WG8IXj7D7pbOAvXjZ8E+xkxE7\nr6wDG/8UpPSlMe1th36ULZ/F4m6dOIFwaar4wqz2qMtOaMY8tvGXFMuN9GLR55hh\nTDViEGkvnVamH3QPqO1dODfttZ+KrQ9/y+zHL3zb0KC0PLSWbMHC37K1u2g9PgNZ\nzP6qAdtFAwTzJUW3S6n92S/TI+PV1d7hoyqXaikEA4TrIb46L+kpUPyfdRHcEtFH\nSsZ51WHt4lB1OQ/SaKxm/D0gXUzZMrQ6IWz0r3qCrX9PxOmLYs5xWIe2mU+Igd2H\nnfnJB9XX3i8uuppCIOUncnh9jicR3qwSxiVc3irpV8+42KqTWbJLLlXo4i6bDoQH\nHdWp5bAYouWkCotoFKGRGU01OsUca+Fu+k3e+w0IfI2oO5yS05X9jhzCMjoUxg/d\ngcSdrttqcu1m23CDahnthZ95C3HlbAXj1hGDAxrePOg8GC/avi6EJnRS28hvIOVo\n825U14Qi0317328r1GROnA94qw2z7HYKh6r/d8jVYG1YNLdgfUP80UIFVR6XKVW4\nWuxFgwrcQ38Bpyj6+tXuLROWO5s6McgjxGq/AtA/ixVFg9CI6QKCAQEA/9VJbXue\n+51hY++m9KM84JmcTzakOJw9znCPqak927A9WTUiPiRTUXB4/RJOXS5xht2zGQB4\nihfOfv7AGvKGq0xAbvFeb1KK1C6S7lut8u58jyy+HQO73NV4mEEkE85JD9P4TuLT\nFQHRaCZQTg82TnSl/8MW0WuwhDvk9qHaElXzBmCl1IburKxtHU+X5EkyfVWuJyRI\nkY9KLuaBwe1+EG9+wZJyr5sESPTZSKfqULBkjFnTuJu6OMGSXWC8eWvtwSQhv/DW\n9HPWmWXg9NJ+lGTvz3N9jgjU2RzhAdqtrNpW3t9UoI0O4/OKgdAidC+7zXcmDNoV\njxUYK63UZyc2RwKCAQEAzp0CezyQDRJjrMM6F3SzWo8MgyHPs8+H1AhxTtNN4ML5\n7a+9EiL9AaWSekAkyEHCOCYoJzvUmx7QbtJmpvLWXz1HF9iSuNXhJUqPWoflNPc4\n4sPnkyP0KIrmzVzF+vKp0MEsR8Qv7pO2l3+1ub63scVPqR0dMs+yPaMcxaisVs2B\nThYvhLciORwtbWYCfOKy/KdX/a72HKiFpVHcvQSN+WsTjYn+e7y+kNrVisg4dCwI\n9E+DBU5MeuhAaI9c4cDXZPm0dcOhyL+FBm2VQdYV1hq8e7HvN4AXyOgVP2FygxoJ\nN2L19uH4OQpav8oTrgDEmNBpkOGsvmsmgkzruIuxAwKCAQBkateTfb59jNy5WUvz\nIk+26RSNkykKf2lTKqN5ONDq9lZeOZjjQ2bgxID49MKFmME+6q5t1d16drW660uE\nSEXL3vY7lco3b/LGLjHGFX5FqI6DtFA7G0gV+kSHnqoGjCXpbI4+iJHJ4RjNBJzo\nxtfOG8M8jNrcAKUcglXw6L6sC8iEbFMrBHuSk2uQ4bkBBionQAZHntpNKC06E4hD\nEnE1Ck56tH0HqJUZ/eF7v00dtt8AqBGOmLGTrYdB18Ki9lYwRXpp2KLG+OD2/SI7\ndpPws13d07sokRba0ZcQH0GkY19Nw+N30WZS2zk2kvezGzlgALCSwtdLfkAqhOSm\nSKHpAoIBAH03Ppe9XnftmybKslwgx8msRCL8zMnmjiT8cN8axGnhAGMCTI2/UqI6\n3Ajm8uPCppgs18zfP7w68osXTEsFhNH3ayySfmkyhd55z2NIVKrC4WDc5W2RLpmb\nhMEU5o9tnWj8iX988KegMdqi9Vl6sg00zVBqapWuthEQ15Ea5kc9CI5wd5/w9Paz\nkvxoBD33jg38xSDjdhhsMYK9mA+dwQVV1WXEKcyH2N4lIaGYMk6FmW+m+Hqwtz0N\noGs950aR/ngdtTZht5zYJSB+LSTXQCifz3cPoTB7mu6RaL8eqa22i7tbaEGVNUAs\nfE8bgs3DfWI3fKLngi9s9MunHnybfE0CggEADkWhhMkrhiz67DxY1zQiUl3n6/aj\nsyjMPth1tqsEPWAGBMuwl1Wj60QlsXoJ7FH1mFLcU2cKdOCNQl9CKLC8XNwZ2Ahj\npGnJ1A1LQ3z+87aHcRXDvQr98fg77uOX6KUX4NMrBlzfUatN9OWjj3pLuJ8+XasV\nXKsOKJJZA4icTORfZ+AuRbNVfu5VJ2gejku5m/1Hp6LgJXUUrgbpoLYoyWrtXlY4\nuO05svUtdwceP0QzL+oVZU03I/BNcCuXZidaZvG5v22De8ZBIOQlLNHMXVnnTUUX\nYfJSdqQDgZXzvwMljmnbl9DtWY38FozRpOpHs0cf9gjA73RAsm/eRSeMsQ==\n-----END RSA PRIVATE KEY-----"
|
||||
-- intermediate key
|
||||
intermediateKey = "-----BEGIN RSA PRIVATE KEY-----\nMIIJKAIBAAKCAgEArgTsjlGv6JXmjTwGdKlUvWAAYvhTXn5TO3ZkTCKtNZvKoiGl\nVfXTZeI4B2DKu4gYWVPq3tYRatSfneMAzHLQ4x/Cq3hJjkmIgKiPZ+P4P/2Oc/kH\njBHCI6qaclQlUKr1zmM7xx0v27zmyhdnLPhUXFEViFzPfQ+/yIKoshopYY1i6nfK\nSzlrOfDI2chAXSZUuzUxSQxSrCvBL6zzMFVcelVGWgick3StGbWwP3jRCZO+i00g\nPflqiGw6q1o4T949A1YPQnRQib73YkjR6cPFvAgt1da9/ifKyvc0mGJlemL59bA1\nSV9gpz75xSa47BokTqc8Hec6NytfdLIYwALBxoCaJEmoULcClc/L2gi2/4SBj2tR\nlqJ0k6mjQnFiN6R/RlrmVxVRcbsPxTQ5lFPXjXTMV08euIbl/haQ8eTWWK3vVvxm\n9FWCD0XVRf71rMJltYtWc/TWaz9NF/SERYpozDh1cCdTWk5xs4P7rvEm8ynPaXPs\n6HHScDKosCAh23CDeCUw2MA7G00v5qCVJPqCcOToi9SmUOB6EwiaZsdZ1WaHDFUL\nmoxCC8hA4kRd4eu9EzTZ5H6BXD5zNvdyDFj8F3guTKAA5aczKU3h3HZZCJIMPf9W\nopzhmGtQftXe/1dO036tpzikFGP+Gf1nixIT5n4xfQt992M+jC5RjfAzCmsCAwEA\nAQKCAgAX589DYc9jiSwp3MQaRKTCeyyya+CwC3SNp57xopXe1m8IxMx8uY934JLH\n2LEg//owU0nhoNC1t03SF7wlWeR+Pv+0JIseQ9W/rug8YmHZEJEAN4ak5E+iLK6Y\n5BxYL5Qi7RjqKoVHj3S48GwZDmgwYmct22oZiQ9UkTZxeQyUPSMIiLo+iT3EsOI2\noL7OzRQ4v37sxQeaZUxdq0mhKyjQGWTXu3UfAJlC/eWfYo583VIAuvCh8uCCqzOI\nFJXFywbgrXLdMzNZKOW9F7nWfjFsukbpqF1jS74dEcak5GeCX5Rs/u7jDHovn4Qa\nZE5lCNZSA8FLbldd+tRbKJgj0H0j+IsIi72fDp9bigHvXmvYU0TR97dURj4Ih233\ndAOT1xLnPHm/3haTTwA6dzEh9ghYxj2A1MpyT4EC6fv2j9LP3Uj55Np9FxtSPZfK\nhe6QSILcEon9aqXsWjf7cHWOd7C673+IynbipedhsSO6g8MnARujrXXe1wbWr+Jc\nBsOS7klYT0+RhDfrm5XReDYEsE6TqoZBlvFavCEZuoTEa6hSEe3iFpnArkaPx2il\n1YKkPTk7xR8t1ncq+F11K1R+kCVRXbnPzhxr99u3A70Z4/uB7AXzYp0c8yHlfm+a\nLajcG3aKJWPpJ22XvZIDGt/egg31d+B9fmVlSXZPIRszjEoDiQKCAQEA555QLid/\nZqc5IK411iOJCmTmFsz1jU15odUahZ96sTi9ZHHsY2u3l+GxgaR/HrxZOfStEjGL\ntX5sEeZoAm4uO1fq9P8YiDzGGzUzxnSxYv6cZHXr3Y1CaDIQLIHVqddHGnyesJDx\nV+f2toElFk9qHla5kUEYPQ6xqDAn2LVdHlYvVDNU4R+ONPb7NiGuOG7b5kc+5Pqh\nWkw0iGd+VAEzrLaBNxlximMfe3VjgvD0LvBV8Dc33xPe6QI6QVnLJV6vxBlnDyiR\n2gCxtGTxgh8RmH/ly8on59MM7IJjQWWfDTvlSqJ+FiaHaHCNlR4tfr4MzSCh3a65\nNnDNXG847dSzXwKCAQEAwFZreSKBLV69wCnNBSGArpIBfeHstBEoCSf0903ub+KF\nOhoY+jksJS8AhT1xIgvMOftDdzXS0p49Kx0dsgdEsLn3IzuO+2itbj4jSiGMTbZN\nLTAYCf86hdQ1aCfGMuHNcvqohICxkEGx3mn4goEDrWsvwTAHANK1kDafZKNL2lgX\nLb+lQp4Z3JxMWYv6Sfzy08Caq/f1FzsJ3/tu4Qb5aYP++cf7rmD7p9wmsB+fAUH6\nFJTw/ZNhiaLC90b59C4KCZScjAh3KqwAePvG1td/RuUbXOhO6RGZGzHXEpxNB5pg\nmWJa8XKDXfHnmf3cHQESI8YPyW/wGL12ubR57qzwdQKCAQEAxcvlzzR90Q1XdPgx\nE5kvK8g00h3gSPZzu+dACgLChVveKUw8wj63/6WGsB7pTDcuv5aawmG7XJgE9Fhe\nVE0BgD45cVXz/kxgJdYOTBlVbyPeLNCjR4Wdw1uVglyyOaOVniH0ZvawlBCNGRg6\nss3I4vXO7SO47lOBFg9hx+hCCGkza+WWQ9Zt2/9bUsP6g0jw07veEy+R4YoYhrBT\nKqwIFCObP5Gj67lwpj7+Z1EcRoWJ7mVJemD+yN/VHf/vww8UbRQAdeqAe7qCB3r4\n39VmcmQuuxT9dTU/4S4MU0nURTn0OwN/R61Jj8AmuMSXt5fXWMnYUXcnxj0Ysyps\nZHZzYwKCAQB2mdOT0q8NJwqi4CPIMiyDeQzqbtHjB2FEpBruFGQfIfM9LLKSOYb7\nNsx/XK/Saqv4ZPPpIotpzKGzYDTbfpfg0guO8j7s0FOBU1e3cpBtqyhT4QAxyexw\ncbatDzmsToi9ics4SZM0fQ4NNBNFhgCagynjWpY277d9wfDvwbIYZZGFaFOjjJIt\n80MxRJuF3DBwWqgFutSrCoDAWO66W+6YHgiwRZzwnmUP0TUaDaWixOhMoLsp4iOX\nF4JZsK6Y33rZBYay4tV4vq9b6wVlnWSidsw0shtWpL9ggY85rp/hPFSswHWLxS00\nVOKXlm6QhASHgq5hbGEFIG+Be8RkZMexAoIBAE9nDwYPHYqsh38flJf61aKzbrg6\nL9l9DEQFaseVQPavqnTHEUJ2ZzGTsDuduZGvy1PwpKltU2vhWDTqfoNQIf76rfml\n84ZsrPtj1Ea0NYKMOtM/mLQhUDy3XDrNEe8VLu/KnWaM+WpYmpKou5MUXF6vjiqZ\nqAF9EEOTwjH9Yl2PgMRqgQdl+uGnLYoAUOJL0K39kLHOl4mA8UujfhdD6EaWsuzp\npxluHdaQMYHBtPf9aqhzNVVSaBBuaOLFuCP76EfTqMhgbWV3ozUmCL+hJu84H8pq\nz2irgWT27g61YCv01a4B6O1ccAtRmKdSu2HEAidY0xVlNEfCrnqaVXXmmfo=\n-----END RSA PRIVATE KEY-----\n"
|
||||
|
||||
customCertChain = [siteCert, intermediateCert, rootCert]
|
||||
|
||||
parseCert text = Either.toException (decodeCert (Text.toUtf8 text))
|
||||
|
||||
defer comp =
|
||||
result = Promise.new ()
|
||||
_ = fork do Promise.write result (catchAll comp)
|
||||
result
|
||||
|
||||
Optional.toException message = cases
|
||||
Some x -> x
|
||||
None -> raise (failure message 0)
|
||||
|
||||
-- client sends then receives
|
||||
chainClient portPromise toSend =
|
||||
use base.IO.net
|
||||
defaultClient = (Tls.ClientConfig.default (HostName.HostName "intermediate") "")
|
||||
tlsconfig = ClientConfig.certificates.set [parseCert rootCert] defaultClient
|
||||
|
||||
sock = Socket.client (HostName.HostName ("127" ++ ".0.0.1")) (Port.Port (Nat.toText (Promise.read portPromise)))
|
||||
tls = Tls.newClient tlsconfig sock
|
||||
tlsock = Tls.handshake tls
|
||||
TlsSocket.send tlsock (Text.toUtf8 toSend)
|
||||
-- res = fromUtf8 (TlsSocket.receive tlsock)
|
||||
TlsSocket.terminate tlsock
|
||||
-- res
|
||||
|
||||
-- server receives then sends
|
||||
chainServer portPromise toSend =
|
||||
use Text toUtf8
|
||||
key = Optional.toException "No private key decoded" <| List.head (decodePrivateKey (toUtf8 intermediateKey)) -- siteKey
|
||||
tlsconfig = Tls.ServerConfig.default [
|
||||
-- parseCert siteKey,
|
||||
parseCert intermediateCert,
|
||||
parseCert rootCert ] key
|
||||
|
||||
sock = Socket.listen (server (Some (HostName ("127" ++ ".0.0.1"))) (Port "0"))
|
||||
port = match sock with ListeningServerSocket sock -> Socket.port sock
|
||||
_ = Promise.write portPromise port
|
||||
sock' = Socket.accept sock
|
||||
-- attach TLS to our TCP connection
|
||||
tls = Tls.newServer tlsconfig sock'
|
||||
tlsock = net.Tls.handshake tls
|
||||
res = fromUtf8 (TlsSocket.receive tlsock)
|
||||
-- TlsSocket.send tlsock (toUtf8 toSend)
|
||||
TlsSocket.terminate tlsock
|
||||
res
|
||||
|
||||
tlsChainTest = do
|
||||
portPromise = Promise.new ()
|
||||
clientSend = "12345"
|
||||
serverSend = "56789"
|
||||
-- Client
|
||||
clientResult = defer do chainClient portPromise clientSend
|
||||
-- Server
|
||||
serverResult = defer do chainServer portPromise serverSend
|
||||
-- Get the results
|
||||
clientReceived = Either.toException <| Promise.read clientResult
|
||||
serverReceived = Either.toException <| Promise.read serverResult
|
||||
-- Check it
|
||||
-- checkEqual "self signed chain client received" serverSend clientReceived
|
||||
checkEqual "self signed chain server received" clientSend serverReceived
|
@ -1,154 +0,0 @@
|
||||
use base.Text toUtf8
|
||||
|
||||
tls.tests = do
|
||||
check "decoding a cert should work" do isRight (decodeCert (toUtf8 selfSignedCert))
|
||||
check "decoding a private key should work" do 1 == List.size (decodePrivateKey (toUtf8 selfSignedKey))
|
||||
check "decoding an invalid private key should ignore" do 0 == List.size (decodePrivateKey (toUtf8 "not a private key"))
|
||||
check "decoding an invalid cert should fail" do isLeft (decodeCert (toUtf8 "not a cert"))
|
||||
!testConnectSelfSigned
|
||||
!tlsChainTest
|
||||
expectError' "self signed with the wrong hostname should fail" ["NameMismatch", "certificate verify failed"] testConnectSelfSignedWrongHost
|
||||
expectError' "self signed with an unknown CA should fail" ["certificate has unknown CA", "certificate verify failed"] do
|
||||
portPromise = Promise.new ()
|
||||
toSend = "12345"
|
||||
-- Server
|
||||
serverResult = defer do serverThread portPromise toSend
|
||||
-- Client
|
||||
Either.toException !(testClient None "test.unison.cloud" portPromise)
|
||||
expectError' "self signed wrong host" ["NameMismatch", "certificate verify failed"] testConnectSelfSignedWrongHost
|
||||
-- -- TODO: Enable this once scheme output correctly escapes \r
|
||||
-- check "connects to example.com over tls" tls.example.com
|
||||
expectError' "wrong host example.com fails" ["NameMismatch", "certificate verify failed"] do
|
||||
socket = Socket.client (HostName "example.com") (Port "443")
|
||||
config = ClientConfig.default (HostName "examplez.com") ""
|
||||
tls = base.IO.net.Tls.newClient config socket
|
||||
_ = base.IO.net.Tls.handshake tls
|
||||
()
|
||||
-- expectError "trying to connect to example.com:443 without tls fails" "Connection reset" do
|
||||
-- socket = Socket.client (HostName "example.com") (Port "443")
|
||||
-- Socket.send socket (toUtf8 "GET /index.html HTTP/1.0\r\n\r\n")
|
||||
-- Socket.receive socket
|
||||
|
||||
reencode.cert bytes =
|
||||
match (decodeCert bytes) with
|
||||
Right cert -> encodeCert cert
|
||||
_ ->
|
||||
Tests.fail "Unable to decode certificate" (fromUtf8' bytes)
|
||||
bug "failed decoding"
|
||||
|
||||
fromUtf8' bytes = match catch '(fromUtf8 bytes) with
|
||||
Right text -> text
|
||||
Left _ -> "the bytes aren't utf8-encoded?"
|
||||
|
||||
reencode.priv bytes =
|
||||
match (decodePrivateKey bytes) with
|
||||
key +: [] -> encodePrivateKey key
|
||||
_ ->
|
||||
Tests.fail "Unable to decode private key" (fromUtf8' bytes)
|
||||
bug "failed decoding"
|
||||
|
||||
tls.cert.codec = do
|
||||
bytes = (toUtf8 selfSignedCert)
|
||||
once = reencode.cert bytes
|
||||
twice = reencode.cert once
|
||||
checkEqual "encode a decoded certificate" once twice
|
||||
|
||||
-- lol the haskell impl for encodePrivateKey doesn't produce the correct type,
|
||||
-- and also doesn't really encode it? what
|
||||
tls.private.codec = do
|
||||
bytes = (toUtf8 selfSignedKey)
|
||||
once = reencode.priv bytes
|
||||
twice = reencode.priv once
|
||||
checkEqual "encode a decoded private key" once twice
|
||||
|
||||
tls.example.com = do
|
||||
socket = Socket.client (HostName "example.com") (Port "443")
|
||||
config = ClientConfig.default (HostName "example.com") ""
|
||||
tls = base.IO.net.Tls.newClient config socket
|
||||
conn = base.IO.net.Tls.handshake tls
|
||||
TlsSocket.send conn (toUtf8 "GET /index.html HTTP/1.0\r\nHost: example.com\r\n\r\n")
|
||||
response = TlsSocket.receive conn
|
||||
TlsSocket.terminate conn
|
||||
contains "HTTP/1.0 200 OK" (fromUtf8 response)
|
||||
|
||||
testConnectSelfSigned = do
|
||||
portPromise = Promise.new ()
|
||||
toSend = "12345"
|
||||
-- Server
|
||||
serverResult = defer do serverThread portPromise toSend
|
||||
-- Client
|
||||
received = clientThread "test.unison.cloud" portPromise
|
||||
_ = Either.toException <| Promise.read serverResult
|
||||
-- Check it
|
||||
checkEqual "self signed should connect & receive what we sent" toSend received
|
||||
|
||||
matchesOne matchers text = match matchers with
|
||||
[] -> false
|
||||
one +: rest -> if Text.contains one text
|
||||
then true
|
||||
else matchesOne rest text
|
||||
|
||||
expectError' msg matchers fn = match catchAll fn with
|
||||
Left (Failure _ message _) ->
|
||||
if matchesOne matchers message
|
||||
then
|
||||
Tests.pass msg
|
||||
else
|
||||
Tests.fail msg ("Unexpected exception found " ++ message)
|
||||
Right _ ->
|
||||
Tests.fail msg "Expected exception, none found"
|
||||
|
||||
expectError msg text fn = expectError' msg [text] fn
|
||||
|
||||
testConnectSelfSignedWrongHost = do
|
||||
-- Server
|
||||
portPromise = Promise.new ()
|
||||
toSend = "12345"
|
||||
serverResult = defer do serverThread portPromise toSend
|
||||
-- Client
|
||||
_ = clientThread "some.other.hostname" portPromise
|
||||
()
|
||||
|
||||
clientThread host portPromise =
|
||||
cert = Either.toException (decodeCert (toUtf8 selfSignedCert))
|
||||
Either.toException !(testClient (Some cert) host portPromise)
|
||||
|
||||
serverThread portPromise toSend =
|
||||
cert = Either.toException (decodeCert (toUtf8 selfSignedCert))
|
||||
key = Optional.toException "No private key decoded" <| List.head (decodePrivateKey (toUtf8 selfSignedKey))
|
||||
tlsconfig = Tls.ServerConfig.default [cert] key
|
||||
sock = Socket.listen (server (Some (HostName ("127" ++ ".0.0.1"))) (Port "0"))
|
||||
port = match sock with ListeningServerSocket sock -> Socket.port sock
|
||||
_ = Promise.write portPromise port
|
||||
sock' = Socket.accept sock
|
||||
-- attach TLS to our TCP connection
|
||||
tls = Tls.newServer tlsconfig sock'
|
||||
tlsock = net.Tls.handshake tls
|
||||
TlsSocket.send tlsock (toUtf8 toSend)
|
||||
TlsSocket.terminate tlsock
|
||||
|
||||
testClient : Optional SignedCert -> Text -> Promise Nat -> '{IO} Either Failure Text
|
||||
testClient cert hostname portVar _ = catch do
|
||||
use base.IO.net
|
||||
-- create a client that will expect a cert from the given hostname (CN)
|
||||
defaultClient = (Tls.ClientConfig.default (HostName.HostName hostname) "")
|
||||
-- if we were passed a certificate to trust, it is the only certificate we trust
|
||||
-- otherwise, we'll reject self-signed certificates
|
||||
tlsconfig = match cert with
|
||||
None -> defaultClient
|
||||
Some (cert) -> defaultClient |> ClientConfig.certificates.set [cert]
|
||||
-- create a tcp connection with the server
|
||||
sock = Socket.client (HostName.HostName ("127" ++ ".0.0.1")) (Port.Port (Nat.toText (Promise.read portVar)))
|
||||
-- attach the TLS client to the TCP socket
|
||||
tls = Tls.newClient tlsconfig sock
|
||||
-- verify that the server presents us with a certificate chain for
|
||||
-- test.unison.cloud originating with a certificate we trust, and
|
||||
-- that the server can use a compatible TLS version and cipher
|
||||
tlsock = Tls.handshake tls
|
||||
-- -- receive a message from the server
|
||||
fromUtf8 (TlsSocket.receive tlsock)
|
||||
|
||||
-- generated with:
|
||||
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 3650 -out cert.pem
|
||||
selfSignedKey = "-----BEGIN PRIVATE KEY-----\nMIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQDtV0Lqk9i5DKJG\ne5zwDFuxHxSxhOygCuq6Jl4xonsjl4hdvXxUUiuqxGGbv4x9HSvavpHwyriGiIRQ\noIjanWiNK9Jp6VDYWOvErnTG/+Rfm1vCoUKQvn8lDrD9knSPUoTz3Cz7JS8FE/rr\nFR3IRyXa0gpXmvIwX16SeCS/Lb/Le9o1HJh9DrkxVyoFq3zlX1OE0AVV0a014IDB\nNprqLITwiVzyDPQkP8rbJF9WPI5afzW8+3+v5UanIFknOOPaJl8pf3gmqI5g8fxk\n/SSMlPgnLd1Fi7h90gBygdpJw3do3/ZA1IOvmFQ+LXE1xtqU1Ay3f3At3DiJgTxP\n8mwBYdtdAgMBAAECggEBAMo85QRF3xIvtcchZeUWYrtWpKdvgMIPC1x7fSAGN69o\nXAakg+DF8/ebRyET435o8QmAAZOQ6hOZGEYrxPGj14cTpEQjT4RKoPwDO/al7c+Z\n7mK2TqZP7L+C+UXZGgFWa3vwTVPjp2FIWTMf1zTli1geSjnECkM1wLxGK+nL7fZQ\nesHXPkJJG5AqzA84bJ/fY5OQ/dfcCxnHEv5XpHPq6VFgXg7jtcNbr1R9EBiQfreN\nU7Hd38R77jYjL1fT71HwEUQ0cwavfxTu0jZFXJxEC7CC1J65QXUguZXLf9vwgSB0\nm0gZgeJlQ905bDJrxUcqCFxdROy/SndP6qFnJSCsfwECgYEA+2cld/WCieUGstJd\njsIrJ6f/e+uuOSTnGTtnsBX6KoiHdcg3sVVVK18xI9El9V+YX9SjN37XeGFe/Wzu\ngE3M4A3Jqz7cgdNj/PaKjqQwJWNbcJnL5ku6eQvcAIpc5gAZxXVCPIbY1ZpeYcsh\nMwr3cOEpQu8UVFBbn/OeJ1r07dECgYEA8a5J3Ls5PSxXq8NDrkAxt3vUJIWLGQQJ\nbV2aGDI2XP2N+vh2WML9rlFeyyBOeRxK9TsErVOaEeOcQZV97//fzIGxCU+SXyiC\nnVMXT2U1mzOu5qPfzLO5Ga4sunxqKDman6NM2IPw2NPA7zMWNQMEIHAerwYZzjm5\nB5tFcMA8e80CgYBgF8rwkTz2LD5lN5dfK8SHAeXbnfgYC4zxzg0R9zSJ8WmlkYQI\nGk/VpisIP7c8lO+PIZ3JZohBkSZXw71d+V7n/R0qgXqTfRNo62uGnidxAws+fOq8\n+hEql2feJQThPQScvvc0X26eJsUQqC3mbripwsacuPmSSKzc9Kds741TIQKBgQCd\nXnG2CytATAliTKlbY218HmOKzHJAfcJttk9KhhekAW5cB0F4lq98vHtPJOA0OFoO\nyLlI63EdSOpMQj1Y83IUxjYy699Rmx1BuAMrral0P/kZMYfe0QAsWp/BZpXxT2EB\npeG58l/3sBqnJsrFBgu/24H/UaeoAyoaa96Rhntb2QKBgQCSEkcUnzTvoUyMFN14\n8NttxOUZiSsCmgoXk6Rk2QKyCPsJocGS4BffGt3kOMcotz/0YsvM1TBBLB7vIaAy\nE1eWLBxK4yYeS8dKXwiCZn170yaJyjoBwZC1RgqQiKa5Y22Di7KjJoMa4Da8Tk4z\nFbE5dBApbLhvNTyQ7BHZxlfmdg==\n-----END PRIVATE KEY-----"
|
||||
selfSignedCert = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUdMNT5sYMfDJYH48Rh8LrlN+5wwgwDQYJKoZIhvcNAQEL\nBQAwOjEaMBgGA1UEAwwRdGVzdC51bmlzb24uY2xvdWQxDzANBgNVBAoMBlVuaXNv\nbjELMAkGA1UEBhMCVVMwHhcNMjIwMTI0MjAxNzQ2WhcNMzIwMTIyMjAxNzQ2WjA6\nMRowGAYDVQQDDBF0ZXN0LnVuaXNvbi5jbG91ZDEPMA0GA1UECgwGVW5pc29uMQsw\nCQYDVQQGEwJVUzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAO1XQuqT\n2LkMokZ7nPAMW7EfFLGE7KAK6romXjGieyOXiF29fFRSK6rEYZu/jH0dK9q+kfDK\nuIaIhFCgiNqdaI0r0mnpUNhY68SudMb/5F+bW8KhQpC+fyUOsP2SdI9ShPPcLPsl\nLwUT+usVHchHJdrSClea8jBfXpJ4JL8tv8t72jUcmH0OuTFXKgWrfOVfU4TQBVXR\nrTXggME2muoshPCJXPIM9CQ/ytskX1Y8jlp/Nbz7f6/lRqcgWSc449omXyl/eCao\njmDx/GT9JIyU+Cct3UWLuH3SAHKB2knDd2jf9kDUg6+YVD4tcTXG2pTUDLd/cC3c\nOImBPE/ybAFh210CAwEAAaNTMFEwHQYDVR0OBBYEFIfwxpuqtqxfCpaJGW32jH2J\nNbnYMB8GA1UdIwQYMBaAFIfwxpuqtqxfCpaJGW32jH2JNbnYMA8GA1UdEwEB/wQF\nMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKh7EDo5XjSd6J190WGH3V8v49J0Sh8M\nP7APe1eL8eTkW1Vh7/QCOhRpkSnyCz2OxJjjeFVAsCO3aLxlRM6wQZQKXu45iM2U\niPmv7ECS5xUn7LqRZd/JG1P6jvRPtBC1+oqA+NNDe27wzQp3rWyDG3pWZga8jJfW\nq+2xQ+s6GfzszxYZ/8MLn4zaUSymnOA+70yQ8czXkSO7MT2jJ7QDX8jxuJPZZARW\nuXeAYPRqD+b4MjdBATEtxgPTDWEi8gtfHFGUgInFhD4hOu+D3NLiE6lfR5brUqpQ\nZ4v8prCI8OjGSUx1dIJhqQHB5O0vdaxO0hkVdfqDVE93UrGBPwBRDlo=\n-----END CERTIFICATE-----"
|
Loading…
Reference in New Issue
Block a user