Skip to content

Commit 24872d8

Browse files
MichelBouceyMichelBoucey
committed
v0.4 Release
1 parent ef2dd71 commit 24872d8

File tree

4 files changed

+102
-102
lines changed

4 files changed

+102
-102
lines changed

‎Text/IPv6Addr.hs

+10-6
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@
44
-- Copyright : (c) Michel Boucey 2011-2013
55
-- License : BSD-style
66
-- Maintainer : michel.boucey@gmail.com
7-
-- Stability : provisional
87
--
98
-- Dealing with IPv6 address text representations, canonization and manipulations.
109
--
@@ -59,11 +58,16 @@ maybeFullIPv6Addr t =
5958
-- > ip6arpa (IPv6Addr "4321:0:1:2:3:4:567:89ab") == Just "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa."
6059
--
6160
ip6arpa :: IPv6Addr -> T.Text
62-
ip6arpa t = rev (fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr t) T.empty
63-
where rev i o = if i == T.empty then o `T.append` T.pack "ip6.arpa."
64-
else do let c = T.last i
65-
rev (T.init i)
66-
(if c /= ':' then o `T.append` T.pack [c] `T.append` T.pack "." else o)
61+
ip6arpa t =
62+
rev (fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr t) T.empty
63+
where
64+
rev i o = if i == T.empty
65+
then o `T.append` T.pack "ip6.arpa."
66+
else do let c = T.last i
67+
rev (T.init i)
68+
(if c /= ':'
69+
then o `T.append` T.pack [c] `T.append` T.pack "."
70+
else o)
6771

6872
-- | Returns 'Just' the canonized 'IPv6Addr' of the given network interface,
6973
-- or 'Nothing'.

‎Text/IPv6Addr/Internal.hs

+83-83
Original file line numberDiff line numberDiff line change
@@ -5,20 +5,14 @@
55
-- Copyright : (c) Michel Boucey 2011-2013
66
-- License : BSD-Style
77
-- Maintainer : michel.boucey@gmail.com
8-
-- Stability : provisional
98
--
109
-- Dealing with IPv6 address text representations, canonization and manipulations.
1110
--
1211

1312
-- -----------------------------------------------------------------------------
1413

1514
module Text.IPv6Addr.Internal
16-
( colon
17-
, doubleColon
18-
, fullSixteenBit
19-
, sixteenBit
20-
, ipv4Addr
21-
, expandTokens
15+
( expandTokens
2216
, macAddr
2317
, maybeIPv6AddrTokens
2418
, ipv4AddrToIPv6AddrTokens
@@ -62,7 +56,7 @@ ipv6TokenToText (SixteenBit s) = s
6256
ipv6TokenToText Colon = T.pack ":"
6357
ipv6TokenToText DoubleColon = T.pack "::"
6458
-- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)
65-
ipv6TokenToText AllZeros = tok0
59+
ipv6TokenToText AllZeros = tok0 --
6660
ipv6TokenToText (IPv4Addr a) = a
6761

6862
-- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address.
@@ -79,28 +73,28 @@ isIPv6Addr tks =
7973
firstValidToken tks &&
8074
(case countIPv4Addr tks of
8175
0 -> case lasttk of
82-
SixteenBit _ -> lenconst
83-
DoubleColon -> lenconst
84-
AllZeros -> lenconst
85-
_ -> False
76+
SixteenBit _ -> lenconst
77+
DoubleColon -> lenconst
78+
AllZeros -> lenconst
79+
_ -> False
8680
1 -> case lasttk of
87-
IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)
88-
_ -> False
81+
IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)
82+
_ -> False
8983
otherwise -> False))
9084
where diffNext [] = False
9185
diffNext [_] = True
9286
diffNext (t:ts) = do
9387
let h = head ts
9488
case t of
95-
SixteenBit _ -> case h of
96-
SixteenBit _ -> False
97-
AllZeros -> False
98-
_ -> diffNext ts
99-
AllZeros -> case h of
100-
SixteenBit _ -> False
101-
AllZeros -> False
102-
_ -> diffNext ts
103-
_ -> diffNext ts
89+
SixteenBit _ -> case h of
90+
SixteenBit _ -> False
91+
AllZeros -> False
92+
_ -> diffNext ts
93+
AllZeros -> case h of
94+
SixteenBit _ -> False
95+
AllZeros -> False
96+
_ -> diffNext ts
97+
_ -> diffNext ts
10498
firstValidToken l =
10599
case head l of
106100
SixteenBit _ -> True
@@ -111,41 +105,44 @@ isIPv6Addr tks =
111105
tok1 = T.pack "1"
112106

113107
countIPv4Addr = foldr oneMoreIPv4Addr 0
114-
where
115-
oneMoreIPv4Addr t c = case t of
116-
IPv4Addr _ -> c + 1
117-
otherwise -> c
108+
where
109+
oneMoreIPv4Addr t c = case t of
110+
IPv4Addr _ -> c + 1
111+
otherwise -> c
118112

