{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Text.IPv6Addr
    ( IPv6Addr (..)
    , maybeIPv6Addr
    , maybePureIPv6Addr
    , maybeFullIPv6Addr
    , sameIPv6Addr

    -- * Conversions
    , toIPv6
    , toHostName
    , toIP6ARPA
    , toUNC

    -- * Utilities
    , getIPv6AddrOf
    , randIPv6Addr
    , randIPv6AddrWithPrefix

    -- * Manipulations
    , IPv6AddrToken (..)
    , randIPv6AddrChunk
    , randPartialIPv6Addr
    , macAddrToIPv6AddrTokens
    , getTokIPv6AddrOf
    , getTokMacAddrOf ) where

import           Control.Applicative  ((<|>))
import           Control.Monad        (replicateM, guard)
import           Data.Aeson
import           Data.Attoparsec.Text
import           Data.Char            (intToDigit, isDigit)
import           Data.IP              (IPv6)
import           Data.List            (elemIndex, elemIndices, 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
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 (IPv6Addr -> Text) -> Maybe IPv6Addr -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
a) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== (IPv6Addr -> Text
unIPv6Addr (IPv6Addr -> Text) -> Maybe IPv6Addr -> Maybe Text
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  -> IPv6Addr -> Parser IPv6Addr
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPv6Addr
a
      Maybe IPv6Addr
Nothing -> String -> Parser IPv6Addr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not An IPv6 Address"
  parseJSON Value
_          = String -> Parser IPv6Addr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JSON String Expected"

data IPv6AddrToken
  = SixteenBit  !T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk
  | AllZeros            -- ^ An all zeros 16-Bit chunk
  | Colon               -- ^ A separator between 16-Bit chunks
  | DoubleColon         -- ^ A double-colon stands for a unique compression of many consecutive 16-Bit chunks
  | IPv4Addr    !T.Text -- ^ An embedded IPv4 address as representation of the last 32-Bit
  deriving (IPv6AddrToken -> IPv6AddrToken -> Bool
(IPv6AddrToken -> IPv6AddrToken -> Bool)
-> (IPv6AddrToken -> IPv6AddrToken -> Bool) -> Eq IPv6AddrToken
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
(Int -> IPv6AddrToken -> ShowS)
-> (IPv6AddrToken -> String)
-> ([IPv6AddrToken] -> ShowS)
-> Show IPv6AddrToken
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)

-- | Returns 'Just' the text representation of a canonized
-- 'IPv6Addr' in conformation with RFC 5952, or 'Nothing'.
--
-- > maybeIPv6Addr "0:0::FFFF:192.0.2.128" == Just (IPv6Addr "::ffff:192.0.2.128")
--
maybeIPv6Addr :: T.Text -> Maybe IPv6Addr
maybeIPv6Addr :: Text -> Maybe IPv6Addr
maybeIPv6Addr Text
t = Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr Text
t Maybe [IPv6AddrToken]
-> ([IPv6AddrToken] -> Maybe IPv6Addr) -> Maybe IPv6Addr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr

-- | Returns 'Just' a pure 'IPv6Addr', or 'Nothing'.
--
-- > maybePureIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "::ffff:c000:280")
--
maybePureIPv6Addr :: T.Text -> Maybe IPv6Addr
maybePureIPv6Addr :: Text -> Maybe IPv6Addr
maybePureIPv6Addr Text
t = Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr Text
t Maybe [IPv6AddrToken]
-> ([IPv6AddrToken] -> Maybe IPv6Addr) -> Maybe IPv6Addr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr

-- | Returns 'Just' a pure and fully expanded 'IPv6Addr', or 'Nothing'.
--
-- > maybeFullIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "0000:0000:0000:0000:0000:ffff:c000:0280")
--
maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr
maybeFullIPv6Addr :: Text -> Maybe IPv6Addr
maybeFullIPv6Addr Text
t =
  Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr Text
