From a11fb94c65b9e4ba18e4468bedba2be6b581a628 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 26 Oct 2012 13:03:08 -0400
Subject: [PATCH] SRV record construction

---
 Assistant/Threads/PushNotifier.hs |  2 +-
 Utility/SRV.hs                    | 17 ++++++++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs
index 2784012f24..0686aac7b7 100644
--- a/Assistant/Threads/PushNotifier.hs
+++ b/Assistant/Threads/PushNotifier.hs
@@ -83,7 +83,7 @@ connectXMPP c a = case parseJID (xmppJID c) of
 connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO (Either SomeException ())
 connectXMPP' jid c a = go =<< lookupSRV srvrecord
 	where
-		srvrecord = "_xmpp-client._tcp." ++ (T.unpack $ strDomain $ jidDomain jid)
+		srvrecord = mkSRVTcp "xmpp-client" (T.unpack $ strDomain $ jidDomain jid)
 		serverjid = JID Nothing (jidDomain jid) Nothing
 
 		go [] = run (xmppHostname c)
diff --git a/Utility/SRV.hs b/Utility/SRV.hs
index c30c8bd866..38ac287870 100644
--- a/Utility/SRV.hs
+++ b/Utility/SRV.hs
@@ -11,6 +11,8 @@
 {-# LANGUAGE CPP #-}
 
 module Utility.SRV (
+	mkSRVTcp,
+	mkSRV,
 	lookupSRV,
 ) where
 
@@ -30,12 +32,21 @@ import ADNS.Resolver
 import Data.Either
 #endif
 
+newtype SRV = SRV String
+
 type HostPort = (HostName, PortID)
 
+mkSRV :: String -> String -> HostName -> SRV
+mkSRV transport protocol host = SRV $ concat
+	["_", protocol, ".", transport, ".", host]
+
+mkSRVTcp :: String -> HostName -> SRV
+mkSRVTcp = mkSRV "tcp"
+
 {- Returns an ordered list, with highest priority hosts first.
  -
  - On error, returns an empty list. -}
-lookupSRV :: HostName -> IO [HostPort]
+lookupSRV :: SRV -> IO [HostPort]
 #ifdef WITH_ADNS
 lookupSRV srv = initResolver [] $ \resolver -> do
 	r <- catchDefaultIO (Right []) $
@@ -45,8 +56,8 @@ lookupSRV srv = initResolver [] $ \resolver -> do
 lookupSRV = lookupSRVHost
 #endif
 
-lookupSRVHost :: HostName -> IO [HostPort]
-lookupSRVHost srv
+lookupSRVHost :: SRV -> IO [HostPort]
+lookupSRVHost (SRV srv)
 	| Build.SysConfig.host = catchDefaultIO [] $ 
 		parseSrvHost <$> readProcessEnv "host" ["-t", "SRV", "--", srv]
 			-- clear environment, to avoid LANG affecting output