{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell   #-}

-- |
-- Module      :  Data.Solidity.Abi.Json
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- JSON encoded contract ABI parsers.
--

module Language.Solidity.Abi
    (
    -- * Contract ABI declarations
      ContractAbi(..)
    , Declaration(..)
    , FunctionArg(..)
    , EventArg(..)
    , StateMutability(..)

    -- * Method/Event id encoder
    , signature
    , methodId
    , eventId

    -- * Solidity type parser
    , SolidityType(..)
    , parseSolidityFunctionArgType
    , parseSolidityEventArgType
    ) where

import           Control.Monad            (void)
import           Crypto.Ethereum.Utils    (keccak256)
import           Data.Aeson               (FromJSON (parseJSON), Options (constructorTagModifier, fieldLabelModifier, sumEncoding),
                                           SumEncoding (TaggedObject),
                                           ToJSON (toJSON), defaultOptions, withObject, (.:), (.:?))
import           Data.Aeson.TH            (deriveJSON, deriveToJSON)
import qualified Data.ByteArray           as A (take)
import           Data.ByteArray.HexString (toText)
import           Data.Char                (toLower)
import           Data.Text                (Text)
import qualified Data.Text                as T (dropEnd, unlines, unpack)
import           Data.Text.Encoding       (encodeUtf8)
import           Lens.Micro               (over, _head)
import           Text.Parsec              (ParseError, char, choice, digit, eof,
                                           lookAhead, many1, manyTill,
                                           optionMaybe, parse, string, try,
                                           (<|>))
import           Text.Parsec.Text         (Parser)

-- | Method argument
data FunctionArg = FunctionArg
    { FunctionArg -> Text
funArgName       :: Text
    -- ^ Argument name
    , FunctionArg -> Text
funArgType       :: Text
    -- ^ Argument type
    , FunctionArg -> Maybe [FunctionArg]
funArgComponents :: Maybe [FunctionArg]
    -- ^ Argument components for tuples
    }
    deriving (Int -> FunctionArg -> ShowS
[FunctionArg] -> ShowS
FunctionArg -> String
(Int -> FunctionArg -> ShowS)
-> (FunctionArg -> String)
-> ([FunctionArg] -> ShowS)
-> Show FunctionArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionArg] -> ShowS
$cshowList :: [FunctionArg] -> ShowS
show :: FunctionArg -> String
$cshow :: FunctionArg -> String
showsPrec :: Int -> FunctionArg -> ShowS
$cshowsPrec :: Int -> FunctionArg -> ShowS
Show, FunctionArg -> FunctionArg -> Bool
(FunctionArg -> FunctionArg -> Bool)
-> (FunctionArg -> FunctionArg -> Bool) -> Eq FunctionArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionArg -> FunctionArg -> Bool
$c/= :: FunctionArg -> FunctionArg -> Bool
== :: FunctionArg -> FunctionArg -> Bool
$c== :: FunctionArg -> FunctionArg -> Bool
Eq, Eq FunctionArg
Eq FunctionArg
-> (FunctionArg -> FunctionArg -> Ordering)
-> (FunctionArg -> FunctionArg -> Bool)
-> (FunctionArg -> FunctionArg -> Bool)
-> (FunctionArg -> FunctionArg -> Bool)
-> (FunctionArg -> FunctionArg -> Bool)
-> (FunctionArg -> FunctionArg -> FunctionArg)
-> (FunctionArg -> FunctionArg -> FunctionArg)
-> Ord FunctionArg
FunctionArg -> FunctionArg -> Bool
FunctionArg -> FunctionArg -> Ordering
FunctionArg -> FunctionArg -> FunctionArg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FunctionArg -> FunctionArg -> FunctionArg
$cmin :: FunctionArg -> FunctionArg -> FunctionArg
max :: FunctionArg -> FunctionArg -> FunctionArg
$cmax :: FunctionArg -> FunctionArg -> FunctionArg
>= :: FunctionArg -> FunctionArg -> Bool
$c>= :: FunctionArg -> FunctionArg -> Bool
> :: FunctionArg -> FunctionArg -> Bool
$c> :: FunctionArg -> FunctionArg -> Bool
<= :: FunctionArg -> FunctionArg -> Bool
$c<= :: FunctionArg -> FunctionArg -> Bool
< :: FunctionArg -> FunctionArg -> Bool
$c< :: FunctionArg -> FunctionArg -> Bool
compare :: FunctionArg -> FunctionArg -> Ordering
$ccompare :: FunctionArg -> FunctionArg -> Ordering
$cp1Ord :: Eq FunctionArg
Ord)

