M Network/Protocol/XMPP/JID.hs => Network/Protocol/XMPP/JID.hs +42 -28
@@ 20,13 20,18 @@ module Network.Protocol.XMPP.JID (
,JIDDomain
,JIDResource
- ,jidNodeBuild
- ,jidNodeValue
- ,jidDomainBuild
- ,jidDomainValue
- ,jidResourceBuild
- ,jidResourceValue
- ,jidBuild
+ ,jidNodeStr
+ ,jidDomainStr
+ ,jidResourceStr
+
+ ,mkJIDNode
+ ,mkJIDDomain
+ ,mkJIDResource
+ ,mkJID
+
+ ,jidNode
+ ,jidDomain
+ ,jidResource
,jidParse
,jidFormat
@@ 44,41 49,50 @@ newtype JIDDomain = JIDDomain String
newtype JIDResource = JIDResource String
deriving (Eq, Show)
-jidNodeBuild :: String -> Maybe JIDNode
-jidNodeBuild "" = Nothing
-jidNodeBuild s = Just (JIDNode s) -- TODO: stringprep, validation
+jidNodeStr :: JIDNode -> String
+jidNodeStr (JIDNode s) = s
-jidNodeValue :: JIDNode -> String
-jidNodeValue (JIDNode s) = s
+jidDomainStr :: JIDDomain -> String
+jidDomainStr (JIDDomain s) = s
-jidDomainBuild :: String -> Maybe JIDDomain
-jidDomainBuild "" = Nothing
-jidDomainBuild s = Just (JIDDomain s) -- TODO: stringprep, validation
+jidResourceStr :: JIDResource -> String
+jidResourceStr (JIDResource s) = s
-jidDomainValue :: JIDDomain -> String
-jidDomainValue (JIDDomain s) = s
+mkJIDNode :: String -> Maybe JIDNode
+mkJIDNode "" = Nothing
+mkJIDNode s = Just (JIDNode s) -- TODO: stringprep, validation
-jidResourceBuild :: String -> Maybe JIDResource
-jidResourceBuild "" = Nothing
-jidResourceBuild s = Just (JIDResource s) -- TODO: stringprep, validation
+mkJIDDomain :: String -> Maybe JIDDomain
+mkJIDDomain "" = Nothing
+mkJIDDomain s = Just (JIDDomain s) -- TODO: stringprep, validation
-jidResourceValue :: JIDResource -> String
-jidResourceValue (JIDResource s) = s
+mkJIDResource :: String -> Maybe JIDResource
+mkJIDResource "" = Nothing
+mkJIDResource s = Just (JIDResource s) -- TODO: stringprep, validation
-jidBuild :: String -> String -> String -> Maybe JID
-jidBuild nodeStr domainStr resourceStr = let
- node = jidNodeBuild nodeStr
- resource = jidResourceBuild resourceStr
+mkJID :: String -> String -> String -> Maybe JID
+mkJID nodeStr domainStr resourceStr = let
+ node = mkJIDNode nodeStr
+ resource = mkJIDResource resourceStr
in do
- domain <- jidDomainBuild domainStr
+ domain <- mkJIDDomain domainStr
Just (JID node domain resource)
+jidNode :: JID -> String
+jidNode (JID x _ _) = maybe "" jidNodeStr x
+
+jidDomain :: JID -> String
+jidDomain (JID _ x _) = jidDomainStr x
+
+jidResource :: JID -> String
+jidResource (JID _ _ x) = maybe "" jidResourceStr x
+
-- TODO: validate input according to RFC 3920, section 3.1
jidParse :: String -> Maybe JID
jidParse s = let
(nodeStr, postNode) = if '@' `elem` s then split s '@' else ("", s)
(domainStr, resourceStr) = if '/' `elem` postNode then split postNode '/' else (postNode, "")
- in jidBuild nodeStr domainStr resourceStr
+ in mkJID nodeStr domainStr resourceStr
jidFormat :: JID -> String
jidFormat (JID node (JIDDomain domain) resource) = let
M Tests/Core.hs => Tests/Core.hs +48 -36
@@ 30,68 30,80 @@ jidTests = "jidTests" ~: TestList [
,buildResourceTests
,buildJIDTests
,parseJIDTests
- ,showJIDTests
+ ,formatJIDTests
+ ,jidPartTests
]
buildNodeTests = "buildNodeTests" ~: TestList [
-- TODO: stringprep, validation
- testValue "" Nothing
- ,testValue "a" (Just "a")
+ testStr "" Nothing
+ ,testStr "a" (Just "a")
]
- where testValue s expected = let
- maybeNode = jidNodeBuild s
- value = maybe Nothing (\x -> Just (jidNodeValue x)) maybeNode
+ where testStr s expected = let
+ maybeNode = mkJIDNode s
+ value = maybe Nothing (\x -> Just (jidNodeStr x)) maybeNode
in expected ~=? value
buildDomainTests = "buildDomainTests" ~: TestList [
-- TODO: stringprep, validation
- testValue "" Nothing
- ,testValue "a" (Just "a")
+ testStr "" Nothing
+ ,testStr "a" (Just "a")
]
- where testValue s expected = let
- maybeDomain = jidDomainBuild s
- value = maybe Nothing (\x -> Just (jidDomainValue x)) maybeDomain
+ where testStr s expected = let
+ maybeDomain = mkJIDDomain s
+ value = maybe Nothing (\x -> Just (jidDomainStr x)) maybeDomain
in expected ~=? value
buildResourceTests = "buildResourceTests" ~: TestList [
-- TODO: stringprep, validation
- testValue "" Nothing
- ,testValue "a" (Just "a")
+ testStr "" Nothing
+ ,testStr "a" (Just "a")
]
- where testValue s expected = let
- maybeResource = jidResourceBuild s
- value = maybe Nothing (\x -> Just (jidResourceValue x)) maybeResource
+ where testStr s expected = let
+ maybeResource = mkJIDResource s
+ value = maybe Nothing (\x -> Just (jidResourceStr x)) maybeResource
in expected ~=? value
buildJIDTests = "buildJIDTests" ~: TestList [
-- TODO: stringprep, validation of segments
- jidBuild "" "" "" ~?= Nothing
- ,jidBuild "a" "" "" ~?= Nothing
- ,jidBuild "" "b" "" ~?/= Nothing
- ,jidBuild "" "" "c" ~?= Nothing
- ,jidBuild "a" "b" "" ~?/= Nothing
- ,jidBuild "a" "" "c" ~?= Nothing
- ,jidBuild "" "b" "c" ~?/= Nothing
- ,jidBuild "a" "b" "c" ~?/= Nothing
+ mkJID "" "" "" ~?= Nothing
+ ,mkJID "a" "" "" ~?= Nothing
+ ,mkJID "" "b" "" ~?/= Nothing
+ ,mkJID "" "" "c" ~?= Nothing
+ ,mkJID "a" "b" "" ~?/= Nothing
+ ,mkJID "a" "" "c" ~?= Nothing
+ ,mkJID "" "b" "c" ~?/= Nothing
+ ,mkJID "a" "b" "c" ~?/= Nothing
]
parseJIDTests = "parseJIDTests" ~: TestList [
- testJIDParse "b" (jidBuild "" "b" "")
- ,testJIDParse "a@b" (jidBuild "a" "b" "")
- ,testJIDParse "b/c" (jidBuild "" "b" "c")
- ,testJIDParse "a@b/c" (jidBuild "a" "b" "c")
+ testJIDParse "b" (mkJID "" "b" "")
+ ,testJIDParse "a@b" (mkJID "a" "b" "")
+ ,testJIDParse "b/c" (mkJID "" "b" "c")
+ ,testJIDParse "a@b/c" (mkJID "a" "b" "c")
]
where testJIDParse s expected = expected ~=? (jidParse s)
-showJIDTests = "showJIDTests" ~: TestList [
- testJIDShow (jidBuild "" "b" "") "b"
- ,testJIDShow (jidBuild "a" "b" "") "a@b"
- ,testJIDShow (jidBuild "" "b" "c") "b/c"
- ,testJIDShow (jidBuild "a" "b" "c") "a@b/c"
+formatJIDTests = "formatJIDTests" ~: TestList [
+ testJIDFormat (mkJID "" "b" "") "b"
+ ,testJIDFormat (mkJID "a" "b" "") "a@b"
+ ,testJIDFormat (mkJID "" "b" "c") "b/c"
+ ,testJIDFormat (mkJID "a" "b" "c") "a@b/c"
]
- where testJIDShow maybeJID expected = TestCase (case maybeJID of
- Nothing -> assertFailure "jidBuild returned Nothing"
- (Just jid) -> expected @=? (show jid))
+ where testJIDFormat maybeJID expected = TestCase $ case maybeJID of
+ Nothing -> assertFailure "mkJID returned Nothing"
+ (Just jid) -> expected @=? (jidFormat jid)
+
+jidPartTests = "jidPartTests" ~: TestList [
+ testJIDPart (mkJID "" "b" "") jidNode ""
+ ,testJIDPart (mkJID "a" "b" "") jidNode "a"
+ ,testJIDPart (mkJID "" "b" "") jidDomain "b"
+ ,testJIDPart (mkJID "" "b" "") jidResource ""
+ ,testJIDPart (mkJID "" "b" "c") jidResource "c"
+ ]
+ where testJIDPart maybeJID f expected = TestCase $ case maybeJID of
+ Nothing -> assertFailure "mkJID returned Nothing"
+ (Just jid) -> expected @=? (f jid)
-------------------------------------------------------------------------------