t Maybe [IPv6AddrToken]
-> ([IPv6AddrToken] -> Maybe IPv6Addr) -> Maybe IPv6Addr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    ([IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr ([IPv6AddrToken] -> Maybe IPv6Addr)
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> Maybe IPv6Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
expandTokens ([IPv6AddrToken] -> [IPv6AddrToken])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon)

-- | Returns 'True' if arguments are two textual representations of a same IPv6 address.
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' IPv6Addr -> IPv6Addr -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6Addr
b'

-- | Returns the reverse lookup domain name corresponding of the given IPv6 address (RFC 3596 Section 2.5).
--
-- > toIP6ARPA (IPv6Addr "4321:0:1:2:3:4:567:89ab") == "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."
--
toIP6ARPA :: IPv6Addr -> T.Text
toIP6ARPA :: IPv6Addr -> Text
toIP6ARPA IPv6Addr
a =
  Text -> Text
T.reverse ((Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ IPv6Addr -> Text
unIPv6Addr (IPv6Addr -> Text) -> IPv6Addr -> Text
forall a b. (a -> b) -> a -> b
$ Maybe IPv6Addr -> IPv6Addr
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IPv6Addr -> IPv6Addr) -> Maybe IPv6Addr -> IPv6Addr
forall a b. (a -> b) -> a -> b
$ Text -> Maybe IPv6Addr
maybeFullIPv6Addr (Text -> Maybe IPv6Addr) -> Text -> Maybe IPv6Addr
forall a b. (a -> b) -> a -> b
$ IPv6Addr -> Text
unIPv6Addr IPv6Addr
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"IP6.ARPA."
  where
    go :: Char -> Text
go Char
':' = Text
T.empty
    go Char
c   = Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack [Char
c]

-- | Returns the Windows UNC path name of the given IPv6 Address.
--
-- > toUNC (IPv6Addr "2001:0DB8:002a:1005:230:48ff:fe73:989d") == "2001-db8-2a-1005-230-48ff-fe73-989d.ipv6-literal.net"
--
toUNC :: IPv6Addr -> T.Text
toUNC :: IPv6Addr -> Text
toUNC IPv6Addr
a =
  (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go (IPv6Addr -> Text
unIPv6Addr (IPv6Addr -> Text) -> IPv6Addr -> Text
forall a b. (a -> b) -> a -> b
$ Maybe IPv6Addr -> IPv6Addr
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IPv6Addr -> IPv6Addr) -> Maybe IPv6Addr -> IPv6Addr
forall a b. (a -> b) -> a -> b
$ Text -> Maybe IPv6Addr
maybePureIPv6Addr (Text -> Maybe IPv6Addr) -> Text -> Maybe IPv6Addr
forall a b. (a -> b) -> a -> b
$ IPv6Addr -> Text
unIPv6Addr IPv6Addr
a) Text -> Text -> Text
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]

-- | Given an 'IPv6Addr', returns the corresponding 'HostName'.
toHostName :: IPv6Addr -> HostName
toHostName :: IPv6Addr -> String
toHostName = IPv6Addr -> String
forall a. Show a => a -> String
show

-- | Given an 'IPv6Addr', returns the corresponding 'Data.IP.IPv6' address.
toIPv6 :: IPv6Addr -> Data.IP.IPv6
toIPv6 :: IPv6Addr -> IPv6
toIPv6 IPv6Addr
a = String -> IPv6
forall a. Read a => String -> a
read (IPv6Addr -> String
forall a. Show a => a -> String
show IPv6Addr
a)

-- | Returns 'Just' the canonized 'IPv6Addr' of the given local network interface,
-- or 'Nothing'.
--
-- > getIPv6AddrOf "eth0"
--
getIPv6AddrOf :: String -> IO (Maybe IPv6Addr)
getIPv6AddrOf :: String -> IO (Maybe IPv6Addr)
getIPv6AddrOf String
s =
  Maybe IPv6Addr
-> (IPv6 -> Maybe IPv6Addr) -> Maybe IPv6 -> Maybe IPv6Addr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe IPv6Addr
forall a. Maybe a
Nothing (Text -> Maybe IPv6Addr
maybeIPv6Addr (Text -> Maybe IPv6Addr)
-> (IPv6 -> Text) -> IPv6 -> Maybe IPv6Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (IPv6 -> String) -> IPv6 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> String
forall a. Show a => a -> String
show) (Maybe IPv6 -> Maybe IPv6Addr)
-> IO (Maybe IPv6) -> IO (Maybe IPv6Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (String -> [(String, IPv6)] -> Maybe IPv6
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s ([(String, IPv6)] -> Maybe IPv6)
-> IO [(String, IPv6)] -> IO (Maybe IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, IPv6)]
networkInterfacesIPv6AddrList)

-- | Returns a random 'IPv6Addr'.
randIPv6Addr :: IO IPv6Addr
randIPv6Addr :: IO IPv6Addr
randIPv6Addr = Maybe IPv6Addr -> IPv6Addr
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IPv6Addr -> IPv6Addr) -> IO (Maybe IPv6Addr) -> IO IPv6Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> IO (Maybe IPv6Addr)
randIPv6AddrWithPrefix Maybe Text
forall a. Maybe a
Nothing

-- | Returns a random 'IPv6Addr', optionally with the given prefix.
--
-- > randIPv6AddrWithPrefix (Just "4321:0:1:2:3:4")
--
randIPv6AddrWithPrefix :: Maybe T.Text -> IO (Maybe IPv6Addr)
randIPv6AddrWithPrefix :: Maybe Text -> IO (Maybe IPv6Addr)
randIPv6AddrWithPrefix Maybe Text
Nothing = do
  Int
r   <- (Int, Int) -> IO Int
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' <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
1,Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r)
        case Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r' of
          Int
7 -> [[IPv6AddrToken]] -> [IPv6AddrToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IPv6AddrToken]] -> [IPv6AddrToken])
-> IO [[IPv6AddrToken]] -> IO [IPv6AddrToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            [IO [IPv6AddrToken]] -> IO [[IPv6AddrToken]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r
                     , [IPv6AddrToken] -> IO [IPv6AddrToken]
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
_ -> [[IPv6AddrToken]] -> [IPv6AddrToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IPv6AddrToken]] -> [IPv6AddrToken])
-> IO [[IPv6AddrToken]] -> IO [IPv6AddrToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            [IO [IPv6AddrToken]] -> IO [[IPv6AddrToken]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r
                     , [IPv6AddrToken] -> IO [IPv6AddrToken]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [IPv6AddrToken
DoubleColon]
                     , Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
r'
                     ]
  Maybe IPv6Addr -> IO (Maybe IPv6Addr)
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
  Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe [IPv6AddrToken] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [IPv6AddrToken]
mtks)
  let tks :: [IPv6AddrToken]