$(deriveJSON
    (defaultOptions {fieldLabelModifier = over _head toLower . drop 6})
    ''FunctionArg)

-- | Event argument
data EventArg = EventArg
    { EventArg -> Text
eveArgName    :: Text
    -- ^ Argument name
    , EventArg -> Text
eveArgType    :: Text
    -- ^ Argument type
    , EventArg -> Bool
eveArgIndexed :: Bool
    -- ^ Argument is indexed (e.g. placed on topics of event)
    }
    deriving (Int -> EventArg -> ShowS
[EventArg] -> ShowS
EventArg -> String
(Int -> EventArg -> ShowS)
-> (EventArg -> String) -> ([EventArg] -> ShowS) -> Show EventArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventArg] -> ShowS
$cshowList :: [EventArg] -> ShowS
show :: EventArg -> String
$cshow :: EventArg -> String
showsPrec :: Int -> EventArg -> ShowS
$cshowsPrec :: Int -> EventArg -> ShowS
Show, EventArg -> EventArg -> Bool
(EventArg -> EventArg -> Bool)
-> (EventArg -> EventArg -> Bool) -> Eq EventArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventArg -> EventArg -> Bool
$c/= :: EventArg -> EventArg -> Bool
== :: EventArg -> EventArg -> Bool
$c== :: EventArg -> EventArg -> Bool
Eq, Eq EventArg
Eq EventArg
-> (EventArg -> EventArg -> Ordering)
-> (EventArg -> EventArg -> Bool)
-> (EventArg -> EventArg -> Bool)
-> (EventArg -> EventArg -> Bool)
-> (EventArg -> EventArg -> Bool)
-> (EventArg -> EventArg -> EventArg)
-> (EventArg -> EventArg -> EventArg)
-> Ord EventArg
EventArg -> EventArg -> Bool
EventArg -> EventArg -> Ordering
EventArg -> EventArg -> EventArg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EventArg -> EventArg -> EventArg
$cmin :: EventArg -> EventArg -> EventArg
max :: EventArg -> EventArg -> EventArg
$cmax :: EventArg -> EventArg -> EventArg
>= :: EventArg -> EventArg -> Bool
$c>= :: EventArg -> EventArg -> Bool
> :: EventArg -> EventArg -> Bool
$c> :: EventArg -> EventArg -> Bool
<= :: EventArg -> EventArg -> Bool
$c<= :: EventArg -> EventArg -> Bool
< :: EventArg -> EventArg -> Bool
$c< :: EventArg -> EventArg -> Bool
compare :: EventArg -> EventArg -> Ordering
$ccompare :: EventArg -> EventArg -> Ordering
$cp1Ord :: Eq EventArg
Ord)

$(deriveJSON
    (defaultOptions {fieldLabelModifier = over _head toLower . drop 6})
    ''EventArg)