119113
-- | This is the main function which returns 'Just' the list of a tokenized IPv6
120114
-- address text representation validated against RFC 4291 and canonized
121115
-- in conformation with RFC 5952, or 'Nothing'.
122116
maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
123117
maybeTokIPv6Addr t =
124118
case maybeIPv6AddrTokens t of
125-
Just ltks -> if isIPv6Addr ltks
119+
Just ltks -> if isIPv6Addr ltks
126120
then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks
127121
else Nothing
128-
Nothing -> Nothing
129-
where ipv4AddrReplacement ltks =
130-
if ipv4AddrRewrite ltks
131-
then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks) else ltks
122+
Nothing -> Nothing
123+
where
124+
ipv4AddrReplacement ltks =
125+
if ipv4AddrRewrite ltks
126+
then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks)
127+
else ltks
132128

133129
-- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an
134130
-- embedded IPv4 address if present.
135131
maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
136-
maybeTokPureIPv6Addr t =
137-
do ltks <- maybeIPv6AddrTokens t
138-
if isIPv6Addr ltks
139-
then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks
140-
else Nothing
141-
where ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')
132+
maybeTokPureIPv6Addr t = do
133+
ltks <- maybeIPv6AddrTokens t
134+
if isIPv6Addr ltks
135+
then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks
136+
else Nothing
137+
where
138+
ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')
142139

143140
-- | Tokenize a 'Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'.
144141
maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]
145142
maybeIPv6AddrTokens s =
146143
case readText s of
147-
Done r l -> if r==T.empty then Just l else Nothing
148-
Fail {} -> Nothing
144+
Done r l -> if r==T.empty then Just l else Nothing
145+
Fail {} -> Nothing
149146
where
150147
readText s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) s) T.empty
151148

@@ -194,9 +191,10 @@ ipv4AddrToIPv6AddrTokens t =
194191
[ SixteenBit ((!!) m 0 `T.append` addZero ((!!) m 1))
195192
, Colon
196193
, SixteenBit ((!!) m 2 `T.append` addZero ((!!) m 3))]
197-
_ -> [t]
198-
where toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a
199-
addZero d = if T.length d == 1 then tok0 `T.append` d else d
194+
_ -> [t]
195+
where
196+
toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a
197+
addZero d = if T.length d == 1 then tok0 `T.append` d else d
200198

201199
expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]
202200
expandTokens = map expandToken
@@ -206,19 +204,20 @@ expandTokens = map expandToken
206204

207205
fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
208206
fromDoubleColon tks =
209-
if DoubleColon `notElem` tks then tks
210-
else do
211-
let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks
212-
let fsts = fst s
213-
let snds = if not (null (snd s)) then tail(snd s) else []
214-
let fste = if null fsts then [] else fsts ++ [Colon]
215-
let snde = if null snds then [] else Colon : snds
216-
fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde
217-
where quantityOfAllZerosTokenToReplace x =
218-
ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x
219-
where
220-
ntks tks = if countIPv4Addr tks == 1 then 7 else 8
221-
allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros)
207+
if DoubleColon `notElem` tks
208+
then tks
209+
else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks
210+
let fsts = fst s
211+
let snds = if not (null (snd s)) then tail(snd s) else []
212+
let fste = if null fsts then [] else fsts ++ [Colon]
213+
let snde = if null snds then [] else Colon : snds
214+
fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde
215+
where
216+
allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros)
217+
quantityOfAllZerosTokenToReplace x =
218+
ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x
219+
where
220+
ntks tks = if countIPv4Addr tks == 1 then 7 else 8
222221

223222
toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
224223
toDoubleColon tks =
@@ -235,14 +234,14 @@ toDoubleColon tks =
235234
zerosRunToReplace t =
236235
let l = longestLengthZerosRun t
237236
in (firstLongestZerosRunIndex t l,l)
238-
where firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x
239-
longestLengthZerosRun x =
240-
maximum $ map longest x
241-
where longest t = case t of
242-
(True,i) -> i
243-
_ -> 0
244-
zerosRunsList x =
245-
map helper $ groupZerosRuns x
237+
where
238+
firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x
239+
longestLengthZerosRun x =
240+
maximum $ map longest x
241+
where longest t = case t of
242+
(True,i) -> i
243+
_ -> 0
244+
zerosRunsList x = map helper $ groupZerosRuns x
246245
where
247246
helper h = (head h == AllZeros, lh) where lh = length h
248247
groupZerosRuns = group . filter (/= Colon)
@@ -253,13 +252,14 @@ ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l
253252
networkInterfacesIPv6AddrList :: IO [(String,IPv6)]
254253
networkInterfacesIPv6AddrList =
255254
getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n
256-
where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)
255+
where
256+
networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)
257257

258258
fullSixteenBit :: T.Text -> Maybe IPv6AddrToken
259259
fullSixteenBit t =
260260
case parse fourHexaChars t of
261-
Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing
262-
_ -> Nothing
261+
Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing
262+
_ -> Nothing
263263