tks = Maybe [IPv6AddrToken] -> [IPv6AddrToken]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [IPv6AddrToken]
mtks
  Int
ntks <- do
    let ctks :: (Int, Int)
ctks = [IPv6AddrToken] -> (Int, Int)
countChunks [IPv6AddrToken]
tks
    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$
      case ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
ctks :: Int) of
        Int
0 -> Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
ctks
        Int
1 -> Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
ctks
        Int
_ -> Int
0
  Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
ntks Int -> Int -> Bool
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 [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken]
rtks
  Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([IPv6AddrToken] -> Bool
isIPv6Addr [IPv6AddrToken]
tks')
  Maybe IPv6Addr -> IO (Maybe IPv6Addr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IPv6Addr -> IO (Maybe IPv6Addr))
-> Maybe IPv6Addr -> IO (Maybe IPv6Addr)
forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr ([IPv6AddrToken] -> Maybe IPv6Addr)
-> [IPv6AddrToken] -> Maybe IPv6Addr
forall a b. (a -> b) -> a -> b
$
    ([IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon ([IPv6AddrToken] -> [IPv6AddrToken])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon) [IPv6AddrToken]
tks'
  where
    countChunks :: [IPv6AddrToken] -> (Int, Int)
countChunks =
      (IPv6AddrToken -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> [IPv6AddrToken] -> (Int, Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IPv6AddrToken -> (Int, Int) -> (Int, Int)
forall a a. (Num a, Num a) => IPv6AddrToken -> (a, a) -> (a, a)
go (Int
0,Int
0)
      where
        go :: IPv6AddrToken -> (a, a) -> (a, a)
go IPv6AddrToken
c (a
a,a
b) =
          case IPv6AddrToken
c of
            SixteenBit Text
_ -> (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
1,a
b)
            IPv6AddrToken
AllZeros     -> (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
1,a
b)
            IPv6AddrToken
DoubleColon  -> (a
a,a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
1)
            IPv6AddrToken
_            -> (a
a,a
b)
    addColon :: [IPv6AddrToken] -> [IPv6AddrToken]
addColon [IPv6AddrToken]
ts =
      case [IPv6AddrToken] -> IPv6AddrToken
forall a. [a] -> a
last [IPv6AddrToken]
ts of
        SixteenBit Text
_ -> [IPv6AddrToken]
ts [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
Colon]
        IPv6AddrToken
AllZeros     -> [IPv6AddrToken]
ts [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
Colon]
        IPv6AddrToken
_            -> [IPv6AddrToken]
ts


-- ------------------------------------------------------------------------ --
-- Manipulations                                                             --
-- ------------------------------------------------------------------------ --

-- | Returns 'Just' a random 'SixteenBit' token based on a mask \"____\", each
-- underscore being replaced by a random hexadecimal digit.
--
-- > randIPv6AddrChunk "_f__" == Just (SixteenBit "bfd4")
--
randIPv6AddrChunk :: String -> IO IPv6AddrToken
randIPv6AddrChunk :: String -> IO IPv6AddrToken
randIPv6AddrChunk String
m =
  (Char -> IO Char) -> String -> IO String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> IO Char
getHex String
m IO String -> (String -> IO IPv6AddrToken) -> IO IPv6AddrToken
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
g -> IPv6AddrToken -> IO IPv6AddrToken
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IPv6AddrToken
SixteenBit (Text -> IPv6AddrToken) -> Text -> IPv6AddrToken
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
g)
  where
    getHex :: Char -> IO Char
getHex Char
c
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'  = IO Char
getDigit
      | Bool
otherwise = Char -> IO Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c

-- | Generates a random partial 'IPv6Addr' with n 'SixteenBit'.
randPartialIPv6Addr :: Int -> IO [IPv6AddrToken]
randPartialIPv6Addr :: Int -> IO [IPv6AddrToken]
randPartialIPv6Addr Int
n =
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9
    then
      IPv6AddrToken -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon ([IPv6AddrToken] -> [IPv6AddrToken])
-> IO [IPv6AddrToken] -> IO [IPv6AddrToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Int -> IO IPv6AddrToken -> IO [IPv6AddrToken]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Text -> IPv6AddrToken
SixteenBit (Text -> IPv6AddrToken)
-> (String -> Text) -> String -> IPv6AddrToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> IPv6AddrToken) -> IO String -> IO IPv6AddrToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Char -> IO String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 IO Char
getDigit)
    else [IPv6AddrToken] -> IO [IPv6AddrToken]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Given a MAC address, returns 'Just' the corresponding 'IPv6AddrToken' list, or 'Nothing'.
--
-- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == Just [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"]
--
macAddrToIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]
macAddrToIPv6AddrTokens :: Text -> Maybe [IPv6AddrToken]
macAddrToIPv6AddrTokens Text
t =
  case Parser (Maybe [IPv6AddrToken])
-> Text -> Result (Maybe [IPv6AddrToken])
forall a. Parser a -> Text -> Result a
parse Parser (Maybe [IPv6AddrToken])
macAddr Text
t of
    Done Text
"" Maybe [IPv6AddrToken]
b -> IPv6AddrToken -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon ([IPv6AddrToken] -> [IPv6AddrToken])
-> Maybe [IPv6AddrToken] -> Maybe [IPv6AddrToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [IPv6AddrToken]
b
    Result (Maybe [IPv6AddrToken])
_         -> Maybe [IPv6AddrToken]
forall a. Maybe a
Nothing

--
-- Functions based upon Network.Info to get local MAC and IPv6 addresses.
--
-- | Given a valid name of a local network interface, returns 'Just' the list of
-- tokens of the interface's IPv6 address, or 'Nothing'.
--
-- > getTokIPv6AddrOf "eth0" == Just [SixteenBit "fe80",DoubleColon,SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"]
--
getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokIPv6AddrOf String
s =
  Maybe [IPv6AddrToken]
-> (IPv6 -> Maybe [IPv6AddrToken])
-> Maybe IPv6
-> Maybe [IPv6AddrToken]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe [IPv6AddrToken]
forall a. Maybe a
Nothing (Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr(Text -> Maybe [IPv6AddrToken])
-> (IPv6 -> Text) -> IPv6 -> Maybe [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (IPv6 -> String) -> IPv6 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> String
forall a. Show a => a -> String
show) (Maybe IPv6 -> Maybe [IPv6AddrToken])
-> IO (Maybe IPv6) -> IO (Maybe [IPv6AddrToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (String -> [(String, IPv6)] -> Maybe IPv6
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s ([(String, IPv6)] -> Maybe IPv6)
-> IO [(String, IPv6)] -> IO (Maybe IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, IPv6)]
networkInterfacesIPv6AddrList)

-- | Given a valid name of a local network interface,
-- returns 'Just' the corresponding list of 'IPv6AddrToken' of the interface's MAC Address,
-- or 'Nothing'.
--
-- > getTokMacAddrOf "eth0" == Just [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"]
--
getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken])
getTokMacAddrOf String
s =
  Maybe [IPv6AddrToken]
-> (MAC -> Maybe [IPv6AddrToken])
-> Maybe MAC
-> Maybe [IPv6AddrToken]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe [IPv6AddrToken]
forall a. Maybe a
Nothing (Text -> Maybe [IPv6AddrToken]
macAddrToIPv6AddrTokens (Text -> Maybe [IPv6AddrToken])
-> (MAC -> Text) -> MAC -> Maybe [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (MAC -> String) -> MAC -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> String
forall a. Show a => a -> String
show) (Maybe MAC -> Maybe [IPv6AddrToken])
-> IO (Maybe MAC) -> IO (Maybe [IPv6AddrToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (String -> [(String, MAC)] -> Maybe MAC
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s ([(String, MAC)] -> Maybe MAC)
-> IO [(String, MAC)] -> IO (Maybe MAC)
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 IO [NetworkInterface]
-> ([NetworkInterface] -> IO [(String, MAC)]) -> IO [(String, MAC)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \[NetworkInterface]
n -> [(String, MAC)] -> IO [(String, MAC)]
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkInterface -> (String, MAC)
networkInterfacesMac (NetworkInterface -> (String, MAC))
-> [NetworkInterface] -> [(String, MAC)]
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 (Int -> Char) -> IO Int -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0,Int
15)

-- ------------------------------------------------------------------------- --
-- Internals                                                                 --
-- ------------------------------------------------------------------------- --

-- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'.
ipv6TokensToText :: [IPv6AddrToken] -> T.Text
ipv6TokensToText :: [IPv6AddrToken] -> Text
ipv6TokensToText [IPv6AddrToken]
l = [Text] -> Text
T.concat (IPv6AddrToken -> Text
ipv6TokenToText (IPv6AddrToken -> Text) -> [IPv6AddrToken] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IPv6AddrToken]
l)

-- | Returns the corresponding 'T.Text' of an IPv6 address token.
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"  -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)
ipv6TokenToText (IPv4Addr Text
a)   = Text
a

-- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address.
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 = [IPv6AddrToken] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPv6AddrToken]
tks
        lasttk :: IPv6AddrToken
lasttk = [IPv6AddrToken] -> IPv6AddrToken
forall a. [a] -> a
last [IPv6AddrToken]
tks
        lenconst :: Bool
lenconst = (Int
lentks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
15 Bool -> Bool -> Bool
&& Int
cdctks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| (Int
lentks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
15 Bool -> Bool -> Bool
&& Int
cdctks Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
13 Bool -> Bool -> Bool
&& Int
cdctks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| (Int
lentks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12 Bool -> Bool -> Bool
&& Int
cdctks Int -> Int -> Bool
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 = [IPv6AddrToken] -> IPv6AddrToken
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 [IPv6AddrToken] -> IPv6AddrToken
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 = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (IPv6AddrToken -> [IPv6AddrToken] -> [Int]
forall a. Eq a => a -> [a] -> [Int]
elemIndices IPv6AddrToken
DoubleColon [IPv6AddrToken]
l)

countIPv4Addr :: [IPv6AddrToken] -> Int
countIPv4Addr :: [IPv6AddrToken] -> Int
countIPv4Addr =
  (IPv6AddrToken -> Int -> Int) -> Int -> [IPv6AddrToken] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IPv6AddrToken -> Int -> Int
forall p. Num p => IPv6AddrToken -> p -> p
oneMoreIPv4Addr Int
0
  where
    oneMoreIPv4Addr :: IPv6AddrToken -> p -> p
oneMoreIPv4Addr IPv6AddrToken
t p
c =
      case IPv6AddrToken
t of
        IPv4Addr Text
_ -> p
c p -> p -> p
forall a. Num a => a -> a -> a
+ p
1
        IPv6AddrToken
_          -> p
c

-- | This is the main function which returns 'Just' the list of a tokenized IPv6
-- address text representation validated against RFC 4291 and canonized
-- in conformation with RFC 5952, or 'Nothing'.
maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr :: Text -> Maybe [IPv6AddrToken]
maybeTokIPv6Addr Text
t = do
  [IPv6AddrToken]
ltks <- Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([IPv6AddrToken] -> Bool
isIPv6Addr [IPv6AddrToken]
ltks)
  [IPv6AddrToken] -> Maybe [IPv6AddrToken]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement ([IPv6AddrToken] -> [IPv6AddrToken])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon ([IPv6AddrToken] -> [IPv6AddrToken])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken] -> [IPv6AddrToken]
forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken]
ltks)
  where
    ipv4AddrReplacement :: [IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement [IPv6AddrToken]
ltks =
      if [IPv6AddrToken] -> Bool
ipv4AddrRewrite [IPv6AddrToken]
ltks
        then [IPv6AddrToken] -> [IPv6AddrToken]
forall a. [a] -> [a]
init [IPv6AddrToken]
ltks [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> IPv6AddrToken -> [IPv6AddrToken]
ipv4AddrToIPv6AddrTokens ([IPv6AddrToken] -> IPv6AddrToken
forall a. [a] -> a
last [IPv6AddrToken]
ltks)
        else [IPv6AddrToken]
ltks

-- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an
-- embedded IPv4 address if present.
maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr :: Text -> Maybe [IPv6AddrToken]
maybeTokPureIPv6Addr Text
t = do
  [IPv6AddrToken]
ltks <- Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([IPv6AddrToken] -> Bool
isIPv6Addr [IPv6AddrToken]
ltks)
  [IPv6AddrToken] -> Maybe [IPv6AddrToken]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon ([IPv6AddrToken] -> [IPv6AddrToken])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement ([IPv6AddrToken] -> [IPv6AddrToken])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [IPv6AddrToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IPv6AddrToken] -> [IPv6AddrToken]
fromDoubleColon ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken] -> [IPv6AddrToken]
forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken]
ltks)
  where
    ipv4AddrReplacement :: [IPv6AddrToken] -> [IPv6AddrToken]
ipv4AddrReplacement [IPv6AddrToken]
ltks' =
      [IPv6AddrToken] -> [IPv6AddrToken]
forall a. [a] -> [a]
init [IPv6AddrToken]
ltks' [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> IPv6AddrToken -> [IPv6AddrToken]
ipv4AddrToIPv6AddrTokens ([IPv6AddrToken] -> IPv6AddrToken
forall a. [a] -> a
last [IPv6AddrToken]
ltks')

-- | Tokenize a 'T.Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'.
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  -> [IPv6AddrToken] -> Maybe [IPv6AddrToken]
forall a. a -> Maybe a
Just [IPv6AddrToken]
l
    IResult Text [IPv6AddrToken]
_          -> Maybe [IPv6AddrToken]
forall a. Maybe a
Nothing
  where
    readText :: Text -> IResult Text [IPv6AddrToken]
readText Text
_s =
      IResult Text [IPv6AddrToken]
-> Text -> IResult Text [IPv6AddrToken]
forall i r. Monoid i => IResult i r -> i -> IResult i r
feed
        (Parser [IPv6AddrToken] -> Text -> IResult Text [IPv6AddrToken]
forall a. Parser a -> Text -> Result a
parse (Parser Text IPv6AddrToken -> Parser [IPv6AddrToken]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser Text IPv6AddrToken -> Parser [IPv6AddrToken])
-> Parser Text IPv6AddrToken -> Parser [IPv6AddrToken]
forall a b. (a -> b) -> a -> b
$ Parser Text IPv6AddrToken
ipv4Addr Parser Text IPv6AddrToken
-> Parser Text IPv6AddrToken -> Parser Text IPv6AddrToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text IPv6AddrToken
sixteenBit Parser Text IPv6AddrToken
-> Parser Text IPv6AddrToken -> Parser Text IPv6AddrToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text IPv6AddrToken
doubleColon Parser Text IPv6AddrToken
-> Parser Text IPv6AddrToken -> Parser Text IPv6AddrToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text IPv6AddrToken
colon) Text
_s)
        Text
T.empty

-- | An embedded IPv4 address have to be rewritten to output a pure IPv6 Address
-- text representation in hexadecimal digits. But some well-known prefixed IPv6
-- addresses have to keep visible in their text representation the fact that
-- they deals with IPv4 to IPv6 transition process (RFC 5952 Section 5):
--
-- IPv4-compatible IPv6 address like "::1.2.3.4"
--
-- IPv4-mapped IPv6 address like "::ffff:1.2.3.4"
--
-- IPv4-translated address like "::ffff:0:1.2.3.4"
--
-- IPv4-translatable address like "64:ff9b::1.2.3.4"
--
-- ISATAP address like "fe80::5efe:1.2.3.4"
--
ipv4AddrRewrite :: [IPv6AddrToken] -> Bool
ipv4AddrRewrite :: [IPv6AddrToken] -> Bool
ipv4AddrRewrite [IPv6AddrToken]
tks =
  case [IPv6AddrToken] -> IPv6AddrToken
forall a. [a] -> a
last [IPv6AddrToken]
tks of
    IPv4Addr Text
_ -> do
      let itks :: [IPv6AddrToken]
itks = [IPv6AddrToken] -> [IPv6AddrToken]
forall a. [a] -> [a]
init [IPv6AddrToken]
tks
      Bool -> Bool
not  ([IPv6AddrToken]
itks [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
forall a. Eq a => a -> a -> Bool
== [IPv6AddrToken
DoubleColon]
         Bool -> Bool -> Bool
|| [IPv6AddrToken]
itks [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
forall a. Eq a => a -> a -> Bool
== [IPv6AddrToken
DoubleColon,Text -> IPv6AddrToken
SixteenBit Text
tokffff,IPv6AddrToken
Colon]
         Bool -> Bool -> Bool
|| [IPv6AddrToken]
itks [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
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 [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
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] [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [IPv6AddrToken]
itks
         Bool -> Bool -> Bool
|| [IPv6AddrToken
AllZeros,IPv6AddrToken
Colon,Text -> IPv6AddrToken
SixteenBit Text
tok5efe,IPv6AddrToken
Colon] [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [IPv6AddrToken]
itks
         Bool -> Bool -> Bool
|| [IPv6AddrToken
DoubleColon,Text -> IPv6AddrToken
SixteenBit Text
tok5efe,IPv6AddrToken
Colon] [IPv6AddrToken] -> [IPv6AddrToken] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [IPv6AddrToken]
itks)
    IPv6AddrToken
_          -> Bool
False
  where
    tokffff :: Text
tokffff = Text
"ffff"
    tok5efe :: Text
tok5efe = Text
"5efe"

-- | Rewrites an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens.
--
-- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"]
--
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 ([Text] -> Int -> Text
forall a. [a] -> Int -> a
(!!) [Text]
m Int
0 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addZero ([Text] -> Int -> Text
forall a. [a] -> Int -> a
(!!) [Text]
m Int
1))
       , IPv6AddrToken
Colon
       , Text -> IPv6AddrToken
SixteenBit ([Text] -> Int -> Text
forall a. [a] -> Int -> a
(!!) [Text]
m Int
2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addZero ([Text] -> Int -> Text
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (String -> Int
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
x)::Int) String
"") (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
a
      addZero :: Text -> Text
addZero Text
d = if Text -> Int
T.length Text
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d else Text
d

expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]
expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]
expandTokens =
  (IPv6AddrToken -> IPv6AddrToken)
-> [IPv6AddrToken] -> [IPv6AddrToken]
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 IPv6AddrToken -> [IPv6AddrToken] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [IPv6AddrToken]
tks
    then [IPv6AddrToken]
tks
    else do
      let s :: ([IPv6AddrToken], [IPv6AddrToken])
s = Int -> [IPv6AddrToken] -> ([IPv6AddrToken], [IPv6AddrToken])
forall a. Int -> [a] -> ([a], [a])
splitAt (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ IPv6AddrToken -> [IPv6AddrToken] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex IPv6AddrToken
DoubleColon [IPv6AddrToken]
tks) [IPv6AddrToken]
tks
          fsts :: [IPv6AddrToken]
fsts = ([IPv6AddrToken], [IPv6AddrToken]) -> [IPv6AddrToken]
forall a b. (a, b) -> a
fst ([IPv6AddrToken], [IPv6AddrToken])
s
          snds :: [IPv6AddrToken]
snds = if Bool -> Bool
not ([IPv6AddrToken] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([IPv6AddrToken], [IPv6AddrToken]) -> [IPv6AddrToken]
forall a b. (a, b) -> b
snd ([IPv6AddrToken], [IPv6AddrToken])
s)) then [IPv6AddrToken] -> [IPv6AddrToken]
forall a. [a] -> [a]
tail(([IPv6AddrToken], [IPv6AddrToken]) -> [IPv6AddrToken]
forall a b. (a, b) -> b
snd ([IPv6AddrToken], [IPv6AddrToken])
s) else []
          fste :: [IPv6AddrToken]
fste = if [IPv6AddrToken] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IPv6AddrToken]
fsts then [] else [IPv6AddrToken]
fsts [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
Colon]
          snde :: [IPv6AddrToken]
snde = if [IPv6AddrToken] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IPv6AddrToken]
snds then [] else IPv6AddrToken
Colon IPv6AddrToken -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. a -> [a] -> [a]
: [IPv6AddrToken]
snds
      [IPv6AddrToken]
fste [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> Int -> [IPv6AddrToken]
allZerosTokensReplacement([IPv6AddrToken] -> Int
forall a (t :: * -> *). (Num a, Foldable t) => t IPv6AddrToken -> a
quantityOfAllZerosTokenToReplace [IPv6AddrToken]
tks) [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken]
snde
      where
        allZerosTokensReplacement :: Int -> [IPv6AddrToken]
allZerosTokensReplacement Int
x = IPv6AddrToken -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon (Int -> IPv6AddrToken -> [IPv6AddrToken]
forall a. Int -> a -> [a]
replicate Int
x IPv6AddrToken
AllZeros)
        quantityOfAllZerosTokenToReplace :: t IPv6AddrToken -> a
quantityOfAllZerosTokenToReplace t IPv6AddrToken
_x =
          [IPv6AddrToken] -> a
forall p. Num p => [IPv6AddrToken] -> p
ntks [IPv6AddrToken]
tks a -> a -> a
forall a. Num a => a -> a -> a
- (a -> IPv6AddrToken -> a) -> a -> t IPv6AddrToken -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
c IPv6AddrToken
_x -> if (IPv6AddrToken
_x IPv6AddrToken -> IPv6AddrToken -> Bool
forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
DoubleColon) Bool -> Bool -> Bool
&& (IPv6AddrToken
_x IPv6AddrToken -> IPv6AddrToken -> Bool
forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
Colon) then a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1 else a
c) a
0 t IPv6AddrToken
_x
          where
            ntks :: [IPv6AddrToken] -> p
ntks [IPv6AddrToken]
_tks = if [IPv6AddrToken] -> Int
countIPv4Addr [IPv6AddrToken]
_tks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then p
7 else p
8

toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
toDoubleColon [IPv6AddrToken]
tks =
  [IPv6AddrToken] -> (Int, Int) -> [IPv6AddrToken]
zerosToDoubleColon [IPv6AddrToken]
tks ([(Bool, Int)] -> (Int, Int)
forall b. (Ord b, Num b) => [(Bool, b)] -> (b, b)
zerosRunToReplace ([(Bool, Int)] -> (Int, Int)) -> [(Bool, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken] -> [(Bool, Int)]
zerosRunsList [IPv6AddrToken]
tks)
  where
    -- No all zeros token, so no double colon replacement...
    zerosToDoubleColon :: [IPv6AddrToken] -> (Int, Int) -> [IPv6AddrToken]
zerosToDoubleColon [IPv6AddrToken]
ls (Int
_,Int
0) = [IPv6AddrToken]
ls
    -- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 5952 4.2.2)
    zerosToDoubleColon [IPv6AddrToken]
ls (Int
_,Int
1) = [IPv6AddrToken]
ls
    zerosToDoubleColon [IPv6AddrToken]
ls (Int
i,Int
l) =
      let ls' :: [IPv6AddrToken]
ls' = (IPv6AddrToken -> Bool) -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. (a -> Bool) -> [a] -> [a]
filter (IPv6AddrToken -> IPv6AddrToken -> Bool
forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
Colon) [IPv6AddrToken]
ls
      in IPv6AddrToken -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon (Int -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Int -> [a] -> [a]
Prelude.take Int
i [IPv6AddrToken]
ls') [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> [IPv6AddrToken
DoubleColon] [IPv6AddrToken] -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Semigroup a => a -> a -> a
<> IPv6AddrToken -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. a -> [a] -> [a]
intersperse IPv6AddrToken
Colon (Int -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) [IPv6AddrToken]
ls')
    zerosRunToReplace :: [(Bool, b)] -> (b, b)
zerosRunToReplace [(Bool, b)]
t =
      let l :: b
l = [(Bool, b)] -> b
forall (t :: * -> *) a.
(Foldable t, Ord a, Functor t, Num a) =>
t (Bool, a) -> a
longestLengthZerosRun [(Bool, b)]
t
      in ([(Bool, b)] -> b -> b
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 = [c] -> c
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([c] -> c) -> ([(Bool, c)] -> [c]) -> [(Bool, c)] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, c) -> c) -> [(Bool, c)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, c) -> c
forall a b. (a, b) -> b
snd ([(Bool, c)] -> c) -> [(Bool, c)] -> c
forall a b. (a -> b) -> a -> b
$ ((Bool, c) -> Bool) -> [(Bool, c)] -> [(Bool, c)]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.takeWhile ((Bool, c) -> (Bool, c) -> Bool
forall a. Eq a => a -> a -> Bool
/=(Bool
True,c
y)) [(Bool, c)]
x
        longestLengthZerosRun :: t (Bool, a) -> a
longestLengthZerosRun t (Bool, a)
x =
          t a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Bool, a) -> a
forall p. Num p => (Bool, p) -> p
longest ((Bool, a) -> a) -> t (Bool, a) -> t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (Bool, a)
x)
          where
            longest :: (Bool, p) -> p
longest (Bool, p)
_t =
              case (Bool, p)
_t of
                (Bool
True,p
i) -> p
i
                (Bool, p)
_        -> p
0
    zerosRunsList :: [IPv6AddrToken] -> [(Bool, Int)]
zerosRunsList [IPv6AddrToken]
x =
      [IPv6AddrToken] -> (Bool, Int)
helper ([IPv6AddrToken] -> (Bool, Int))
-> [[IPv6AddrToken]] -> [(Bool, Int)]
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 = ([IPv6AddrToken] -> IPv6AddrToken
forall a. [a] -> a
head [IPv6AddrToken]
h IPv6AddrToken -> IPv6AddrToken -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6AddrToken
AllZeros, Int
lh) where lh :: Int
lh = [IPv6AddrToken] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IPv6AddrToken]
h
        groupZerosRuns :: [IPv6AddrToken] -> [[IPv6AddrToken]]
groupZerosRuns = [IPv6AddrToken] -> [[IPv6AddrToken]]
forall a. Eq a => [a] -> [[a]]
group ([IPv6AddrToken] -> [[IPv6AddrToken]])
-> ([IPv6AddrToken] -> [IPv6AddrToken])
-> [IPv6AddrToken]
-> [[IPv6AddrToken]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IPv6AddrToken -> Bool) -> [IPv6AddrToken] -> [IPv6AddrToken]
forall a. (a -> Bool) -> [a] -> [a]
filter (IPv6AddrToken -> IPv6AddrToken -> Bool
forall a. Eq a => a -> a -> Bool
/= IPv6AddrToken
Colon)

ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr
ipv6TokensToIPv6Addr [IPv6AddrToken]
l = IPv6Addr -> Maybe IPv6Addr
forall a. a -> Maybe a
Just (Text -> IPv6Addr
IPv6Addr (Text -> IPv6Addr) -> Text -> IPv6Addr
forall a b. (a -> b) -> a -> b
$ [IPv6AddrToken] -> Text
ipv6TokensToText [IPv6AddrToken]
l)

networkInterfacesIPv6AddrList :: IO [(String,Network.Info.IPv6)]
networkInterfacesIPv6AddrList :: IO [(String, IPv6)]
networkInterfacesIPv6AddrList =
  (NetworkInterface -> (String, IPv6))
-> [NetworkInterface] -> [(String, IPv6)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkInterface -> (String, IPv6)
networkInterfacesIPv6Addr ([NetworkInterface] -> [(String, IPv6)])
-> IO [NetworkInterface] -> IO [(String, IPv6)]
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 <- Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar Parser Text String -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
  String
n2 <- Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar Parser Text String -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
  String
n3 <- Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar Parser Text String -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
  String
n4 <- Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar Parser Text String -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
  String
n5 <- Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar Parser Text String -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
":"
  String
n6 <- Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar
  Maybe [IPv6AddrToken] -> Parser (Maybe [IPv6AddrToken])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [IPv6AddrToken] -> Parser (Maybe [IPv6AddrToken]))
-> Maybe [IPv6AddrToken] -> Parser (Maybe [IPv6AddrToken])
forall a b. (a -> b) -> a -> b
$ Text -> Maybe [IPv6AddrToken]
maybeIPv6AddrTokens (Text -> Maybe [IPv6AddrToken]) -> Text -> Maybe [IPv6AddrToken]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
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 Parser Text String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 Parser Text Char
hexaChar Parser Text String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Text Char
hexaChar Parser Text String -> Parser Text String -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
1 Parser Text Char
hexaChar
  -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1)
  let r' :: Text
r' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'0') (String -> Text
T.pack String
r)
  IPv6AddrToken -> Parser Text IPv6AddrToken
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6AddrToken -> Parser Text IPv6AddrToken)
-> IPv6AddrToken -> Parser Text IPv6AddrToken
forall a b. (a -> b) -> a -> b
$
    if Text -> Bool