data StateMutability
  = SMPure
  | SMView
  | SMPayable
  | SMNonPayable
  deriving (StateMutability -> StateMutability -> Bool
(StateMutability -> StateMutability -> Bool)
-> (StateMutability -> StateMutability -> Bool)
-> Eq StateMutability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateMutability -> StateMutability -> Bool
$c/= :: StateMutability -> StateMutability -> Bool
== :: StateMutability -> StateMutability -> Bool
$c== :: StateMutability -> StateMutability -> Bool
Eq, Eq StateMutability
Eq StateMutability
-> (StateMutability -> StateMutability -> Ordering)
-> (StateMutability -> StateMutability -> Bool)
-> (StateMutability -> StateMutability -> Bool)
-> (StateMutability -> StateMutability -> Bool)
-> (StateMutability -> StateMutability -> Bool)
-> (StateMutability -> StateMutability -> StateMutability)
-> (StateMutability -> StateMutability -> StateMutability)
-> Ord StateMutability
StateMutability -> StateMutability -> Bool
StateMutability -> StateMutability -> Ordering
StateMutability -> StateMutability -> StateMutability
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StateMutability -> StateMutability -> StateMutability
$cmin :: StateMutability -> StateMutability -> StateMutability
max :: StateMutability -> StateMutability -> StateMutability
$cmax :: StateMutability -> StateMutability -> StateMutability
>= :: StateMutability -> StateMutability -> Bool
$c>= :: StateMutability -> StateMutability -> Bool
> :: StateMutability -> StateMutability -> Bool
$c> :: StateMutability -> StateMutability -> Bool
<= :: StateMutability -> StateMutability -> Bool
$c<= :: StateMutability -> StateMutability -> Bool
< :: StateMutability -> StateMutability -> Bool
$c< :: StateMutability -> StateMutability -> Bool
compare :: StateMutability -> StateMutability -> Ordering
$ccompare :: StateMutability -> StateMutability -> Ordering
$cp1Ord :: Eq StateMutability
Ord, Int -> StateMutability -> ShowS
[StateMutability] -> ShowS
StateMutability -> String
(Int -> StateMutability -> ShowS)
-> (StateMutability -> String)
-> ([StateMutability] -> ShowS)
-> Show StateMutability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateMutability] -> ShowS
$cshowList :: [StateMutability] -> ShowS
show :: StateMutability -> String
$cshow :: StateMutability -> String
showsPrec :: Int -> StateMutability -> ShowS
$cshowsPrec :: Int -> StateMutability -> ShowS
Show)

-- | Elementary contract interface item
data Declaration = DConstructor
    { Declaration -> [FunctionArg]
conInputs :: [FunctionArg]
    -- ^ Contract constructor
    }
    | DFunction
    { Declaration -> Text
funName     :: Text
    , Declaration -> Bool
funConstant :: Bool
    , Declaration -> [FunctionArg]
funInputs   :: [FunctionArg]
    , Declaration -> Maybe [FunctionArg]
funOutputs  :: Maybe [FunctionArg]
    -- ^ Method
    }
    | DEvent
    { Declaration -> Text
eveName      :: Text
    , Declaration -> [EventArg]
eveInputs    :: [EventArg]
    , Declaration -> Bool
eveAnonymous :: Bool
    -- ^ Event
    }
    | DFallback
    { Declaration -> Bool
falPayable :: Bool
    -- ^ Fallback function
    }
    deriving Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
(Int -> Declaration -> ShowS)
-> (Declaration -> String)
-> ([Declaration] -> ShowS)
-> Show Declaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Declaration] -> ShowS
$cshowList :: [Declaration] -> ShowS
show :: Declaration -> String
$cshow :: Declaration -> String
showsPrec :: Int -> Declaration -> ShowS
$cshowsPrec :: Int -> Declaration -> ShowS
Show

instance Eq Declaration where
    (DConstructor [FunctionArg]
a) == :: Declaration -> Declaration -> Bool
== (DConstructor [FunctionArg]
b) = [FunctionArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctionArg]
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [FunctionArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctionArg]
b
    (DFunction Text
a Bool
_ [FunctionArg]
_ Maybe [FunctionArg]
_) == (DFunction Text
b Bool
_ [FunctionArg]
_ Maybe [FunctionArg]
_) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
    (DEvent Text
a [EventArg]
_ Bool
_) == (DEvent Text
b [EventArg]
_ Bool
_) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
    (DFallback Bool
_) == (DFallback Bool
_) = Bool
True
    (==) Declaration
