1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{-# LANGUAGE OverloadedStrings #-}
module Util where
import qualified Data.ByteString.Lazy as L
import Data.Monoid
import qualified Data.Text as Text
;import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified Network.BSD as BSD
import Network.Socket
import Network.Address (setPort)
type UserName = Text
type ResourceName = Text
stripResource :: Text -> Text
stripResource jid = let (n,h,_) = splitJID jid
in unsplitJID (n,h,Nothing)
unsplitJID :: (Maybe UserName,Text,Maybe ResourceName) -> Text
unsplitJID (n,h,r) = username <> h <> resource
where
username = maybe "" (<>"@") n
resource = maybe "" ("/"<>) r
splitJID :: Text -> (Maybe UserName,Text,Maybe ResourceName)
splitJID bjid =
let (uATh,slashrsc) = Text.break (=='/') bjid
rsrc = if Text.null slashrsc then Nothing
else Just $ Text.drop 1 slashrsc
(u,atserver) = Text.break (=='@') uATh
(name,server) = if Text.null atserver then (Nothing,u)
else (Just u,Text.drop 1 atserver)
in (name,server,rsrc)
textHostName :: IO Text
textHostName = fmap Text.pack BSD.getHostName
textToLazyByteString :: Text -> L.ByteString
textToLazyByteString s = L.fromChunks [Text.encodeUtf8 s]
lazyByteStringToText :: L.ByteString -> Text
lazyByteStringToText = (foldr (<>) mempty . map Text.decodeUtf8 . L.toChunks)
-- | for example: 2001-db8-85a3-8d3-1319-8a2e-370-7348.ipv6-literal.net
ip6literal :: Text -> Text
ip6literal addr = Text.map dash addr <> ".ipv6-literal.net"
where
dash ':' = '-'
dash x = x
sameAddress :: SockAddr -> SockAddr -> Bool
sameAddress laddr addr = setPort 0 laddr == setPort 0 addr
|
