module Net.IP
(
case_
, ipv4
, ipv6
, fromIPv4
, fromIPv6
, encode
, decode
, IP(..)
) where
import Data.Bits
import Net.IPv6 (IPv6(..))
import Net.IPv4 (IPv4(..))
import Text.Read (Read(..),Lexeme(Ident),lexP,parens)
import Text.ParserCombinators.ReadPrec (prec,step,(+++))
import Data.Aeson (FromJSON(..),ToJSON(..))
import Data.Text (Text)
import qualified Net.IPv4 as IPv4
import qualified Net.IPv6 as IPv6
import qualified Data.Aeson as Aeson
case_ :: (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ f g (IP addr@(IPv6 w1 w2)) = if w1 == 0 && (0xFFFFFFFF00000000 .&. w2 == 0x0000FFFF00000000)
then f (IPv4 (fromIntegral w2))
else g addr
ipv4 :: IP -> Maybe IPv4
ipv4 = case_ Just (const Nothing)
ipv6 :: IP -> Maybe IPv6
ipv6 = case_ (const Nothing) Just
fromIPv4 :: IPv4 -> IP
fromIPv4 (IPv4 w) = IP (IPv6 0 (0x0000FFFF00000000 .|. fromIntegral w))
fromIPv6 :: IPv6 -> IP
fromIPv6 = IP
encode :: IP -> Text
encode = case_ IPv4.encode IPv6.encode
decode :: Text -> Maybe IP
decode t = case IPv4.decode t of
Nothing -> case IPv6.decode t of
Nothing -> Nothing
Just v6 -> Just (fromIPv6 v6)
Just v4 -> Just (fromIPv4 v4)
newtype IP = IP { getIP :: IPv6 }
deriving (Eq,Ord)
instance Show IP where
showsPrec p = case_
(\x -> showParen (p > 10) $ showString "fromIPv4 " . showsPrec 11 x)
(\x -> showParen (p > 10) $ showString "fromIPv6 " . showsPrec 11 x)
instance Read IP where
readPrec = parens $
( prec 10 $ do
Ident "fromIPv4 " <- lexP
fmap fromIPv4 (step readPrec)
) +++
( prec 10 $ do
Ident "fromIPv6 " <- lexP
fmap fromIPv6 (step readPrec)
)
instance ToJSON IP where
toJSON = Aeson.String . encode
instance FromJSON IP where
parseJSON = Aeson.withText "IP" $ \t -> case decode t of
Nothing -> fail "Could not parse IP address"
Just addr -> return addr