_ Declaration
_ = Bool
False

instance Ord Declaration where
    compare :: Declaration -> Declaration -> Ordering
compare (DConstructor [FunctionArg]
a) (DConstructor [FunctionArg]
b) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([FunctionArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctionArg]
a) ([FunctionArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctionArg]
b)
    compare (DFunction Text
a Bool
_ [FunctionArg]
_ Maybe [FunctionArg]
_) (DFunction Text
b Bool
_ [FunctionArg]
_ Maybe [FunctionArg]
_) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
    compare (DEvent Text
a [EventArg]
_ Bool
_) (DEvent Text
b [EventArg]
_ Bool
_) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
    compare (DFallback Bool
_) (DFallback Bool
_) = Ordering
EQ

    compare DConstructor {} DFunction {} = Ordering
LT
    compare DConstructor {} DEvent {} = Ordering
LT
    compare DConstructor {} DFallback {} = Ordering
LT

    compare DFunction {} DConstructor {} = Ordering
GT
    compare DFunction {} DEvent {} = Ordering
LT
    compare DFunction {} DFallback {} = Ordering
LT

    compare DEvent {} DConstructor {} = Ordering
GT
    compare DEvent {} DFunction {} = Ordering
GT
    compare DEvent {} DFallback {} = Ordering
LT

    compare DFallback {} DConstructor {} = Ordering
GT
    compare DFallback {} DFunction {} = Ordering
GT
    compare DFallback {} DEvent {} = Ordering
GT

instance FromJSON Declaration where
  parseJSON :: Value -> Parser Declaration
parseJSON = String
-> (Object -> Parser Declaration) -> Value -> Parser Declaration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Declaration" ((Object -> Parser Declaration) -> Value -> Parser Declaration)
-> (Object -> Parser Declaration) -> Value -> Parser Declaration
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
t :: Text <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
    case Text
t of
      Text
"fallback" -> Bool -> Declaration
DFallback (Bool -> Declaration) -> Parser Bool -> Parser Declaration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"payable"
      Text
"constructor" -> [FunctionArg] -> Declaration
DConstructor ([FunctionArg] -> Declaration)
-> Parser [FunctionArg] -> Parser Declaration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [FunctionArg]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"inputs"
      Text
