module Ethereum.Analyzer.Solidity.AstJson
( SolNode(..)
, decodeSoleNodes
, defSolNode
) where
import Protolude hiding ((<>), show)
import Data.Aeson
import Data.Aeson.Types
import Data.HashMap.Lazy hiding (map)
import Ethereum.Analyzer.Common
import Ckev.In.Text
import Text.PrettyPrint.Leijen.Text as PP
decodeSoleNodes :: LByteString -> Either Text [SolNode]
decodeSoleNodes combined_ast = do
value <- s2t4Either (eitherDecode combined_ast) :: Either Text Value
case value of
Object o1 -> do
srcObj <-
maybeToRight "Could not find 'sources' in object" (lookup "sources" o1) :: Either Text Value
case srcObj of
Object o2 -> do
let srcUnitObjs = elems o2
mapM (s2t4Either . eitherDecode . encode) (srcUnitObjs :: [Value])
_ -> Left "'sources''s value is not an Aeson Object"
_ -> Left "input is not an Aeson Object"
data SolNode = SolNode
{ name :: Maybe Text
, _id :: Maybe Int
, _type :: Maybe Text
, _AST :: Maybe SolNode
, attributes :: Maybe SolNode
, constant :: Maybe Bool
, components :: Maybe [Maybe SolNode]
, fullyImplemented :: Maybe Bool
, hexvalue :: Maybe Text
, isLibrary :: Maybe Bool
, linearizedBaseContracts :: Maybe [Int]
, literals :: Maybe [Text]
, member_name :: Maybe Text
, operator :: Maybe Text
, payable :: Maybe Bool
, src :: Maybe Text
, storageLocation :: Maybe Text
, subdenomination :: Maybe Text
, token :: Maybe Text
, type_conversion :: Maybe Bool
, value :: Maybe Text
, visibility :: Maybe Text
, children :: Maybe [SolNode]
} deriving (Eq, Generic, Show)
instance ShowText SolNode where
showText = showT
instance ToJSON SolNode where
toJSON =
genericToJSON
defaultOptions
{fieldLabelModifier = dropWhile (== '_'), omitNothingFields = True}
instance FromJSON SolNode where
parseJSON =
genericParseJSON
defaultOptions
{fieldLabelModifier = dropWhile (== '_'), omitNothingFields = True}
defSolNode :: SolNode
defSolNode =
SolNode
{ children = Nothing
, _id = Nothing
, _type = Nothing
, _AST = Nothing
, attributes = Nothing
, constant = Nothing
, components = Nothing
, fullyImplemented = Nothing
, hexvalue = Nothing
, isLibrary = Nothing
, linearizedBaseContracts = Nothing
, literals = Nothing
, member_name = Nothing
, name = Nothing
, operator = Nothing
, payable = Nothing
, src = Nothing
, storageLocation = Nothing
, subdenomination = Nothing
, token = Nothing
, type_conversion = Nothing
, value = Nothing
, visibility = Nothing
}
instance Pretty SolNode where
pretty n@SolNode {name = name}
| isNothing name = prettyAst n
| name == Just "SourceUnit" = prettySourceUnit n
| name == Just "PragmaDirective" = PP.empty
| name == Just "ContractDefinition" = prettyContractDefinition n
| name == Just "VariableDeclaration" = prettyVariableDeclaration n
| name == Just "ElementaryTypeName" = prettyElementTypeName n
| name == Just "FunctionDefinition" = prettyFunctionDefinition n
| name == Just "ParameterList" = prettyParameterList n
| name == Just "Block" = prettyBlock n
| name == Just "ExpressionStatement" = prettyExpressionStatement n
| name == Just "Assignment" = prettyAssignment n
| name == Just "Identifier" = prettyIdentifier n
| name == Just "Return" = prettyReturn n
| name == Just "Mapping" = prettyMapping n
| name == Just "IndexAccess" = prettyIndexAccess n
| name == Just "MemberAccess" = prettyMemberAccess n
| name == Just "IfStatement" = prettyIfStatement n
| name == Just "BinaryOperation" = prettyBinaryOperation n
| name == Just "VariableDeclarationStatement" =
prettyVariableDeclarationStatement n
| name == Just "FunctionCall" = prettyFunctionCall n
| name == Just "UserDefinedTypeName" = prettyUserDefinedTypeName n
| name == Just "Literal" = prettyLiteral n
| otherwise = unimplementedPanic n
prettyAst :: SolNode -> Doc
prettyAst SolNode {name = Nothing, _AST = Just ast} = pretty ast
prettyAst n = unexpectedPanic n
prettySourceUnit :: SolNode -> Doc
prettySourceUnit SolNode {name = Just "SourceUnit", children = Just children} =
textStrict "//--SourceUnit--" PP.<$> vsep (map pretty children)
prettySourceUnit n = unexpectedPanic n
prettyContractDefinition :: SolNode -> Doc
prettyContractDefinition SolNode { name = Just "ContractDefinition"
, children = Just children
, attributes = Just SolNode { children = Nothing
, name = Just cName
}
} =
textStrict "contract" </> textStrict cName </>
semiBraces (map pretty children)
prettyContractDefinition n = unexpectedPanic n
prettyVariableDeclaration :: SolNode -> Doc
prettyVariableDeclaration SolNode { name = Just "VariableDeclaration"
, children = Just _
, attributes = Just SolNode { children = Nothing
, name = Just vName
, _type = Just vType
}
}
= textStrict vType </> textStrict vName
prettyVariableDeclaration n = unexpectedPanic n
prettyElementTypeName :: SolNode -> Doc
prettyElementTypeName SolNode { name = Just "ElementaryTypeName"
, children = Nothing
, attributes = Just SolNode {name = Just veType}
} = textStrict veType
prettyElementTypeName n = unexpectedPanic n
prettyFunctionDefinition :: SolNode -> Doc
prettyFunctionDefinition SolNode { name = Just "FunctionDefinition"
, children = Just [params, returns, body]
, attributes = Just SolNode { children = Nothing
, name = Just fName
}
} =
textStrict "fun" </>
align (textStrict fName </> cat (map pretty [params, returns, body]))
prettyFunctionDefinition n = unexpectedPanic n
prettyParameterList :: SolNode -> Doc
prettyParameterList SolNode { name = Just "ParameterList"
, children = Just pChildren
} =
parens (align (cat (punctuate comma $ map pretty pChildren)))
prettyParameterList n = unexpectedPanic n
prettyBlock :: SolNode -> Doc
prettyBlock SolNode {name = Just "Block", children = Just children} =
semiBraces $ map pretty children
prettyBlock n = unexpectedPanic n
prettyExpressionStatement :: SolNode -> Doc
prettyExpressionStatement SolNode { name = Just "ExpressionStatement"
, children = Just children
} = tupled $ map pretty children
prettyExpressionStatement n = unexpectedPanic n
prettyAssignment :: SolNode -> Doc
prettyAssignment SolNode { name = Just "Assignment"
, children = Just [lval, rval]
, attributes = Just SolNode { _type = Just _
, operator = Just operator
}
} = pretty lval <> textStrict operator <> pretty rval
prettyAssignment n = unexpectedPanic n
prettyIdentifier :: SolNode -> Doc
prettyIdentifier SolNode { name = Just "Identifier"
, children = Nothing
, attributes = Just SolNode { _type = Just _
, value = Just idName
}
}
= textStrict idName
prettyIdentifier n = unexpectedPanic n
prettyReturn :: SolNode -> Doc
prettyReturn SolNode {name = Just "Return", children = Just children} =
textStrict "return" <> tupled (map pretty children)
prettyReturn n = unexpectedPanic n
prettyMapping :: SolNode -> Doc
prettyMapping SolNode {name = Just "Mapping", children = Just children} =
textStrict "mapping" <> tupled (map pretty children)
prettyMapping n = unexpectedPanic n
prettyIndexAccess :: SolNode -> Doc
prettyIndexAccess SolNode { name = Just "IndexAccess"
, children = Just (c1:ctail)
, attributes = Just SolNode {_type = Just _}
} = pretty c1 <> pretty ctail
prettyIndexAccess n = unexpectedPanic n
prettyMemberAccess :: SolNode -> Doc
prettyMemberAccess SolNode { name = Just "MemberAccess"
, children = Just [obj]
, attributes = Just SolNode { _type = Just _
, member_name = Just mName
}
} = pretty obj <> textStrict "." <> textStrict mName
prettyMemberAccess n = unexpectedPanic n
prettyIfStatement :: SolNode -> Doc
prettyIfStatement SolNode {name = Just "IfStatement", children = Just children} =
textStrict "if" <> tupled (map pretty children)
prettyIfStatement n = unexpectedPanic n
prettyBinaryOperation :: SolNode -> Doc
prettyBinaryOperation SolNode { name = Just "BinaryOperation"
, children = Just [op1, op2]
, attributes = Just SolNode { _type = Just _
, operator = Just vOp
}
} =
parens (pretty op1 <> textStrict vOp <> pretty op2)
prettyBinaryOperation n = unexpectedPanic n
prettyVariableDeclarationStatement :: SolNode -> Doc
prettyVariableDeclarationStatement SolNode { name = Just "VariableDeclarationStatement"
, children = Just [vdec, vinit]
} =
pretty vdec </> textStrict "=" </> pretty vinit
prettyVariableDeclarationStatement n = unexpectedPanic n
prettyFunctionCall :: SolNode -> Doc
prettyFunctionCall SolNode { name = Just "FunctionCall"
, children = Just (func:params)
, attributes = Just SolNode {_type = Just _}
} = pretty func <> tupled (map pretty params)
prettyFunctionCall n = unexpectedPanic n
prettyUserDefinedTypeName :: SolNode -> Doc
prettyUserDefinedTypeName SolNode { name = Just "UserDefinedTypeName"
, children = Nothing
, attributes = Just SolNode {name = Just vName}
} = textStrict vName
prettyUserDefinedTypeName n = unexpectedPanic n
prettyLiteral :: SolNode -> Doc
prettyLiteral SolNode { name = Just "Literal"
, children = Nothing
, attributes = Just SolNode { _type = Just _
, value = Just vValue
}
} = textStrict vValue
prettyLiteral n = unexpectedPanic n