Merge pull request #143 from txkaduo/master

Fix wildcards

Keter/LabelMap.hs

@@ -240,7 +240,7 @@ lookupTree [] _ = Nothing
 lookupTree _ EmptyLabelMap = Nothing
 
 lookupTree [l] (Static t)   = Map.lookup (CI.mk l) t >>= getPortEntry
---lookupTree (_:_) (Wildcard w) = getPortEntry $ w
+lookupTree [_] (Wildcard w) = getPortEntry $ w
 lookupTree [l] (WildcardExcept w t) =
     case Map.lookup (CI.mk l) t >>= getPortEntry of
         Just e  -> Just e

test/LabelMapSpec.hs

@@ -8,12 +8,14 @@ import           Test.Hspec
 import           Test.HUnit
 
 import qualified Keter.LabelMap as LM
+import           Data.Maybe
 
 
 spec :: Spec
 spec = do
   describe "LabelMap" $ do
     it "modified subdmonains" caseSubdomainIntegrity
+    it "assert wildcards" caseWildcards
 
 
 {-
@@ -57,3 +59,12 @@ caseSubdomainIntegrity = do
   print test3b
 
   assertBool msg $ test3a == test3b
+
+caseWildcards :: Assertion
+caseWildcards = do
+  let test0 = LM.empty
+      test1 = LM.insert "*.someapp.com"       () test0
+      test2 = LM.lookup "a.someapp.com"         test1
+      msg = "Wildcards domains"
+
+  assertBool msg $ isJust test2