"event" -> Text -> [EventArg] -> Bool -> Declaration
DEvent (Text -> [EventArg] -> Bool -> Declaration)
-> Parser Text -> Parser ([EventArg] -> Bool -> Declaration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name" Parser ([EventArg] -> Bool -> Declaration)
-> Parser [EventArg] -> Parser (Bool -> Declaration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [EventArg]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"inputs" Parser (Bool -> Declaration) -> Parser Bool -> Parser Declaration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"anonymous"
      Text
"function" -> Text -> Bool -> [FunctionArg] -> Maybe [FunctionArg] -> Declaration
DFunction (Text
 -> Bool -> [FunctionArg] -> Maybe [FunctionArg] -> Declaration)
-> Parser Text
-> Parser
     (Bool -> [FunctionArg] -> Maybe [FunctionArg] -> Declaration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name" Parser
  (Bool -> [FunctionArg] -> Maybe [FunctionArg] -> Declaration)
-> Parser Bool
-> Parser ([FunctionArg] -> Maybe [FunctionArg] -> Declaration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Bool
parseSm Object
o Parser ([FunctionArg] -> Maybe [FunctionArg] -> Declaration)
-> Parser [FunctionArg]
-> Parser (Maybe [FunctionArg] -> Declaration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [FunctionArg]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"inputs" Parser (Maybe [FunctionArg] -> Declaration)
-> Parser (Maybe [FunctionArg]) -> Parser Declaration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [FunctionArg])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"outputs"
      Text
_ -> String -> Parser Declaration
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"value of 'type' not recognized"
      where
        parseSm :: Object -> Parser Bool
parseSm Object
o = do
          Object
o Object -> Text -> Parser (Maybe StateMutability)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"stateMutability" Parser (Maybe StateMutability)
-> (Maybe StateMutability -> Parser Bool) -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe StateMutability
Nothing -> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"constant"
            Just StateMutability
sm -> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Parser Bool) -> Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ StateMutability
sm StateMutability -> [StateMutability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StateMutability
SMPure, StateMutability
SMView]

$(deriveToJSON
   (defaultOptions {
       sumEncoding = TaggedObject "type" "contents"
       , constructorTagModifier = over _head toLower . drop 1
       , fieldLabelModifier = over _head toLower . drop 3 })
   ''Declaration)

$(deriveJSON (defaultOptions {
    sumEncoding = TaggedObject "stateMutability" "contents"
  , constructorTagModifier = fmap toLower . drop 2 })
    ''StateMutability)


-- | Contract Abi is a list of method / event declarations
newtype ContractAbi = ContractAbi { ContractAbi -> [Declaration]
unAbi :: [Declaration] }
  deriving (ContractAbi -> ContractAbi -> Bool
(ContractAbi -> ContractAbi -> Bool)
-> (ContractAbi -> ContractAbi -> Bool) -> Eq ContractAbi
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractAbi -> ContractAbi -> Bool
$c/= :: ContractAbi -> ContractAbi -> Bool
== :: ContractAbi -> ContractAbi -> Bool
$c== :: ContractAbi -> ContractAbi -> Bool
Eq, Eq ContractAbi
Eq ContractAbi
-> (ContractAbi -> ContractAbi -> Ordering)
-> (ContractAbi -> ContractAbi -> Bool)
-> (ContractAbi -> ContractAbi -> Bool)
-> (ContractAbi -> ContractAbi -> Bool)
-> (ContractAbi -> ContractAbi -> Bool)
-> (ContractAbi -> ContractAbi -> ContractAbi)
-> (ContractAbi -> ContractAbi -> ContractAbi)
-> Ord ContractAbi
ContractAbi -> ContractAbi -> Bool
ContractAbi -> ContractAbi -> Ordering
ContractAbi -> ContractAbi -> ContractAbi
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContractAbi -> ContractAbi -> ContractAbi
$cmin :: ContractAbi -> ContractAbi -> ContractAbi
max :: ContractAbi -> ContractAbi -> ContractAbi
$cmax :: ContractAbi -> ContractAbi -> ContractAbi
>= :: ContractAbi -> ContractAbi -> Bool
$c>= :: ContractAbi -> ContractAbi -> Bool
> :: ContractAbi -> ContractAbi -> Bool
$c> :: ContractAbi -> ContractAbi -> Bool
<= :: ContractAbi -> ContractAbi -> Bool
$c<= :: ContractAbi -> ContractAbi -> Bool
< :: ContractAbi -> ContractAbi -> Bool
$c< :: ContractAbi -> ContractAbi -> Bool
compare :: ContractAbi -> ContractAbi -> Ordering
$ccompare :: ContractAbi -> ContractAbi -> Ordering
$cp1Ord :: Eq ContractAbi
Ord)

instance FromJSON ContractAbi where
    parseJSON :: Value -> Parser ContractAbi
parseJSON = ([Declaration] -> ContractAbi)
-> Parser [Declaration] -> Parser ContractAbi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Declaration] -> ContractAbi
ContractAbi (Parser [Declaration] -> Parser ContractAbi)
-> (Value -> Parser [Declaration]) -> Value -> Parser ContractAbi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [Declaration]
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON ContractAbi where
    toJSON :: ContractAbi -> Value
toJSON = [Declaration] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Declaration] -> Value)
-> (ContractAbi -> [Declaration]) -> ContractAbi -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractAbi -> [Declaration]
unAbi

