snoyberg/keter
1
1
Fork 0
mirror of https://github.com/snoyberg/keter.git synced 2024-12-14 08:05:40 +03:00
Code Issues Projects Releases Wiki Activity

Support fully qualified domain names ending in a dot.

Browse Source
This commit is contained in:
Aaron Friel 2013-08-16 11:52:38 -05:00
parent 3c85e21dab
commit 4758633573
1 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Keter/LabelMap.hs
View File

@ -21,6 +21,7 @@ import qualified Data.Map as Map
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Text (Text) import Data.Text (Text)
import Data.List (drop)
import qualified Keter.ReverseProxy as ReverseProxy (RPEntry) import qualified Keter.ReverseProxy as ReverseProxy (RPEntry)
import Debug.Trace (trace) import Debug.Trace (trace)
@ -85,6 +86,16 @@ data LabelEntry = Assigned PortEntry LabelMap
| Unassigned LabelMap | Unassigned LabelMap
deriving (Show) deriving (Show)
hostToLabels :: Text -> [Text]
hostToLabels h =
if Text.null h
then []
else
if Text.last h == '.'
then drop 1 $ labels
else labels
where labels = reverse . Text.splitOn "." $ h
lemap :: (LabelMap -> LabelMap) -> LabelEntry -> LabelEntry lemap :: (LabelMap -> LabelMap) -> LabelEntry -> LabelEntry
lemap f (Assigned e m) = Assigned e (f m) lemap f (Assigned e m) = Assigned e (f m)
lemap f (Unassigned m) = Unassigned (f m) lemap f (Unassigned m) = Unassigned (f m)
@ -101,7 +112,7 @@ insert h e m = trace
++" with result " ++ (show result) ++" with result " ++ (show result)
) )
result result
where result = insertTree (reverse . Text.splitOn "." $ h) e m where result = insertTree (hostToLabels h) e m
-- insert = insertTree . reverse . Text.splitOn "." -- insert = insertTree . reverse . Text.splitOn "."
insertTree :: [Text] -> PortEntry -> LabelMap -> LabelMap insertTree :: [Text] -> PortEntry -> LabelMap -> LabelMap
@ -151,7 +162,7 @@ delete h m = trace
) )
result result
where result = deleteTree (reverse . Text.splitOn "." $ h) m where result = deleteTree (hostToLabels h) m
-- delete = deleteTree . reverse . Text.splitOn "." -- delete = deleteTree . reverse . Text.splitOn "."
deleteTree :: [Text] -> LabelMap -> LabelMap deleteTree :: [Text] -> LabelMap -> LabelMap
@ -190,7 +201,7 @@ lookup h m = trace
++" and found " ++ (show result) ++" and found " ++ (show result)
) )
result result
where result = (lookupTree (reverse . Text.splitOn "." $ h) m) where result = (lookupTree (hostToLabels h) m)
-- lookup = lookupTree . reverse . Text.splitOn "." -- lookup = lookupTree . reverse . Text.splitOn "."
lookupTree :: [Text] -> LabelMap -> Maybe PortEntry lookupTree :: [Text] -> LabelMap -> Maybe PortEntry