function to parse Triple-Field Specs

author: James Crayne <jim.crayne@gmail.com> 2016-04-29 02:49:31 -0400
committer: James Crayne <jim.crayne@gmail.com> 2016-04-29 16:12:22 -0400
commit: 20d17eef898d342ef62812d2b74b590e73cc1180 (patch)
tree: dffa84a3469ecc40f1e2999f9a21adeea6877c22 /testkiki
parent: baf38b1c4aebebae1a3a93b9336d147ab7ce84c3 (diff)
1 files changed, 129 insertions, 0 deletions
diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs
index c8b141b..d588336 100644
--- a/testkiki/testkiki.hs
+++ b/testkiki/testkiki.hs
@@ -29,6 +29,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import ProcessUtils
 import Data.Bool
 import Data.Char
+import KeyRing
 #if !MIN_VERSION_base(4,7,0)
 setEnv k v = System.Posix.Env.setEnv k v True
@@ -80,6 +81,134 @@ didFirstEportSecret = unsafePerformIO $ newIORef False
 doTests :: TestKikiSettings -> IO ()
 doTests tkConfig = hspec $ do
+    describe "parseSpec3" $ do
+        it "succeeds as expected" $ do
+            let resultOf x = (x,parseSpec3 Nothing x)
+                rslt y x = (x, parseSpec3 (Just y) x)
+            let typ = Just KeyTypeField
+                user = Just UserIDField
+                circ = Just GroupIDField
+            resultOf "u:joe//fp:4abf30"
+                `shouldBe` ("u:joe//fp:4abf30",Right (SubstringMatch user "joe",AnyMatch, FingerprintMatch "4abf30"))
+            resultOf "t:tor"
+                `shouldBe` ("t:tor",Right (AnyMatch,           AnyMatch,       SubstringMatch typ "tor"))
+            resultOf "u:joe"
+                `shouldBe` ("u:joe",Right (AnyMatch,           SubstringMatch user "joe", AnyMatch     ))
+            resultOf "u:joe/"
+                `shouldBe` ("u:joe/",Right (AnyMatch,          SubstringMatch user "joe", AnyMatch    ))
+            resultOf "fp:4A39F/tor"
+                `shouldBe` ("fp:4A39F/tor",Right (AnyMatch,    FingerprintMatch "4A39F",  SubstringMatch typ "tor"))
+            resultOf "u:joe/tor"
+                `shouldBe` ("u:joe/tor",Right (AnyMatch,       SubstringMatch user "joe", SubstringMatch typ "tor"))
+            resultOf "u:joe/t:tor"
+                `shouldBe` ("u:joe/t:tor",Right (AnyMatch,     SubstringMatch user "joe", SubstringMatch typ "tor"))
+            resultOf "u:joe/fp:4abf30"
+                `shouldBe` ("u:joe/fp:4abf30",Right (AnyMatch, SubstringMatch user "joe", FingerprintMatch "4abf30"))
+            resultOf "joe/tor"
+                `shouldBe` ("joe/tor",Right (AnyMatch,         SubstringMatch user "joe", SubstringMatch typ "tor"))
+            resultOf "c:buds//fp:4abf3"
+                `shouldBe` ("c:buds//fp:4abf3",Right (SubstringMatch circ "buds", AnyMatch, FingerprintMatch "4abf3" ))
+        it "succeeds as expected, with context: UserIDField" $ do
+            let resultOf x = (x,parseSpec3 Nothing x)
+                rslt y x = (x, parseSpec3 (Just y) x)
+            let typ = Just KeyTypeField
+                user = Just UserIDField
+                circ = Just GroupIDField
+            rslt UserIDField "t:tor"
+                `shouldBe` ("t:tor",Right (AnyMatch,        SubstringMatch typ "tor", AnyMatch      ))
+            rslt UserIDField "u:joe"
+                `shouldBe` ("u:joe",Right (AnyMatch,           SubstringMatch user "joe", AnyMatch     ))
+            rslt UserIDField "u:joe/"
+                `shouldBe` ("u:joe/",Right (AnyMatch,          SubstringMatch user "joe", AnyMatch    ))
+            rslt UserIDField "fp:4A39F/tor"
+                `shouldBe` ("fp:4A39F/tor",Right (AnyMatch,    FingerprintMatch "4A39F",  SubstringMatch typ "tor"))
+            rslt UserIDField "u:joe/tor"
+                `shouldBe` ("u:joe/tor",Right (AnyMatch,       SubstringMatch user "joe", SubstringMatch typ "tor"))
+            rslt UserIDField "u:joe/t:tor"
+                `shouldBe` ("u:joe/t:tor",Right (AnyMatch,     SubstringMatch user "joe", SubstringMatch typ "tor"))
+            rslt UserIDField "u:joe/fp:4abf30"
+                `shouldBe` ("u:joe/fp:4abf30",Right (AnyMatch, SubstringMatch user "joe", FingerprintMatch "4abf30"))
+            rslt UserIDField "joe/tor"
+                `shouldBe` ("joe/tor",Right (AnyMatch,         SubstringMatch user "joe", SubstringMatch typ "tor"))
+        it "succeeds as expected, with context: GroupIDField" $ do
+            let resultOf x = (x,parseSpec3 Nothing x)
+                rslt y x = (x, parseSpec3 (Just y) x)
+            let typ = Just KeyTypeField
+                user = Just UserIDField
+                circ = Just GroupIDField
+            rslt GroupIDField "u:joe//fp:4abf30"
+                `shouldBe` ("u:joe//fp:4abf30",Right (SubstringMatch user "joe",AnyMatch, FingerprintMatch "4abf30"))
+            rslt GroupIDField "t:tor"
+                `shouldBe` ("t:tor",Right (SubstringMatch typ "tor", AnyMatch,  AnyMatch))
+            rslt GroupIDField "u:joe"
+                `shouldBe` ("u:joe",Right (SubstringMatch user "joe", AnyMatch, AnyMatch     ))
+            rslt GroupIDField "u:joe/"
+                `shouldBe` ("u:joe/",Right (SubstringMatch user "joe", AnyMatch, AnyMatch    ))
+            rslt GroupIDField "fp:4A39F/tor"
+                `shouldBe` ("fp:4A39F/tor",Right (FingerprintMatch "4A39F", AnyMatch, SubstringMatch typ "tor"))
+            rslt GroupIDField "u:joe/tor"
+                `shouldBe` ("u:joe/tor",Right (SubstringMatch user "joe", AnyMatch,  SubstringMatch typ "tor"))
+            rslt GroupIDField "u:joe/t:tor"
+                `shouldBe` ("u:joe/t:tor",Right (SubstringMatch user "joe", AnyMatch,     SubstringMatch typ "tor"))
+            rslt GroupIDField "u:joe/fp:4abf30"
+                `shouldBe` ("u:joe/fp:4abf30",Right (SubstringMatch user "joe", AnyMatch, FingerprintMatch "4abf30"))
+            rslt GroupIDField "joe/tor"
+                `shouldBe` ("joe/tor",Right (SubstringMatch user "joe",AnyMatch,          SubstringMatch typ "tor"))
+            rslt GroupIDField "c:buds//fp:4abf3"
+                `shouldBe` ("c:buds//fp:4abf3",Right (SubstringMatch circ "buds", AnyMatch, FingerprintMatch "4abf3" ))
+        it "succeeds as expected, with context: KeyTypeField" $ do
+            let resultOf x = (x,parseSpec3 Nothing x)
+                rslt y x = (x, parseSpec3 (Just y) x)
+            let typ = Just KeyTypeField
+                user = Just UserIDField
+                circ = Just GroupIDField
+            rslt KeyTypeField "t:tor"
+                `shouldBe` ("t:tor",Right (AnyMatch,           AnyMatch,       SubstringMatch typ "tor"))
+            rslt KeyTypeField "u:joe"
+                `shouldBe` ("u:joe",Right (AnyMatch,           AnyMatch, SubstringMatch user "joe" ))
+            rslt KeyTypeField "u:joe/"
+                `shouldBe` ("u:joe/",Right (AnyMatch,          AnyMatch, SubstringMatch user "joe" ))
+            rslt KeyTypeField "fp:4A39F/tor"
+                `shouldBe` ("fp:4A39F/tor",Right (AnyMatch,    FingerprintMatch "4A39F",  SubstringMatch typ "tor"))
+            rslt KeyTypeField "u:joe/tor"
+                `shouldBe` ("u:joe/tor",Right (AnyMatch,       SubstringMatch user "joe", SubstringMatch typ "tor"))
+            rslt KeyTypeField "u:joe/t:tor"
+                `shouldBe` ("u:joe/t:tor",Right (AnyMatch,     SubstringMatch user "joe", SubstringMatch typ "tor"))
+            rslt KeyTypeField "u:joe/fp:4abf30"
+                `shouldBe` ("u:joe/fp:4abf30",Right (AnyMatch, SubstringMatch user "joe", FingerprintMatch "4abf30"))
+            rslt KeyTypeField "joe/tor"
+                `shouldBe` ("joe/tor",Right (AnyMatch,         SubstringMatch user "joe", SubstringMatch typ "tor"))
+        it "fails as expected" $ do
+            let resultOf x = (x,parseSpec3 Nothing x)
+                rslt y x = (x, parseSpec3 (Just y) x)
+            let typ = Just KeyTypeField
+                user = Just UserIDField
+                circ = Just GroupIDField
+            -- TODO: Should be error:
+            resultOf "//c:buds"
+                `shouldBe` ("//c:buds",
+                    (Left $ SpecEMissMatch "buds" (Just GroupIDField) KeyTypeField))
+            resultOf "/c:buds/"
+                `shouldBe` ("/c:buds/",
+                    (Left $ SpecEMissMatch "buds" (Just GroupIDField) UserIDField))
+            rslt UserIDField "c:buds//fp:4abf3"
+                `shouldBe` ("c:buds//fp:4abf3",
+                    (Left . SpecETooBig) (SubstringMatch (Just GroupIDField) "buds",AnyMatch, FingerprintMatch "4abf3"))
+            rslt UserIDField "u:joe//fp:4abf30"
+                `shouldBe` ("u:joe//fp:4abf30",
+                    (Left . SpecETooBig) (SubstringMatch (Just UserIDField) "joe",AnyMatch, FingerprintMatch "4abf30"))
+            rslt KeyTypeField "u:joe//fp:4abf30"
+                `shouldBe` ("u:joe//fp:4abf30",
+                    Left (SpecETooBig (SubstringMatch user "joe",AnyMatch, FingerprintMatch "4abf30")))
+            rslt KeyTypeField "c:buds//fp:4abf3"
+                `shouldBe` ("c:buds//fp:4abf3",
+                    (Left . SpecETooBig) (SubstringMatch circ "buds", AnyMatch, FingerprintMatch "4abf3" ))
    {-
    -- Example of shouldThrow
    describe "TODO: error" $
author	James Crayne <jim.crayne@gmail.com>	2016-04-29 02:49:31 -0400
committer	James Crayne <jim.crayne@gmail.com>	2016-04-29 16:12:22 -0400
commit	20d17eef898d342ef62812d2b74b590e73cc1180 (patch)
tree	dffa84a3469ecc40f1e2999f9a21adeea6877c22 /testkiki
parent	baf38b1c4aebebae1a3a93b9336d147ab7ce84c3 (diff)

diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs index c8b141b..d588336 100644 --- a/testkiki/testkiki.hs +++ b/testkiki/testkiki.hs
@@ -29,6 +29,7 @@ import System.IO.Unsafe (unsafePerformIO)
29	import ProcessUtils	29	import ProcessUtils
30	import Data.Bool	30	import Data.Bool
31	import Data.Char	31	import Data.Char
		32	import KeyRing
32		33
33	#if !MIN_VERSION_base(4,7,0)	34	#if !MIN_VERSION_base(4,7,0)
34	setEnv k v = System.Posix.Env.setEnv k v True	35	setEnv k v = System.Posix.Env.setEnv k v True
@@ -80,6 +81,134 @@ didFirstEportSecret = unsafePerformIO $ newIORef False
80		81
81	doTests :: TestKikiSettings -> IO ()	82	doTests :: TestKikiSettings -> IO ()
82	doTests tkConfig = hspec $ do	83	doTests tkConfig = hspec $ do
		84	describe "parseSpec3" $ do
		85	it "succeeds as expected" $ do
		86	let resultOf x = (x,parseSpec3 Nothing x)
		87	rslt y x = (x, parseSpec3 (Just y) x)
		88	let typ = Just KeyTypeField
		89	user = Just UserIDField
		90	circ = Just GroupIDField
		91	resultOf "u:joe//fp:4abf30"
		92	`shouldBe` ("u:joe//fp:4abf30",Right (SubstringMatch user "joe",AnyMatch, FingerprintMatch "4abf30"))
		93	resultOf "t:tor"
		94	`shouldBe` ("t:tor",Right (AnyMatch, AnyMatch, SubstringMatch typ "tor"))
		95	resultOf "u:joe"
		96	`shouldBe` ("u:joe",Right (AnyMatch, SubstringMatch user "joe", AnyMatch ))
		97	resultOf "u:joe/"
		98	`shouldBe` ("u:joe/",Right (AnyMatch, SubstringMatch user "joe", AnyMatch ))
		99	resultOf "fp:4A39F/tor"
		100	`shouldBe` ("fp:4A39F/tor",Right (AnyMatch, FingerprintMatch "4A39F", SubstringMatch typ "tor"))
		101	resultOf "u:joe/tor"
		102	`shouldBe` ("u:joe/tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		103	resultOf "u:joe/t:tor"
		104	`shouldBe` ("u:joe/t:tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		105	resultOf "u:joe/fp:4abf30"
		106	`shouldBe` ("u:joe/fp:4abf30",Right (AnyMatch, SubstringMatch user "joe", FingerprintMatch "4abf30"))
		107	resultOf "joe/tor"
		108	`shouldBe` ("joe/tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		109	resultOf "c:buds//fp:4abf3"
		110	`shouldBe` ("c:buds//fp:4abf3",Right (SubstringMatch circ "buds", AnyMatch, FingerprintMatch "4abf3" ))
		111
		112	it "succeeds as expected, with context: UserIDField" $ do
		113	let resultOf x = (x,parseSpec3 Nothing x)
		114	rslt y x = (x, parseSpec3 (Just y) x)
		115	let typ = Just KeyTypeField
		116	user = Just UserIDField
		117	circ = Just GroupIDField
		118	rslt UserIDField "t:tor"
		119	`shouldBe` ("t:tor",Right (AnyMatch, SubstringMatch typ "tor", AnyMatch ))
		120	rslt UserIDField "u:joe"
		121	`shouldBe` ("u:joe",Right (AnyMatch, SubstringMatch user "joe", AnyMatch ))
		122	rslt UserIDField "u:joe/"
		123	`shouldBe` ("u:joe/",Right (AnyMatch, SubstringMatch user "joe", AnyMatch ))
		124	rslt UserIDField "fp:4A39F/tor"
		125	`shouldBe` ("fp:4A39F/tor",Right (AnyMatch, FingerprintMatch "4A39F", SubstringMatch typ "tor"))
		126	rslt UserIDField "u:joe/tor"
		127	`shouldBe` ("u:joe/tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		128	rslt UserIDField "u:joe/t:tor"
		129	`shouldBe` ("u:joe/t:tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		130	rslt UserIDField "u:joe/fp:4abf30"
		131	`shouldBe` ("u:joe/fp:4abf30",Right (AnyMatch, SubstringMatch user "joe", FingerprintMatch "4abf30"))
		132	rslt UserIDField "joe/tor"
		133	`shouldBe` ("joe/tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		134
		135	it "succeeds as expected, with context: GroupIDField" $ do
		136	let resultOf x = (x,parseSpec3 Nothing x)
		137	rslt y x = (x, parseSpec3 (Just y) x)
		138	let typ = Just KeyTypeField
		139	user = Just UserIDField
		140	circ = Just GroupIDField
		141	rslt GroupIDField "u:joe//fp:4abf30"
		142	`shouldBe` ("u:joe//fp:4abf30",Right (SubstringMatch user "joe",AnyMatch, FingerprintMatch "4abf30"))
		143	rslt GroupIDField "t:tor"
		144	`shouldBe` ("t:tor",Right (SubstringMatch typ "tor", AnyMatch, AnyMatch))
		145	rslt GroupIDField "u:joe"
		146	`shouldBe` ("u:joe",Right (SubstringMatch user "joe", AnyMatch, AnyMatch ))
		147	rslt GroupIDField "u:joe/"
		148	`shouldBe` ("u:joe/",Right (SubstringMatch user "joe", AnyMatch, AnyMatch ))
		149	rslt GroupIDField "fp:4A39F/tor"
		150	`shouldBe` ("fp:4A39F/tor",Right (FingerprintMatch "4A39F", AnyMatch, SubstringMatch typ "tor"))
		151	rslt GroupIDField "u:joe/tor"
		152	`shouldBe` ("u:joe/tor",Right (SubstringMatch user "joe", AnyMatch, SubstringMatch typ "tor"))
		153	rslt GroupIDField "u:joe/t:tor"
		154	`shouldBe` ("u:joe/t:tor",Right (SubstringMatch user "joe", AnyMatch, SubstringMatch typ "tor"))
		155	rslt GroupIDField "u:joe/fp:4abf30"
		156	`shouldBe` ("u:joe/fp:4abf30",Right (SubstringMatch user "joe", AnyMatch, FingerprintMatch "4abf30"))
		157	rslt GroupIDField "joe/tor"
		158	`shouldBe` ("joe/tor",Right (SubstringMatch user "joe",AnyMatch, SubstringMatch typ "tor"))
		159	rslt GroupIDField "c:buds//fp:4abf3"
		160	`shouldBe` ("c:buds//fp:4abf3",Right (SubstringMatch circ "buds", AnyMatch, FingerprintMatch "4abf3" ))
		161
		162	it "succeeds as expected, with context: KeyTypeField" $ do
		163	let resultOf x = (x,parseSpec3 Nothing x)
		164	rslt y x = (x, parseSpec3 (Just y) x)
		165	let typ = Just KeyTypeField
		166	user = Just UserIDField
		167	circ = Just GroupIDField
		168	rslt KeyTypeField "t:tor"
		169	`shouldBe` ("t:tor",Right (AnyMatch, AnyMatch, SubstringMatch typ "tor"))
		170	rslt KeyTypeField "u:joe"
		171	`shouldBe` ("u:joe",Right (AnyMatch, AnyMatch, SubstringMatch user "joe" ))
		172	rslt KeyTypeField "u:joe/"
		173	`shouldBe` ("u:joe/",Right (AnyMatch, AnyMatch, SubstringMatch user "joe" ))
		174	rslt KeyTypeField "fp:4A39F/tor"
		175	`shouldBe` ("fp:4A39F/tor",Right (AnyMatch, FingerprintMatch "4A39F", SubstringMatch typ "tor"))
		176	rslt KeyTypeField "u:joe/tor"
		177	`shouldBe` ("u:joe/tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		178	rslt KeyTypeField "u:joe/t:tor"
		179	`shouldBe` ("u:joe/t:tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		180	rslt KeyTypeField "u:joe/fp:4abf30"
		181	`shouldBe` ("u:joe/fp:4abf30",Right (AnyMatch, SubstringMatch user "joe", FingerprintMatch "4abf30"))
		182	rslt KeyTypeField "joe/tor"
		183	`shouldBe` ("joe/tor",Right (AnyMatch, SubstringMatch user "joe", SubstringMatch typ "tor"))
		184
		185
		186	it "fails as expected" $ do
		187	let resultOf x = (x,parseSpec3 Nothing x)
		188	rslt y x = (x, parseSpec3 (Just y) x)
		189	let typ = Just KeyTypeField
		190	user = Just UserIDField
		191	circ = Just GroupIDField
		192	-- TODO: Should be error:
		193	resultOf "//c:buds"
		194	`shouldBe` ("//c:buds",
		195	(Left $ SpecEMissMatch "buds" (Just GroupIDField) KeyTypeField))
		196	resultOf "/c:buds/"
		197	`shouldBe` ("/c:buds/",
		198	(Left $ SpecEMissMatch "buds" (Just GroupIDField) UserIDField))
		199	rslt UserIDField "c:buds//fp:4abf3"
		200	`shouldBe` ("c:buds//fp:4abf3",
		201	(Left . SpecETooBig) (SubstringMatch (Just GroupIDField) "buds",AnyMatch, FingerprintMatch "4abf3"))
		202	rslt UserIDField "u:joe//fp:4abf30"
		203	`shouldBe` ("u:joe//fp:4abf30",
		204	(Left . SpecETooBig) (SubstringMatch (Just UserIDField) "joe",AnyMatch, FingerprintMatch "4abf30"))
		205	rslt KeyTypeField "u:joe//fp:4abf30"
		206	`shouldBe` ("u:joe//fp:4abf30",
		207	Left (SpecETooBig (SubstringMatch user "joe",AnyMatch, FingerprintMatch "4abf30")))
		208	rslt KeyTypeField "c:buds//fp:4abf3"
		209	`shouldBe` ("c:buds//fp:4abf3",
		210	(Left . SpecETooBig) (SubstringMatch circ "buds", AnyMatch, FingerprintMatch "4abf3" ))
		211
83	{-	212	{-
84	-- Example of shouldThrow	213	-- Example of shouldThrow
85	describe "TODO: error" $	214	describe "TODO: error" $