264264
macAddr :: Parser (Maybe [IPv6AddrToken])
265265
macAddr = do
@@ -277,33 +277,33 @@ sixteenBit = do
277277
-- "Leading zeros MUST be suppressed" (RFC 5952, 4.1)
278278
let r' = T.dropWhile (=='0') $ T.pack r
279279
return $ if T.null r'
280-
then AllZeros
281-
-- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)
282-
else SixteenBit $ T.toLower r'
280+
then AllZeros
281+
-- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)
282+
else SixteenBit $ T.toLower r'
283283

284284
ipv4Addr :: Parser IPv6AddrToken
285285
ipv4Addr = do
286286
n1 <- manyDigits <*. dot
287287
if n1 /= T.empty
288-
then do n2 <- manyDigits <*. dot
289-
if n2 /= T.empty
290-
then do n3 <- manyDigits <*. dot
291-
if n3 /= T.empty
292-
then do n4 <- manyDigits
293-
if n4 /= T.empty
294-
then return $ IPv4Addr $ T.intercalate dot [n1,n2,n3,n4]
295-
else parserFailure
296-
else parserFailure
297-
else parserFailure
298-
else parserFailure
288+
then do n2 <- manyDigits <*. dot
289+
if n2 /= T.empty
290+
then do n3 <- manyDigits <*. dot
291+
if n3 /= T.empty
292+
then do n4 <- manyDigits
293+
if n4 /= T.empty
294+
then return $ IPv4Addr $ T.intercalate dot [n1,n2,n3,n4]
295+
else parserFailure
296+
else parserFailure
297+
else parserFailure
298+
else parserFailure
299299
where
300300
parserFailure = fail "ipv4Addr parsing failure"
301301
dot = T.pack "."
302302
manyDigits = do
303303
ds <- takeWhile1 isDigit
304304
case R.decimal ds of
305-
Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty)
306-
Left _ -> return T.empty
305+
Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty)
306+
Left _ -> return T.empty
307307

308308
doubleColon :: Parser IPv6AddrToken
309309
doubleColon = do

‎Text/IPv6Addr/Manip.hs

+9-12
Original file line numberDiff line numberDiff line change
@@ -5,33 +5,29 @@
55
-- Copyright : (c) Michel Boucey 2011-2013
66
-- License : BSD-Style
77
-- Maintainer : michel.boucey@gmail.com
8-
-- Stability : provisional
98
--
109
-- Dealing with IPv6 address text representations, canonization and manipulations.
1110
--
1211

1312
-- -----------------------------------------------------------------------------
1413

1514
module Text.IPv6Addr.Manip
16-
(
17-
module Text.IPv6Addr.Internal
18-
, sixteenBitArbToken
15+
( sixteenBitArbToken
1916
, partialRandAddr
2017
, macAddrToIPv6AddrTokens
2118
, getTokIPv6AddrOf
2219
, getTokMacAddrOf
2320
) where
2421

25-
import Control.Monad (replicateM)
2622
import Control.Applicative ((<$>))
23+
import Control.Monad (replicateM)
2724
import Data.Attoparsec.Text as A
2825
import Data.Char (intToDigit,isHexDigit)
2926
import Data.List (intersperse)
3027
import Data.Maybe (fromJust)
3128
import qualified Data.Text as T
32-
import System.Random (randomRIO)
33-
3429
import Network.Info
30+
import System.Random (randomRIO)
3531

3632
import Text.IPv6Addr.Internal
3733
import Text.IPv6Addr.Types
@@ -44,9 +40,10 @@ import Text.IPv6Addr.Types
4440
sixteenBitArbToken :: String -> IO IPv6AddrToken
4541
sixteenBitArbToken m =
4642
mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g
47-
where getHex c
48-
| c == '_' = randomRIO(0,15) >>= \r -> return $ intToDigit r
49-
| otherwise = return c
43+
where
44+
getHex c
45+
| c == '_' = randomRIO(0,15) >>= \r -> return $ intToDigit r
46+
| otherwise = return c
5047

5148
-- | Generates a partial 'IPv6Addr' with n 'SixteenBit'
5249
partialRandAddr :: Int -> IO [IPv6AddrToken]
@@ -61,8 +58,8 @@ partialRandAddr n
6158
macAddrToIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]
6259
macAddrToIPv6AddrTokens t =
6360
case parse macAddr t of
64-
Done a b -> if a==T.empty then intersperse Colon <$> b else Nothing
65-
_ -> Nothing
61+
Done a b -> if a==T.empty then intersperse Colon <$> b else Nothing
62+
_ -> Nothing
6663

6764
--
6865
-- Functions based upon Network.Info to get local MAC and IPv6 addresses.

‎Text/IPv6Addr/Types.hs

-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@
55
-- Copyright : (c) Michel Boucey 2011-2013
66
-- License : BSD-Style
77
-- Maintainer : michel.boucey@gmail.com
8-
-- Stability : provisional
98
--
109
-- Dealing with IPv6 address text representations, canonization and manipulations.
1110
--

0 commit comments

Comments
 (0)