T.null Text
r'
      then IPv6AddrToken
AllZeros
      -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)
      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 Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"."
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
  Text
n2 <- Parser Text Text
manyDigits Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"."
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
  Text
n3 <- Parser Text Text
manyDigits Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"."
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n3 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
  Text
n4 <- Parser Text Text
manyDigits
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n4 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
T.empty)
  IPv6AddrToken -> Parser Text IPv6AddrToken
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IPv6AddrToken
IPv4Addr (Text -> IPv6AddrToken) -> Text -> IPv6AddrToken
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 Parser Text Text -> (Text -> Parser Text Text) -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
ds ->
      Text -> Parser Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text Text) -> Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$
        case Reader Integer
forall a. Integral a => Reader a
R.decimal Text
ds :: Either String (Integer, T.Text) of
          Right (Integer
n,Text
_) ->
            if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256
              then String -> Text
T.pack (Integer -> String
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
"::"
  IPv6AddrToken -> Parser Text IPv6AddrToken
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
":"
  IPv6AddrToken -> Parser Text IPv6AddrToken
forall (m :: * -> *) a. Monad m => a -> m a
return IPv6AddrToken
Colon

ipv6AddrFullChunk :: Parser String
ipv6AddrFullChunk :: Parser Text String
ipv6AddrFullChunk = Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 Parser Text Char
hexaChar

hexaChar :: Parser Char
hexaChar :: Parser Text Char
hexaChar = (Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
inClass String
"0-9a-fA-F")