instance Show ContractAbi where
    show :: ContractAbi -> String
show (ContractAbi [Declaration]
c) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        [ Text
"Contract:" ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Declaration -> [Text]) -> [Declaration] -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> [Text]
showConstructor [Declaration]
c [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ Text
"\tEvents:" ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Declaration -> [Text]) -> [Declaration] -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> [Text]
showEvent [Declaration]
c [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
        [ Text
"\tMethods:" ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Declaration -> [Text]) -> [Declaration] -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> [Text]
showMethod [Declaration]
c

showConstructor :: Declaration -> [Text]
showConstructor :: Declaration -> [Text]
showConstructor Declaration
x = case Declaration
x of
    DConstructor{} -> [Text
"\tConstructor " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Declaration -> Text
signature Declaration
x]
    Declaration
_              -> []

showEvent :: Declaration -> [Text]
showEvent :: Declaration -> [Text]
showEvent Declaration
x = case Declaration
x of
    DEvent{} -> [Text
"\t\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Declaration -> Text
signature Declaration
x]
    Declaration
_        -> []

showMethod :: Declaration -> [Text]
showMethod :: Declaration -> [Text]
showMethod Declaration
x = case Declaration
x of
    DFunction{} ->
        [Text
"\t\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Declaration -> Text
methodId Declaration
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Declaration -> Text
signature Declaration
x]
    Declaration
_ -> []

-- | Take a signature by given decl, e.g. foo(uint,string)
signature :: Declaration -> Text

signature :: Declaration -> Text
signature (DConstructor [FunctionArg]
inputs) = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
inputs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    args :: [FunctionArg] -> Text
args [] = Text
""
    args [FunctionArg
x] = FunctionArg -> Text
funArgType FunctionArg
x
    args (FunctionArg
x:[FunctionArg]
xs) = case FunctionArg -> Maybe [FunctionArg]
funArgComponents FunctionArg
x of
      Maybe [FunctionArg]
Nothing   -> FunctionArg -> Text
funArgType FunctionArg
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
xs
      Just [FunctionArg]
cmps -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
cmps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
xs

signature (DFallback Bool
_) = Text
"()"

signature (DFunction Text
name Bool
_ [FunctionArg]
inputs Maybe [FunctionArg]
_) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
inputs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    args :: [FunctionArg] -> Text
    args :: [FunctionArg] -> Text
args [] = Text
""
    args [FunctionArg
x] = FunctionArg -> Text
funArgType FunctionArg
x
    args (FunctionArg
x:[FunctionArg]
xs) = case FunctionArg -> Maybe [FunctionArg]
funArgComponents FunctionArg
x of
      Maybe [FunctionArg]
Nothing   -> FunctionArg -> Text
funArgType FunctionArg
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
xs
      Just [FunctionArg]
cmps -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
cmps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionArg] -> Text
args [FunctionArg]
xs

signature (DEvent Text
name [EventArg]
inputs Bool
_) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [EventArg] -> Text
args [EventArg]
inputs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    args :: [EventArg] -> Text
    args :: [EventArg] -> Text
args = Int -> Text -> Text
T.dropEnd Int
1 (Text -> Text) -> ([EventArg] -> Text) -> [EventArg] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
",") ([Text] -> Text) -> ([EventArg] -> [Text]) -> [EventArg] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventArg -> Text) -> [EventArg] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventArg -> Text
eveArgType

-- | Generate method selector by given method 'Delcaration'
methodId :: Declaration -> Text
{-# INLINE methodId #-}
methodId :: Declaration -> Text
methodId = HexString -> Text
toText (HexString -> Text)
-> (Declaration -> HexString) -> Declaration -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HexString -> HexString
forall bs. ByteArray bs => Int -> bs -> bs
A.take Int
4 (HexString -> HexString)
-> (Declaration -> HexString) -> Declaration -> HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HexString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
keccak256 (ByteString -> HexString)
-> (Declaration -> ByteString) -> Declaration -> HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Declaration -> Text) -> Declaration -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Text
signature

