{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Aeson.IP () where
import Data.Aeson
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Aeson.Types
import Data.IP
import Data.IP.RouteTable (Routable, IPRTable)
import qualified Data.IP.RouteTable as RouteTable
import qualified Data.Text as Text
import Text.Read (readMaybe)
instance FromJSON IPv4 where
parseJSON :: Value -> Parser IPv4
parseJSON (String Text
s)
| Just IPv4
r <- String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
s) = IPv4 -> Parser IPv4
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPv4
r
| Bool
otherwise = String -> Parser IPv4
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse"
parseJSON Value
v = String -> Value -> Parser IPv4
forall a. String -> Value -> Parser a
typeMismatch String
"IPv4" Value
v
instance FromJSONKey IPv4 where
fromJSONKey :: FromJSONKeyFunction IPv4
fromJSONKey = (Text -> Parser IPv4) -> FromJSONKeyFunction IPv4
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser IPv4) -> FromJSONKeyFunction IPv4)
-> (Text -> Parser IPv4) -> FromJSONKeyFunction IPv4
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
t) of
Just IPv4
r -> IPv4 -> Parser IPv4
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPv4
r
Maybe IPv4
Nothing -> String -> Parser IPv4
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse IPv4"
instance ToJSON IPv4 where
toJSON :: IPv4 -> Value
toJSON = Text -> Value
String (Text -> Value) -> (IPv4 -> Text) -> IPv4 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (IPv4 -> String) -> IPv4 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> String
forall a. Show a => a -> String
show
instance ToJSONKey IPv4 where
toJSONKey :: ToJSONKeyFunction IPv4
toJSONKey = (IPv4 -> Text) -> ToJSONKeyFunction IPv4
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
Text.pack (String -> Text) -> (IPv4 -> String) -> IPv4 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> String
forall a. Show a => a -> String
show)
instance FromJSON IPv6 where
parseJSON :: Value -> Parser IPv6
parseJSON (String Text
s)
| Just IPv6
r <- String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
s) = IPv6 -> Parser IPv6
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPv6
r
| Bool
otherwise = String -> Parser IPv6
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse"
parseJSON Value
v = String -> Value -> Parser IPv6
forall a. String -> Value -> Parser a
typeMismatch String
"IPv6" Value
v
instance FromJSONKey IPv6 where
fromJSONKey :: FromJSONKeyFunction IPv6
fromJSONKey = (Text -> Parser IPv6) -> FromJSONKeyFunction IPv6
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser IPv6) -> FromJSONKeyFunction IPv6)
-> (Text -> Parser IPv6) -> FromJSONKeyFunction IPv6
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
t) of
Just IPv6
r -> IPv6 -> Parser IPv6
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPv6
r
Maybe IPv6
Nothing -> String -> Parser IPv6
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse IPv6"
instance ToJSON IPv6 where
toJSON :: IPv6 -> Value
toJSON = Text -> Value
String (Text -> Value) -> (IPv6 -> Text) -> IPv6 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.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
instance ToJSONKey IPv6 where
toJSONKey :: ToJSONKeyFunction IPv6
toJSONKey = (IPv6 -> Text) -> ToJSONKeyFunction IPv6
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
Text.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)
instance FromJSON IP where
parseJSON :: Value -> Parser IP
parseJSON (String Text
s)
| Just IP
r <- String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
s) = IP -> Parser IP
forall (f :: * -> *) a. Applicative f => a -> f a
pure IP
r
| Bool
otherwise = String -> Parser IP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse"
parseJSON Value
v = String -> Value -> Parser IP
forall a. String -> Value -> Parser a
typeMismatch String
"IP" Value
v
instance FromJSONKey IP where
fromJSONKey :: FromJSONKeyFunction IP
fromJSONKey = (Text -> Parser IP) -> FromJSONKeyFunction IP
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser IP) -> FromJSONKeyFunction IP)
-> (Text -> Parser IP) -> FromJSONKeyFunction IP
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
t) of
Just IP
r -> IP -> Parser IP
forall (f :: * -> *) a. Applicative f => a -> f a
pure IP
r
Maybe IP
Nothing -> String -> Parser IP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse IP"
instance ToJSON IP where
toJSON :: IP -> Value
toJSON = Text -> Value
String (Text -> Value) -> (IP -> Text) -> IP -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (IP -> String) -> IP -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> String
forall a. Show a => a -> String
show
instance ToJSONKey IP where
toJSONKey :: ToJSONKeyFunction IP
toJSONKey = (IP -> Text) -> ToJSONKeyFunction IP
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
Text.pack (String -> Text) -> (IP -> String) -> IP -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> String
forall a. Show a => a -> String
show)
instance Read (AddrRange a) => FromJSON (AddrRange a) where
parseJSON :: Value -> Parser (AddrRange a)
parseJSON (String Text
s)
| Just AddrRange a
r <- String -> Maybe (AddrRange a)
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
s) = AddrRange a -> Parser (AddrRange a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrRange a
r
| Bool
otherwise = String -> Parser (AddrRange a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse"
parseJSON Value
v = String -> Value -> Parser (AddrRange a)
forall a. String -> Value -> Parser a
typeMismatch String
"AddrRange" Value
v
instance Show a => ToJSON (AddrRange a) where
toJSON :: AddrRange a -> Value
toJSON = Text -> Value
String (Text -> Value) -> (AddrRange a -> Text) -> AddrRange a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (AddrRange a -> String) -> AddrRange a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrRange a -> String
forall a. Show a => a -> String
show
instance FromJSON IPRange where
parseJSON :: Value -> Parser IPRange
parseJSON (String Text
s)
| Just IPRange
r <- String -> Maybe IPRange
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
s) = IPRange -> Parser IPRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPRange
r
| Bool
otherwise = String -> Parser IPRange
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse"
parseJSON Value
v = String -> Value -> Parser IPRange
forall a. String -> Value -> Parser a
typeMismatch String
"IPRange" Value
v
instance ToJSON IPRange where
toJSON :: IPRange -> Value
toJSON = Text -> Value
String (Text -> Value) -> (IPRange -> Text) -> IPRange -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (IPRange -> String) -> IPRange -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPRange -> String
forall a. Show a => a -> String
show
instance Read (AddrRange a) => FromJSONKey (AddrRange a) where
fromJSONKey :: FromJSONKeyFunction (AddrRange a)
fromJSONKey = (Text -> Parser (AddrRange a)) -> FromJSONKeyFunction (AddrRange a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser (AddrRange a))
-> FromJSONKeyFunction (AddrRange a))
-> (Text -> Parser (AddrRange a))
-> FromJSONKeyFunction (AddrRange a)
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe (AddrRange a)
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
t) of
Just AddrRange a
r -> AddrRange a -> Parser (AddrRange a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrRange a
r
Maybe (AddrRange a)
Nothing -> String -> Parser (AddrRange a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse AddrRange"
instance Show a => ToJSONKey (AddrRange a) where
toJSONKey :: ToJSONKeyFunction (AddrRange a)
toJSONKey = (AddrRange a -> Text) -> ToJSONKeyFunction (AddrRange a)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
Text.pack (String -> Text) -> (AddrRange a -> String) -> AddrRange a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrRange a -> String
forall a. Show a => a -> String
show)
instance FromJSONKey IPRange where
fromJSONKey :: FromJSONKeyFunction IPRange
fromJSONKey = (Text -> Parser IPRange) -> FromJSONKeyFunction IPRange
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser IPRange) -> FromJSONKeyFunction IPRange)
-> (Text -> Parser IPRange) -> FromJSONKeyFunction IPRange
forall a b. (a -> b) -> a -> b
$ \Text
t ->
case String -> Maybe IPRange
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
t) of
Just IPRange
r -> IPRange -> Parser IPRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPRange
r
Maybe IPRange
Nothing -> String -> Parser IPRange
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse IPRange"
instance ToJSONKey IPRange where
toJSONKey :: ToJSONKeyFunction IPRange
toJSONKey = (IPRange -> Text) -> ToJSONKeyFunction IPRange
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
Text.pack (String -> Text) -> (IPRange -> String) -> IPRange -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPRange -> String
forall a. Show a => a -> String
show)
instance ( FromJSONKey k
, Read (AddrRange k)
, Routable k
) => FromJSON1 (IPRTable k) where
liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (IPRTable k a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
_ = case FromJSONKeyFunction (AddrRange k)
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey of
FromJSONKeyTextParser Text -> Parser (AddrRange k)
f -> String
-> (Object -> Parser (IPRTable k a))
-> Value
-> Parser (IPRTable k a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IPRTable k v" ((Object -> Parser (IPRTable k a))
-> Value -> Parser (IPRTable k a))
-> (Object -> Parser (IPRTable k a))
-> Value
-> Parser (IPRTable k a)
forall a b. (a -> b) -> a -> b
$
(Key -> Value -> Parser (IPRTable k a) -> Parser (IPRTable k a))
-> Parser (IPRTable k a) -> Object -> Parser (IPRTable k a)
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
KeyMap.foldrWithKey
(\Key
k Value
v Parser (IPRTable k a)
rt -> AddrRange k -> a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
RouteTable.insert (AddrRange k -> a -> IPRTable k a -> IPRTable k a)
-> Parser (AddrRange k)
-> Parser (a -> IPRTable k a -> IPRTable k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (AddrRange k)
f (Key -> Text
Key.toText Key
k) Parser (AddrRange k) -> JSONPathElement -> Parser (AddrRange k)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
k
Parser (a -> IPRTable k a -> IPRTable k a)
-> Parser a -> Parser (IPRTable k a -> IPRTable k a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
k
Parser (IPRTable k a -> IPRTable k a)
-> Parser (IPRTable k a) -> Parser (IPRTable k a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IPRTable k a)
rt)
(IPRTable k a -> Parser (IPRTable k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPRTable k a
forall k a. Routable k => IPRTable k a
RouteTable.empty)
FromJSONKeyFunction (AddrRange k)
_ -> \Value
_ -> String -> Parser (IPRTable k a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"using IPRTable in this context is not yet supported"
instance ( FromJSONKey k
, Read (AddrRange k)
, Routable k
, FromJSON v
) => FromJSON (IPRTable k v) where
parseJSON :: Value -> Parser (IPRTable k v)
parseJSON = Value -> Parser (IPRTable k v)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1
instance (Routable k, Show k, ToJSON k) => ToJSON1 (IPRTable k) where
liftToJSON :: (a -> Value) -> ([a] -> Value) -> IPRTable k a -> Value
liftToJSON a -> Value
g [a] -> Value
_ = case ToJSONKeyFunction (AddrRange k)
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey of
ToJSONKeyText AddrRange k -> Key
f AddrRange k -> Encoding' Key
_ -> Object -> Value
Object (Object -> Value)
-> (IPRTable k a -> Object) -> IPRTable k a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
([(Key, Value)] -> Object)
-> (IPRTable k a -> [(Key, Value)]) -> IPRTable k a -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AddrRange k, a) -> (Key, Value))
-> [(AddrRange k, a)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\(AddrRange k
k, a
v) -> (AddrRange k -> Key
f AddrRange k
k, a -> Value
g a
v))
([(AddrRange k, a)] -> [(Key, Value)])
-> (IPRTable k a -> [(AddrRange k, a)])
-> IPRTable k a
-> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPRTable k a -> [(AddrRange k, a)]
forall k a. Routable k => IPRTable k a -> [(AddrRange k, a)]
RouteTable.toList
ToJSONKeyFunction (AddrRange k)
_ -> String -> IPRTable k a -> Value
forall a. HasCallStack => String -> a
error String
"using IPRTable as a JSON key is not yet supported"
instance (Routable k, Show k, ToJSON k, ToJSON v) => ToJSON (IPRTable k v) where
toJSON :: IPRTable k v -> Value
toJSON = IPRTable k v -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1