module Network.IPFS.Info.Types (Info (..)) where

import Network.IPFS.Prelude
import Network.IPFS.Peer.Types

data Info = Info
  { Info -> Text
id              :: Text
  , Info -> Text
publicKey       :: Text
  , Info -> [Peer]
addresses       :: [Peer]
  , Info -> Text
agentVersion    :: Text
  , Info -> Text
protocolVersion :: Text
  } deriving (Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show, Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c== :: Info -> Info -> Bool
Eq)

instance FromJSON Info where
  parseJSON :: Value -> Parser Info
parseJSON = String -> (Object -> Parser Info) -> Value -> Parser Info
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IPFS.Info" \Object
obj -> do
    Text
id              <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ID"
    Text
publicKey       <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"PublicKey"
    [Peer]
addresses       <- Object
obj Object -> Text -> Parser [Peer]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Addresses"
    Text
agentVersion    <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"AgentVersion"
    Text
protocolVersion <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ProtocolVersion"

    return Info :: Text -> Text -> [Peer] -> Text -> Text -> Info
Info {[Peer]
Text
protocolVersion :: Text
agentVersion :: Text
addresses :: [Peer]
publicKey :: Text
id :: Text
$sel:protocolVersion:Info :: Text
$sel:agentVersion:Info :: Text
$sel:addresses:Info :: [Peer]
$sel:publicKey:Info :: Text
$sel:id:Info :: Text
..}