-- | Generate event `topic0` hash by givent event 'Delcaration'
eventId :: Declaration -> Text
{-# INLINE eventId #-}
eventId :: Declaration -> Text
eventId = HexString -> Text
toText (HexString -> Text)
-> (Declaration -> HexString) -> Declaration -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HexString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
keccak256 (ByteString -> HexString)
-> (Declaration -> ByteString) -> Declaration -> HexString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (Declaration -> Text) -> Declaration -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Text
signature

-- | Solidity types and parsers
data SolidityType = SolidityBool
    | SolidityAddress
    | SolidityUint Int
    | SolidityInt Int
    | SolidityString
    | SolidityBytesN Int
    | SolidityBytes
    | SolidityTuple [SolidityType]
    | SolidityVector [Int] SolidityType
    | SolidityArray SolidityType
    deriving (SolidityType -> SolidityType -> Bool
(SolidityType -> SolidityType -> Bool)
-> (SolidityType -> SolidityType -> Bool) -> Eq SolidityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolidityType -> SolidityType -> Bool
$c/= :: SolidityType -> SolidityType -> Bool
== :: SolidityType -> SolidityType -> Bool
$c== :: SolidityType -> SolidityType -> Bool
Eq, Int -> SolidityType -> ShowS
[SolidityType] -> ShowS
SolidityType -> String
(Int -> SolidityType -> ShowS)
-> (SolidityType -> String)
-> ([SolidityType] -> ShowS)
-> Show SolidityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolidityType] -> ShowS
$cshowList :: [SolidityType] -> ShowS
show :: SolidityType -> String
$cshow :: SolidityType -> String
showsPrec :: Int -> SolidityType -> ShowS
$cshowsPrec :: Int -> SolidityType -> ShowS
Show)

numberParser :: Parser Int
numberParser :: Parser Int
numberParser = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT Text () Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

parseUint :: Parser SolidityType
parseUint :: Parser SolidityType
parseUint = do
  String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"uint"
  Int -> SolidityType
SolidityUint (Int -> SolidityType) -> Parser Int -> Parser SolidityType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
numberParser

parseInt :: Parser SolidityType
parseInt :: Parser SolidityType
parseInt = do
  String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"int"
  Int -> SolidityType
SolidityInt (Int -> SolidityType) -> Parser Int -> Parser SolidityType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
numberParser

parseBool :: Parser SolidityType
parseBool :: Parser SolidityType
parseBool = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"bool" ParsecT Text () Identity String
-> Parser SolidityType -> Parser SolidityType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  SolidityType -> Parser SolidityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SolidityType
SolidityBool

parseString :: Parser SolidityType
parseString :: Parser SolidityType
parseString = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"string" ParsecT Text () Identity String
-> Parser SolidityType -> Parser SolidityType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SolidityType -> Parser SolidityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SolidityType
SolidityString

parseBytes :: Parser SolidityType
parseBytes :: Parser SolidityType
parseBytes = do
  String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"bytes"
  Maybe Int
mn <- Parser Int -> ParsecT Text () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe Parser Int
numberParser
  SolidityType -> Parser SolidityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SolidityType -> Parser SolidityType)
-> SolidityType -> Parser SolidityType
forall a b. (a -> b) -> a -> b
$ SolidityType -> (Int -> SolidityType) -> Maybe Int -> SolidityType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SolidityType
SolidityBytes Int -> SolidityType
SolidityBytesN Maybe Int
mn

parseAddress :: Parser SolidityType
parseAddress :: Parser SolidityType
parseAddress = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"address" ParsecT Text () Identity String
-> Parser SolidityType -> Parser SolidityType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SolidityType -> Parser SolidityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SolidityType
SolidityAddress

