{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.IPv6Addr
( IPv6Addr (..)
, maybeIPv6Addr
, maybePureIPv6Addr
, maybeFullIPv6Addr
, sameIPv6Addr
, toIPv6
, toHostName
, toIP6ARPA
, toUNC
, getIPv6AddrOf
, randIPv6Addr
, randIPv6AddrWithPrefix
, IPv6AddrToken (..)
, randIPv6AddrChunk
, randPartialIPv6Addr
, macAddrToIPv6AddrTokens
, getTokIPv6AddrOf
, getTokMacAddrOf ) where
import Control.Applicative ((<|>))
import Control.Monad (guard, replicateM)
import Data.Aeson
import Data.Attoparsec.Text
import Data.Char (intToDigit, isDigit)
import Data.IP (IPv6)
import Data.List (elemIndex, elemIndices, foldl', group,
intersperse, isSuffixOf)
import Data.Maybe (fromJust, isJust)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T hiding (foldl')
import qualified Data.Text.Read as R (decimal)
#if MIN_VERSION_network (2,7,0)
import Network.Socket (HostName)
#else
import Network (HostName)
#endif
import Network.Info
import Numeric (showHex)
import System.Random (randomRIO)
newtype IPv6Addr = IPv6Addr { IPv6Addr -> Text
unIPv6Addr :: T.Text }
instance Show IPv6Addr where
show :: IPv6Addr -> String
show (IPv6Addr Text
a) = Text -> String
T.unpack Text
a
instance Eq IPv6Addr where
== :: IPv6Addr -> IPv6Addr -> Bool
(==) (IPv6Addr Text
a) (IPv6Addr Text
b) =
(IPv6Addr -> Text
unIPv6Addr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
a) forall a. Eq a => a -> a -> Bool
== (IPv6Addr -> Text
unIPv6Addr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
b)
instance ToJSON IPv6Addr where
toJSON :: IPv6Addr -> Value
toJSON (IPv6Addr Text
a) = Text -> Value
String Text
a
instance FromJSON IPv6Addr where
parseJSON :: Value -> Parser IPv6Addr
parseJSON (String Text
s) =
case Text -> Maybe IPv6Addr
maybeIPv6Addr Text
s of
Just IPv6Addr
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IPv6Addr
a
Maybe IPv6Addr
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not An IPv6 Address"
parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JSON String Expected"
data IPv6AddrToken
= SixteenBit !T.Text
| AllZeros
| Colon
| DoubleColon
| IPv4Addr !T.Text
deriving (IPv6AddrToken -> IPv6AddrToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6AddrToken -> IPv6AddrToken -> Bool
$c/= :: IPv6AddrToken -> IPv6AddrToken -> Bool
== :: IPv6AddrToken -> IPv6AddrToken -> Bool
$c== :: IPv6AddrToken -> IPv6AddrToken -> Bool
Eq, Int -> IPv6AddrToken -> ShowS
[IPv6AddrToken] -> ShowS
IPv6AddrToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPv6AddrToken] -> ShowS
$cshowList :: [IPv6AddrToken] -> ShowS
show :: IPv6AddrToken -> String
$cshow :: IPv6AddrToken -> String
showsPrec :: Int -> IPv6AddrToken -> ShowS
$cshowsPrec :: Int -> IPv6AddrToken -> ShowS
Show)
maybeIPv6Addr :: T.Text -> Maybe IPv6Addr
maybeIPv6Addr :: Text -> Maybe IPv6Addr
maybeIPv6Addr Text
t = Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr Text
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr
maybePureIPv6Addr :: T.Text -> Maybe IPv6Addr
maybePureIPv6Addr :: Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
t = Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr Text
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr
maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr
maybeFullIPv6Addr :: Text -> Maybe IPv6Addr
maybeFullIPv6Addr Text
t =
Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr Text
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
([IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
expandTokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon)
sameIPv6Addr :: T.Text -> T.Text -> Bool
sameIPv6Addr :: Text -> Text -> Bool
sameIPv6Addr Text
a Text
b =
case Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
a of
Maybe IPv6Addr
Nothing -> Bool
False
Just IPv6Addr
a' ->
case Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
b of
Maybe IPv6Addr
Nothing -> Bool
False
Just IPv6Addr
b' -> IPv6Addr
a' forall a. Eq a => a -> a -> Bool
== IPv6Addr
b'
toIP6ARPA :: IPv6Addr -> T.Text
toIP6ARPA :: IPv6Addr -> Text
toIP6ARPA IPv6Addr
a =
Text -> Text
T.reverse ((Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go forall a b. (a -> b) -> a -> b
$ IPv6Addr -> Text
unIPv6Addr forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Text -> Maybe IPv6Addr
maybeFullIPv6Addr forall a b. (a -> b) -> a -> b
$ IPv6Addr -> Text
unIPv6Addr IPv6Addr
a) forall a. Semigroup a => a -> a -> a
<> Text
"IP6.ARPA."
where
go :: Char -> Text
go Char
':' = Text
T.empty
go Char
c = Text
"." forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack [Char
c]
toUNC :: IPv6Addr -> T.Text
toUNC :: IPv6Addr -> Text
toUNC IPv6Addr
a =
(Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go (IPv6Addr -> Text
unIPv6Addr forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Text -> Maybe IPv6Addr
maybePureIPv6Addr forall a b. (a -> b) -> a -> b
$ IPv6Addr -> Text
unIPv6Addr IPv6Addr
a) forall a. Semigroup a => a -> a -> a
<> Text
".ipv6-literal.net"
where
go :: Char -> Text
go Char
':' = Text
"-"
go Char
c = String -> Text
T.pack [Char
c]
toHostName :: IPv6Addr -> HostName
toHostName :: IPv6Addr -> String
toHostName = forall a. Show a => a -> String
show
toIPv6 :: IPv6Addr -> Data.IP.IPv6
toIPv6 :: IPv6Addr -> IPv6
toIPv6 IPv6Addr
a = forall a. Read a => String -> a
read (forall a. Show a => a -> String
show IPv6Addr
a)
getIPv6AddrOf :: String -> IO (Maybe IPv6Addr)
getIPv6AddrOf :: String -> IO (Maybe IPv6Addr)
getIPv6AddrOf String
s =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (Text -> Maybe IPv6Addr
maybeIPv6Addr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, IPv6)]
networkInterfacesIPv6AddrList)
randIPv6Addr :: IO IPv6Addr
randIPv6Addr :: IO IPv6Addr
randIPv6Addr = forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> IO (Maybe IPv6Addr)
randIPv6AddrWithPrefix forall a. Maybe a
Nothing
randIPv6AddrWithPrefix :: Maybe T.Text -> IO (Maybe IPv6Addr)
randIPv6AddrWithPrefix :: Maybe Text -> IO (Maybe IPv6Addr)
randIPv6AddrWithPrefix Maybe Text
Nothing = do
Int
r <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
1,Int
8)
[IPv6AddrToken]
tks <-
case Int
r of
Int
8 -> Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
8
Int
_ -> do
Int
r' <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
1,Int
8forall a. Num a => a -> a -> a
-Int
r)
case Int
r forall a. Num a => a -> a -> a
+ Int
r' of
Int
7 -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [IPv6AddrToken
Colon,IPv6AddrToken
AllZeros,IPv6AddrToken
Colon]
, Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r'
]
Int
8 -> Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
8
Int
_ -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [IPv6AddrToken
DoubleColon]
, Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r'
]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr [IPv6AddrToken]
tks)
randIPv6AddrWithPrefix (Just Text
p) = do
let mtks :: Maybe [IPv6AddrToken]
mtks = Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens Text
p
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Maybe a -> Bool
isJust Maybe [IPv6AddrToken]
mtks)
let tks :: [IPv6AddrToken]
tks = forall a. HasCallStack => Maybe a -> a
fromJust Maybe [IPv6AddrToken]
mtks
Int
ntks <- do
let ctks :: (Int, Int)
ctks = [IPv6AddrToken] -> (Int, Int)
countChunks [IPv6AddrToken]
tks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case (forall a b. (a, b) -> b
snd (Int, Int)
ctks :: Int) of
Int
0 -> Int
8 forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (Int, Int)
ctks
Int
1 -> Int
6 forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (Int, Int)
ctks
Int
_ -> Int
0
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
ntks forall a. Ord a => a -> a -> Bool
> Int
0)
[IPv6AddrToken]
rtks <- Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
ntks
let tks' :: [IPv6AddrToken]
tks' = [IPv6AddrToken] -> [IPv6AddrToken]
addColon [IPv6AddrToken]
tks forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken]
rtks
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([IPv6AddrToken] -> Bool
isIPv6Addr [IPv6AddrToken]
tks')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr forall a b. (a -> b) -> a -> b
$
([IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon) [IPv6AddrToken]
tks'
where
countChunks :: [IPv6AddrToken] -> (Int, Int)
countChunks =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}. (Num a, Num b) => IPv6AddrToken -> (a, b) -> (a, b)
go (Int
0,Int
0)
where
go :: IPv6AddrToken -> (a, b) -> (a, b)
go IPv6AddrToken
c (a
a,b
b) =
case IPv6AddrToken
c of
SixteenBit Text
_ -> (a
aforall a. Num a => a -> a -> a
+a
1,b
b)
IPv6AddrToken
AllZeros -> (a
aforall a. Num a => a -> a -> a
+a
1,b
b)
IPv6AddrToken
DoubleColon -> (a
a,b
bforall a. Num a => a -> a -> a
+b
1)
IPv6AddrToken
_ -> (a
a,b
b)
addColon :: [IPv6AddrToken] -> [IPv6AddrToken]
addColon [IPv6AddrToken]
ts =
case forall a. [a] -> a
last [IPv6AddrToken]
ts of
SixteenBit Text
_ -> [IPv6AddrToken]
ts forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
Colon]
IPv6AddrToken
AllZeros -> [IPv6AddrToken]
ts forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
Colon]
IPv6AddrToken
_ -> [IPv6AddrToken]
ts
randIPv6AddrChunk :: String -> IO IPv6AddrToken
randIPv6AddrChunk :: String -> IO IPv6AddrToken
randIPv6AddrChunk String
m =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> IO Char
getHex String
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
g -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IPv6AddrToken
SixteenBit forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'0') forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
g)
where
getHex :: Char -> IO Char
getHex Char
c
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' = IO Char
getDigit
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
randPartialIPv6Addr :: Int -> IO [IPv6AddrToken]
randPartialIPv6Addr :: Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
n =
if Int
n forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
< Int
9
then
forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Text -> IPv6AddrToken
SixteenBit forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 IO Char
getDigit)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure []
macAddrToIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]
macAddrToIPv6AddrTokens :: Text -> Maybe [IPv6AddrToken]
macAddrToIPv6AddrTokens Text
t =
case forall a. Parser a -> Text -> Result a
parse Parser (Maybe [IPv6AddrToken])
macAddr Text
t of
Done Text
"" Maybe [IPv6AddrToken]
b -> forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [IPv6AddrToken]
b
IResult Text (Maybe [IPv6AddrToken])
_ -> forall a. Maybe a
Nothing
getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokIPv6AddrOf String
s =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addrforall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, IPv6)]
networkInterfacesIPv6AddrList)
getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokMacAddrOf String
s =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (Text -> Maybe [IPv6AddrToken]
macAddrToIPv6AddrTokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, MAC)]
networkInterfacesMacAddrList)
where
networkInterfacesMacAddrList :: IO [(String, MAC)]
networkInterfacesMacAddrList = IO [NetworkInterface]
getNetworkInterfaces forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\[NetworkInterface]
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkInterface -> (String, MAC)
networkInterfacesMac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NetworkInterface]
n)
where networkInterfacesMac :: NetworkInterface -> (String, MAC)
networkInterfacesMac (NetworkInterface String
n IPv4
_ IPv6
_ MAC
m) = (String
n,MAC
m)
getDigit :: IO Char
getDigit :: IO Char
getDigit = Int -> Char
intToDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0,Int
15)
ipv6TokensToText :: [IPv6AddrToken] -> T.Text
ipv6TokensToText :: [IPv6AddrToken] -> Text
ipv6TokensToText [IPv6AddrToken]
l = [Text] -> Text
T.concat (IPv6AddrToken -> Text
ipv6TokenToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IPv6AddrToken]
l)
ipv6TokenToText :: IPv6AddrToken -> T.Text
ipv6TokenToText :: IPv6AddrToken -> Text
ipv6TokenToText (SixteenBit Text
s) = Text
s
ipv6TokenToText IPv6AddrToken
Colon = Text
":"
ipv6TokenToText IPv6AddrToken
DoubleColon = Text
"::"
ipv6TokenToText IPv6AddrToken
AllZeros = Text
"0"
ipv6TokenToText (IPv4Addr Text
a) = Text
a
isIPv6Addr :: [IPv6AddrToken] -> Bool
isIPv6Addr :: [IPv6AddrToken] -> Bool
isIPv6Addr [] = Bool
False
isIPv6Addr [IPv6AddrToken
DoubleColon] = Bool
True
isIPv6Addr [IPv6AddrToken
DoubleColon,SixteenBit Text
"1"] = Bool
True
isIPv6Addr [IPv6AddrToken]
tks =
[IPv6AddrToken] -> Bool
diffNext [IPv6AddrToken]
tks Bool -> Bool -> Bool
&& (do
let cdctks :: Int
cdctks = [IPv6AddrToken] -> Int
countDoubleColon [IPv6AddrToken]
tks
lentks :: Int
lentks = forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPv6AddrToken]
tks
lasttk :: IPv6AddrToken
lasttk = forall a. [a] -> a
last [IPv6AddrToken]
tks
lenconst :: Bool
lenconst = (Int
lentks forall a. Eq a => a -> a -> Bool
== Int
15 Bool -> Bool -> Bool
&& Int
cdctks forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| (Int
lentks forall a. Ord a => a -> a -> Bool
< Int
15 Bool -> Bool -> Bool
&& Int
cdctks forall a. Eq a => a -> a -> Bool
== Int
1)
[IPv6AddrToken] -> Bool
firstValidToken [IPv6AddrToken]
tks Bool -> Bool -> Bool
&&
(case [IPv6AddrToken] -> Int
countIPv4Addr [IPv6AddrToken]
tks :: Int of
Int
0 -> case IPv6AddrToken
lasttk of
SixteenBit Text
_ -> Bool
lenconst
IPv6AddrToken
DoubleColon -> Bool
lenconst
IPv6AddrToken
AllZeros -> Bool
lenconst
IPv6AddrToken
_ -> Bool
False
Int
1 -> case IPv6AddrToken
lasttk of
IPv4Addr Text
_ ->
(Int
lentks forall a. Eq a => a -> a -> Bool
== Int
13 Bool -> Bool -> Bool
&& Int
cdctks forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| (Int
lentks forall a. Ord a => a -> a -> Bool
< Int
12 Bool -> Bool -> Bool
&& Int
cdctks forall a. Eq a => a -> a -> Bool
== Int
1)
IPv6AddrToken
_ -> Bool
False
Int
_ -> Bool
False))
where
diffNext :: [IPv6AddrToken] -> Bool
diffNext [] = Bool
False
diffNext [IPv6AddrToken
_] = Bool
True
diffNext (IPv6AddrToken
t:[IPv6AddrToken]
ts) = do
let h :: IPv6AddrToken
h = forall a. [a] -> a
head [IPv6AddrToken]
ts
case IPv6AddrToken
t of
IPv6AddrToken
DoubleColon ->
case IPv6AddrToken
h of
IPv6AddrToken
Colon -> Bool
False
IPv6AddrToken
_ -> Bool
True
SixteenBit Text
_ ->
case IPv6AddrToken
h of
SixteenBit Text
_ -> Bool
False
IPv6AddrToken
AllZeros -> Bool
False
IPv6AddrToken
_ -> [IPv6AddrToken] -> Bool
diffNext [IPv6AddrToken]
ts
IPv6AddrToken
AllZeros ->
case IPv6AddrToken
h of
SixteenBit Text
_ -> Bool
False
IPv6AddrToken
AllZeros -> Bool
False
IPv6AddrToken
_ -> [IPv6AddrToken] -> Bool
diffNext [IPv6AddrToken]
ts
IPv6AddrToken
_ -> [IPv6AddrToken] -> Bool
diffNext [IPv6AddrToken]
ts
firstValidToken :: [IPv6AddrToken] -> Bool
firstValidToken [IPv6AddrToken]
l =
case forall a. [a] -> a
head [IPv6AddrToken]
l of
SixteenBit Text
_ -> Bool
True
IPv6AddrToken
DoubleColon -> Bool
True
IPv6AddrToken
AllZeros -> Bool
True
IPv6AddrToken
_ -> Bool
False
countDoubleColon :: [IPv6AddrToken] -> Int
countDoubleColon [IPv6AddrToken]
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => a -> [a] -> [Int]
elemIndices IPv6AddrToken
DoubleColon [IPv6AddrToken]
l)
countIPv4Addr :: [IPv6AddrToken] -> Int
countIPv4Addr :: [IPv6AddrToken] -> Int
countIPv4Addr =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Num a => IPv6AddrToken -> a -> a
oneMoreIPv4Addr Int
0
where
oneMoreIPv4Addr :: IPv6AddrToken -> a -> a
oneMoreIPv4Addr IPv6AddrToken
t a
c =
case IPv6AddrToken
t of
IPv4Addr Text
_ -> a
c forall a. Num a => a -> a -> a
+ a
1
IPv6AddrToken
_ -> a
c
maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr :: Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr Text
t = do
[IPv6AddrToken]
ltks <- Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([IPv6AddrToken] -> Bool
isIPv6Addr [IPv6AddrToken]
ltks)
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken]
ltks)
where
ipv4AddrReplacement :: [IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement [IPv6AddrToken]
ltks =
if [IPv6AddrToken] -> Bool
ipv4AddrRewrite [IPv6AddrToken]
ltks
then forall a. [a] -> [a]
init [IPv6AddrToken]
ltks forall a. Semigroup a => a -> a -> a
<> IPv6AddrToken -> [IPv6AddrToken]
ipv4AddrToIPv6AddrTokens (forall a. [a] -> a
last [IPv6AddrToken]
ltks)
else [IPv6AddrToken]
ltks
maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr :: Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr Text
t = do
[IPv6AddrToken]
ltks <- Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([IPv6AddrToken] -> Bool
isIPv6Addr [IPv6AddrToken]
ltks)
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken]
ltks)
where
ipv4AddrReplacement :: [IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement [IPv6AddrToken]
ltks' =
forall a. [a] -> [a]
init [IPv6AddrToken]
ltks' forall a. Semigroup a => a -> a -> a
<> IPv6AddrToken -> [IPv6AddrToken]
ipv4AddrToIPv6AddrTokens (forall a. [a] -> a
last [IPv6AddrToken]
ltks')
maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens :: Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens Text
s =
case Text -> IResult Text [IPv6AddrToken]
readText Text
s of
Done Text
"" [IPv6AddrToken]
l -> forall a. a -> Maybe a
Just [IPv6AddrToken]
l
IResult Text [IPv6AddrToken]
_ -> forall a. Maybe a
Nothing
where
readText :: Text -> IResult Text [IPv6AddrToken]
readText Text
_s =
forall i r. Monoid i => IResult i r -> i -> IResult i r
feed
(forall a. Parser a -> Text -> Result a
parse (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 forall a b. (a -> b) -> a -> b
$ Parser Text IPv6AddrToken
ipv4Addr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text IPv6AddrToken
sixteenBit forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text IPv6AddrToken
doubleColon forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text IPv6AddrToken
colon) Text
_s)
Text
T.empty
ipv4AddrRewrite :: [IPv6AddrToken] -> Bool
ipv4AddrRewrite :: [IPv6AddrToken] -> Bool
ipv4AddrRewrite [IPv6AddrToken]
tks =
case forall a. [a] -> a
last [IPv6AddrToken]
tks of
IPv4Addr Text
_ -> do
let itks :: [IPv6AddrToken]
itks = forall a. [a] -> [a]
init [IPv6AddrToken]
tks
Bool -> Bool
not ([IPv6AddrToken]
itks forall a. Eq a => a -> a -> Bool
== [IPv6AddrToken
DoubleColon]
Bool -> Bool -> Bool
|| [IPv6AddrToken]
itks forall a. Eq a => a -> a -> Bool
== [IPv6AddrToken
DoubleColon,Text -> IPv6AddrToken
SixteenBit Text
tokffff,IPv6AddrToken
Colon]
Bool -> Bool -> Bool
|| [IPv6AddrToken]
itks forall a. Eq a => a -> a -> Bool
== [IPv6AddrToken
DoubleColon,Text -> IPv6AddrToken
SixteenBit Text
tokffff,IPv6AddrToken
Colon,IPv6AddrToken
AllZeros,IPv6AddrToken
Colon]
Bool -> Bool -> Bool
|| [IPv6AddrToken]
itks forall a. Eq a => a -> a -> Bool
== [Text -> IPv6AddrToken
SixteenBit Text
"64",IPv6AddrToken
Colon,Text -> IPv6AddrToken
SixteenBit Text
"ff9b",IPv6AddrToken
DoubleColon]
Bool -> Bool -> Bool
|| [Text -> IPv6AddrToken
SixteenBit Text
"200",IPv6AddrToken
Colon,Text -> IPv6AddrToken
SixteenBit Text
tok5efe,IPv6AddrToken
Colon] forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [IPv6AddrToken]
itks
Bool -> Bool -> Bool
|| [IPv6AddrToken
AllZeros,IPv6AddrToken
Colon,Text -> IPv6AddrToken
SixteenBit Text
tok5efe,IPv6AddrToken
Colon] forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [IPv6AddrToken]
itks
Bool -> Bool -> Bool
|| [IPv6AddrToken
DoubleColon,Text -> IPv6AddrToken
SixteenBit Text
tok5efe,IPv6AddrToken
Colon] forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [IPv6AddrToken]
itks)
IPv6AddrToken
_ -> Bool
False
where
tokffff :: Text
tokffff = Text
"ffff"
tok5efe :: Text
tok5efe = Text
"5efe"
ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken]
ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken]
ipv4AddrToIPv6AddrTokens IPv6AddrToken
t =
case IPv6AddrToken
t of
IPv4Addr Text
a -> do
let m :: [Text]
m = Text -> [Text]
toHex Text
a
[ Text -> IPv6AddrToken
SixteenBit (forall a. [a] -> Int -> a
(!!) [Text]
m Int
0 forall a. Semigroup a => a -> a -> a
<> Text -> Text
addZero (forall a. [a] -> Int -> a
(!!) [Text]
m Int
1))
, IPv6AddrToken
Colon
, Text -> IPv6AddrToken
SixteenBit (forall a. [a] -> Int -> a
(!!) [Text]
m Int
2 forall a. Semigroup a => a -> a -> a
<> Text -> Text
addZero (forall a. [a] -> Int -> a
(!!) [Text]
m Int
3)) ]
IPv6AddrToken
_ -> [IPv6AddrToken
t]
where
toHex :: Text -> [Text]
toHex Text
a = (\Text
x -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
showHex (forall a. Read a => String -> a
read (Text -> String
T.unpack Text
x)::Int) String
"") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
'.') Text
a
addZero :: Text -> Text
addZero Text
d = if Text -> Int
T.length Text
d forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"0" forall a. Semigroup a => a -> a -> a
<> Text
d else Text
d
expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]
expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]
expandTokens =
forall a b. (a -> b) -> [a] -> [b]
map IPv6AddrToken -> IPv6AddrToken
expandToken
where
expandToken :: IPv6AddrToken -> IPv6AddrToken
expandToken (SixteenBit Text
s) = Text -> IPv6AddrToken
SixteenBit (Int -> Char -> Text -> Text
T.justifyRight Int
4 Char
'0' Text
s)
expandToken IPv6AddrToken
AllZeros = Text -> IPv6AddrToken
SixteenBit Text
"0000"
expandToken IPv6AddrToken
t = IPv6AddrToken
t
fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon [IPv6AddrToken]
tks =
if IPv6AddrToken
DoubleColon forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IPv6AddrToken]
tks
then [IPv6AddrToken]
tks
else do
let s :: ([IPv6AddrToken], [IPv6AddrToken])
s = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex IPv6AddrToken
DoubleColon [IPv6AddrToken]
tks) [IPv6AddrToken]
tks
fsts :: [IPv6AddrToken]
fsts = forall a b. (a, b) -> a
fst ([IPv6AddrToken], [IPv6AddrToken])
s
snds :: [IPv6AddrToken]
snds = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a b. (a, b) -> b
snd ([IPv6AddrToken], [IPv6AddrToken])
s)) then forall a. [a] -> [a]
tail(forall a b. (a, b) -> b
snd ([IPv6AddrToken], [IPv6AddrToken])
s) else []
fste :: [IPv6AddrToken]
fste = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IPv6AddrToken]
fsts then [] else [IPv6AddrToken]
fsts forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
Colon]
snde :: [IPv6AddrToken]
snde = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IPv6AddrToken]
snds then [] else IPv6AddrToken
Colon forall a. a -> [a] -> [a]
: [IPv6AddrToken]
snds
[IPv6AddrToken]
fste forall a. Semigroup a => a -> a -> a
<> Int -> [IPv6AddrToken]
allZerosTokensReplacement(forall {a} {t :: * -> *}.
(Num a, Foldable t) =>
t IPv6AddrToken -> a
quantityOfAllZerosTokenToReplace [IPv6AddrToken]
tks) forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken]
snde
where
allZerosTokensReplacement :: Int -> [IPv6AddrToken]
allZerosTokensReplacement Int
x = forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon (forall a. Int -> a -> [a]
replicate Int
x IPv6AddrToken
AllZeros)
quantityOfAllZerosTokenToReplace :: t IPv6AddrToken -> a
quantityOfAllZerosTokenToReplace t IPv6AddrToken
_x =
forall {a}. Num a => [IPv6AddrToken] -> a
ntks [IPv6AddrToken]
tks forall a. Num a => a -> a -> a
- forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
c IPv6AddrToken
_x -> if (IPv6AddrToken
_x forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
DoubleColon) Bool -> Bool -> Bool
&& (IPv6AddrToken
_x forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
Colon) then a
cforall a. Num a => a -> a -> a
+a
1 else a
c) a
0 t IPv6AddrToken
_x
where
ntks :: [IPv6AddrToken] -> a
ntks [IPv6AddrToken]
_tks = if [IPv6AddrToken] -> Int
countIPv4Addr [IPv6AddrToken]
_tks forall a. Eq a => a -> a -> Bool
== Int
1 then a
7 else a
8
toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon [IPv6AddrToken]
tks =
[IPv6AddrToken] -> (Int, Int) -> [IPv6AddrToken]
zerosToDoubleColon [IPv6AddrToken]
tks (forall {b}. (Ord b, Num b) => [(Bool, b)] -> (b, b)
zerosRunToReplace forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken] -> [(Bool, Int)]
zerosRunsList [IPv6AddrToken]
tks)
where
zerosToDoubleColon :: [IPv6AddrToken] -> (Int, Int) -> [IPv6AddrToken]
zerosToDoubleColon [IPv6AddrToken]
ls (Int
_,Int
0) = [IPv6AddrToken]
ls
zerosToDoubleColon [IPv6AddrToken]
ls (Int
_,Int
1) = [IPv6AddrToken]
ls
zerosToDoubleColon [IPv6AddrToken]
ls (Int
i,Int
l) =
let ls' :: [IPv6AddrToken]
ls' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
Colon) [IPv6AddrToken]
ls
in forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon (forall a. Int -> [a] -> [a]
Prelude.take Int
i [IPv6AddrToken]
ls') forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
DoubleColon] forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon (forall a. Int -> [a] -> [a]
drop (Int
iforall a. Num a => a -> a -> a
+Int
l) [IPv6AddrToken]
ls')
zerosRunToReplace :: [(Bool, b)] -> (b, b)
zerosRunToReplace [(Bool, b)]
t =
let l :: b
l = forall {t :: * -> *} {a}.
(Foldable t, Ord a, Functor t, Num a) =>
t (Bool, a) -> a
longestLengthZerosRun [(Bool, b)]
t
in (forall {c}. (Num c, Eq c) => [(Bool, c)] -> c -> c
firstLongestZerosRunIndex [(Bool, b)]
t b
l,b
l)
where
firstLongestZerosRunIndex :: [(Bool, c)] -> c -> c
firstLongestZerosRunIndex [(Bool, c)]
x c
y = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
Prelude.takeWhile (forall a. Eq a => a -> a -> Bool
/=(Bool
True,c
y)) [(Bool, c)]
x
longestLengthZerosRun :: t (Bool, a) -> a
longestLengthZerosRun t (Bool, a)
x =
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall {b}. Num b => (Bool, b) -> b
longest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (Bool, a)
x)
where
longest :: (Bool, b) -> b
longest (Bool, b)
_t =
case (Bool, b)
_t of
(Bool
True,b
i) -> b
i
(Bool, b)
_ -> b
0
zerosRunsList :: [IPv6AddrToken] -> [(Bool, Int)]
zerosRunsList [IPv6AddrToken]
x =
[IPv6AddrToken] -> (Bool, Int)
helper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IPv6AddrToken] -> [[IPv6AddrToken]]
groupZerosRuns [IPv6AddrToken]
x
where
helper :: [IPv6AddrToken] -> (Bool, Int)
helper [IPv6AddrToken]
h = (forall a. [a] -> a
head [IPv6AddrToken]
h forall a. Eq a => a -> a -> Bool
== IPv6AddrToken
AllZeros, Int
lh) where lh :: Int
lh = forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPv6AddrToken]
h
groupZerosRuns :: [IPv6AddrToken] -> [[IPv6AddrToken]]
groupZerosRuns = forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
Colon)
ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr [IPv6AddrToken]
l = forall a. a -> Maybe a
Just (Text -> IPv6Addr
IPv6Addr forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken] -> Text
ipv6TokensToText [IPv6AddrToken]
l)
networkInterfacesIPv6AddrList :: IO [(String,Network.Info.IPv6)]
networkInterfacesIPv6AddrList :: IO [(String, IPv6)]
networkInterfacesIPv6AddrList =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkInterface -> (String, IPv6)
networkInterfacesIPv6Addr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [NetworkInterface]
getNetworkInterfaces
where
networkInterfacesIPv6Addr :: NetworkInterface -> (String, IPv6)
networkInterfacesIPv6Addr (NetworkInterface String
n IPv4
_ IPv6
a MAC
_) = (String
n,IPv6
a)
macAddr :: Parser (Maybe [IPv6AddrToken])
macAddr :: Parser (Maybe [IPv6AddrToken])
macAddr = do
String
n1 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
String
n2 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
String
n3 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
String
n4 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
String
n5 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
String
n6 <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
n1,String
n2,String
n3,String
n4,String
n5,String
n6]
sixteenBit :: Parser IPv6AddrToken
sixteenBit :: Parser Text IPv6AddrToken
sixteenBit = do
String
r <- Parser Text String
ipv6AddrFullChunk forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 Parser Char
hexaChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
hexaChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
1 Parser Char
hexaChar
let r' :: Text
r' = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'0') (String -> Text
T.pack String
r)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if Text -> Bool
T.null Text
r'
then IPv6AddrToken
AllZeros
else Text -> IPv6AddrToken
SixteenBit (Text -> Text
T.toLower Text
r')
ipv4Addr :: Parser IPv6AddrToken
ipv4Addr :: Parser Text IPv6AddrToken
ipv4Addr = do
Text
n1 <- Parser Text Text
manyDigits forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"."
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n1 forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
Text
n2 <- Parser Text Text
manyDigits forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"."
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n2 forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
Text
n3 <- Parser Text Text
manyDigits forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"."
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n3 forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
Text
n4 <- Parser Text Text
manyDigits
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n4 forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IPv6AddrToken
IPv4Addr forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." [Text
n1,Text
n2,Text
n3,Text
n4])
where
manyDigits :: Parser Text Text
manyDigits = (Char -> Bool) -> Parser Text Text
takeWhile1 Char -> Bool
isDigit forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
ds ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case forall a. Integral a => Reader a
R.decimal Text
ds :: Either String (Integer, T.Text) of
Right (Integer
n,Text
_) ->
if Integer
n forall a. Ord a => a -> a -> Bool
< Integer
256
then String -> Text
T.pack (forall a. Show a => a -> String
show Integer
n)
else Text
T.empty
Left String
_ -> Text
T.empty
doubleColon :: Parser IPv6AddrToken
doubleColon :: Parser Text IPv6AddrToken
doubleColon = do
Text
_ <- Text -> Parser Text Text
string Text
"::"
forall (m :: * -> *) a. Monad m => a -> m a
return IPv6AddrToken
DoubleColon
colon :: Parser IPv6AddrToken
colon :: Parser Text IPv6AddrToken
colon = do
Text
_ <- Text -> Parser Text Text
string Text
":"
forall (m :: * -> *) a. Monad m => a -> m a
return IPv6AddrToken
Colon
ipv6AddrFullChunk :: Parser String
ipv6AddrFullChunk :: Parser Text String
ipv6AddrFullChunk = forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 Parser Char
hexaChar
hexaChar :: Parser Char
hexaChar :: Parser Char
hexaChar = (Char -> Bool) -> Parser Char
satisfy (String -> Char -> Bool
inClass String
"0-9a-fA-F")