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

import Network.IPFS.Prelude
import Network.IPFS.Bytes.Types


data Stat = Stat 
  { Stat -> Bytes
blockSize      :: Bytes
  , Stat -> Bytes
cumulativeSize :: Bytes
  , Stat -> Bytes
dataSize       :: Bytes
  , Stat -> Text
hash           :: Text
  , Stat -> Bytes
linksSize      :: Bytes
  , Stat -> Natural
numLinks       :: Natural
  }

instance FromJSON Stat where
  parseJSON :: Value -> Parser Stat
parseJSON = String -> (Object -> Parser Stat) -> Value -> Parser Stat
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Stat" \Object
obj -> do
    Bytes
blockSize      <- Object
obj Object -> Text -> Parser Bytes
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"BlockSize"
    Bytes
cumulativeSize <- Object
obj Object -> Text -> Parser Bytes
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"CumulativeSize"
    Bytes
dataSize       <- Object
obj Object -> Text -> Parser Bytes
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"DataSize"
    Text
hash           <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Hash"
    Bytes
linksSize      <- Object
obj Object -> Text -> Parser Bytes
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"LinksSize"
    Natural
numLinks       <- Object
obj Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"NumLinks"

    return Stat :: Bytes -> Bytes -> Bytes -> Text -> Bytes -> Natural -> Stat
Stat {Natural
Text
Bytes
numLinks :: Natural
linksSize :: Bytes
hash :: Text
dataSize :: Bytes
cumulativeSize :: Bytes
blockSize :: Bytes
$sel:numLinks:Stat :: Natural
$sel:linksSize:Stat :: Bytes
$sel:hash:Stat :: Text
$sel:dataSize:Stat :: Bytes
$sel:cumulativeSize:Stat :: Bytes
$sel:blockSize:Stat :: Bytes
..}