solidityBasicTypeParser :: Parser SolidityType
solidityBasicTypeParser :: Parser SolidityType
solidityBasicTypeParser =
    [Parser SolidityType] -> Parser SolidityType
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseUint
           , Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseInt
           , Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseAddress
           , Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseBool
           , Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseString
           , Parser SolidityType
parseBytes
           ]

parseVector :: Parser SolidityType
parseVector :: Parser SolidityType
parseVector = do
    SolidityType
s <- Parser SolidityType
solidityBasicTypeParser
    [Int]
ns <- Parser Int -> Parser () -> Parser [Int]
many1Till Parser Int
lengthParser (Parser () -> Parser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text () Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text () Identity String -> Parser ())
-> ParsecT Text () Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]") Parser () -> Parser () -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
    SolidityType -> Parser SolidityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SolidityType -> Parser SolidityType)
-> SolidityType -> Parser SolidityType
forall a b. (a -> b) -> a -> b
$ [Int] -> SolidityType -> SolidityType
SolidityVector [Int]
ns SolidityType
s
  where
    many1Till :: Parser Int -> Parser () -> Parser [Int]
    many1Till :: Parser Int -> Parser () -> Parser [Int]
many1Till Parser Int
p Parser ()
end = do
      Int
a <- Parser Int
p
      [Int]
as <- Parser Int -> Parser () -> Parser [Int]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill Parser Int
p Parser ()
end
      [Int] -> Parser [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
as)

    lengthParser :: Parser Int
lengthParser = do
          Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
          Int
n <- Parser Int
numberParser
          Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
          Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n

parseArray :: Parser SolidityType
parseArray :: Parser SolidityType
parseArray = do
  SolidityType
s <- Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser SolidityType
parseVector Parser SolidityType
-> ParsecT Text () Identity String -> Parser SolidityType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]") Parser SolidityType -> Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Parser SolidityType
solidityBasicTypeParser Parser SolidityType
-> ParsecT Text () Identity String -> Parser SolidityType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]")
  SolidityType -> Parser SolidityType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SolidityType -> Parser SolidityType)
-> SolidityType -> Parser SolidityType
forall a b. (a -> b) -> a -> b
$ SolidityType -> SolidityType
SolidityArray SolidityType
s


solidityTypeParser :: Parser SolidityType
solidityTypeParser :: Parser SolidityType
solidityTypeParser =
    [Parser SolidityType] -> Parser SolidityType
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseArray
           , Parser SolidityType -> Parser SolidityType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser SolidityType
parseVector
           , Parser SolidityType
solidityBasicTypeParser
           ]

parseSolidityFunctionArgType :: FunctionArg -> Either ParseError SolidityType
parseSolidityFunctionArgType :: FunctionArg -> Either ParseError SolidityType
parseSolidityFunctionArgType (FunctionArg Text
_ Text
typ Maybe [FunctionArg]
mcmps) = case Maybe [FunctionArg]
mcmps of
  Maybe [FunctionArg]
Nothing -> Parser SolidityType
-> String -> Text -> Either ParseError SolidityType
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser SolidityType
solidityTypeParser String
"Solidity" Text
typ
  Just [FunctionArg]
cmps -> [SolidityType] -> SolidityType
SolidityTuple ([SolidityType] -> SolidityType)
-> Either ParseError [SolidityType]
-> Either ParseError SolidityType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FunctionArg -> Either ParseError SolidityType)
-> [FunctionArg] -> Either ParseError [SolidityType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunctionArg -> Either ParseError SolidityType
parseSolidityFunctionArgType [FunctionArg]
cmps


parseSolidityEventArgType :: EventArg -> Either ParseError SolidityType
parseSolidityEventArgType :: EventArg -> Either ParseError SolidityType
parseSolidityEventArgType (EventArg Text
_ Text
typ Bool
_) = Parser SolidityType
-> String -> Text -> Either ParseError SolidityType
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser SolidityType
solidityTypeParser String
"Solidity" Text
typ