module EVM.StorageLayout where

-- Figures out the layout of storage slots for Solidity contracts.

import EVM.Dapp (DappInfo(..))
import EVM.Solidity (SolcContract, creationSrcmap, SlotType(..))
import EVM.ABI (AbiType (..), parseTypeName)

import Optics.Core
import Data.Aeson (Value (..))
import Data.Aeson.Optics
import Data.Foldable (toList)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence qualified as Seq
import Data.Text (Text, unpack, pack, words)
import EVM.Types (internalError)

import Prelude hiding (words)

-- A contract has all the slots of its inherited contracts.
--
-- The slot order is determined by the inheritance linearization order,
-- so we first have to calculate that.
--
-- This information is available in the abstract syntax tree.

findContractDefinition :: DappInfo -> SolcContract -> Maybe Value
findContractDefinition :: DappInfo -> SolcContract -> Maybe Value
findContractDefinition DappInfo
dapp SolcContract
solc =
  -- The first source mapping in the contract's creation code
  -- corresponds to the source field of the contract definition.
  case Seq SrcMap -> ViewL SrcMap
forall (a :: OpticKind). Seq a -> ViewL a
Seq.viewl SolcContract
solc.creationSrcmap of
    SrcMap
firstSrcMap Seq.:< Seq SrcMap
_ ->
      DappInfo
dapp.astSrcMap SrcMap
firstSrcMap
    ViewL SrcMap
_ ->
      Maybe Value
forall (a :: OpticKind). Maybe a
Nothing

storageLayout :: DappInfo -> SolcContract -> [Text]
storageLayout :: DappInfo -> SolcContract -> [Text]
storageLayout DappInfo
dapp SolcContract
solc =
  let
    root :: Value
    root :: Value
root =
      Value -> Maybe Value -> Value
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Value
Null
        (DappInfo -> SolcContract -> Maybe Value
findContractDefinition DappInfo
dapp SolcContract
solc)
  in
    case Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Value -> Maybe (Vector Value)
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview ( Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"attributes"
                 AffineTraversal' Value Value
-> AffineTraversal' Value Value -> AffineTraversal' Value Value
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"linearizedBaseContracts"
                 AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array
                 ) Value
root of
      Maybe (Vector Value)
Nothing ->
        []
      Just (([Value] -> [Value]
forall (a :: OpticKind). [a] -> [a]
reverse ([Value] -> [Value])
-> (Vector Value -> [Value]) -> Vector Value -> [Value]
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Vector Value -> [Value]
forall (a :: OpticKind). Vector a -> [a]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList) -> [Value]
linearizedBaseContracts) ->
        ((Value -> [Text]) -> [Value] -> [Text])
-> [Value] -> (Value -> [Text]) -> [Text]
forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> b -> a -> c
flip (Value -> [Text]) -> [Value] -> [Text]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap [Value]
linearizedBaseContracts
          (\case
             Number Scientific
i -> [Text] -> Maybe [Text] -> [Text]
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe ([Char] -> [Text]
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"malformed AST JSON") (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall (a :: OpticKind) b. (a -> b) -> a -> b
$
               Value -> Maybe [Text]
storageVariablesForContract (Value -> Maybe [Text]) -> Maybe Value -> Maybe [Text]
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
(a -> m b) -> m a -> m b
=<<
                 Int -> Map Int Value -> Maybe Value
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup (Scientific -> Int
forall (b :: OpticKind). Integral b => Scientific -> b
forall (a :: OpticKind) (b :: OpticKind).
(RealFrac a, Integral b) =>
a -> b
floor Scientific
i) DappInfo
dapp.astIdMap
             Value
_ ->
               [Char] -> [Text]
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"malformed AST JSON")

storageVariablesForContract :: Value -> Maybe [Text]
storageVariablesForContract :: Value -> Maybe [Text]
storageVariablesForContract Value
node = do
  Text
name <- Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index Value -> Optic' (IxKind Value) NoIx Value (IxValue Value)
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Key
Index Value
"attributes" AffineTraversal' Value Value
-> AffineTraversal' Value Value -> AffineTraversal' Value Value
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
node
  [Value]
vars <-
    (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> Maybe a -> Maybe b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap
      ((Value -> Bool) -> [Value] -> [Value]
forall (a :: OpticKind). (a -> Bool) -> [a] -> [a]
filter Value -> Bool
isStorageVariableDeclaration ([Value] -> [Value])
-> (Vector Value -> [Value]) -> Vector Value -> [Value]
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Vector Value -> [Value]
forall (a :: OpticKind). Vector a -> [a]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList)
      (Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Value -> Maybe (Vector Value)
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index Value -> Optic' (IxKind Value) NoIx Value (IxValue Value)
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Key
Index Value
"children" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array) Value
node)

  [Text] -> Maybe [Text]
forall (a :: OpticKind). a -> Maybe a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ([Text] -> Maybe [Text])
-> ((Value -> Text) -> [Text]) -> (Value -> Text) -> Maybe [Text]
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ((Value -> Text) -> [Value] -> [Text])
-> [Value] -> (Value -> Text) -> [Text]
forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> b -> a -> c
flip (Value -> Text) -> [Value] -> [Text]
forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map [Value]
vars ((Value -> Text) -> Maybe [Text])
-> (Value -> Text) -> Maybe [Text]
forall (a :: OpticKind) b. (a -> b) -> a -> b
$
    \Value
x ->
      case Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"attributes" AffineTraversal' Value Value
-> AffineTraversal' Value Value -> AffineTraversal' Value Value
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
x of
        Just Text
variableName ->
          [Text] -> Text
forall (a :: OpticKind). Monoid a => [a] -> a
mconcat
            [ Text
variableName
            , Text
" (", Text
name, Text
")"
            , Text
"\n", Text
"  Type: "
            , [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ SlotType -> [Char]
forall (a :: OpticKind). Show a => a -> [Char]
show (Value -> SlotType
slotTypeForDeclaration Value
x)
            ]
        Maybe Text
Nothing ->
          [Char] -> Text
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"malformed variable declaration"

nodeIs :: Text -> Value -> Bool
nodeIs :: Text -> Value -> Bool
nodeIs Text
t Value
x = Bool
isSourceNode Bool -> Bool -> Bool
&& Bool
hasRightName
  where
    isSourceNode :: Bool
isSourceNode =
      Maybe Value -> Bool
forall (a :: OpticKind). Maybe a -> Bool
isJust (AffineTraversal' Value Value -> Value -> Maybe Value
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"src") Value
x)
    hasRightName :: Bool
hasRightName =
      Text -> Maybe Text
forall (a :: OpticKind). a -> Maybe a
Just Text
t Maybe Text -> Maybe Text -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
x

isStorageVariableDeclaration :: Value -> Bool
isStorageVariableDeclaration :: Value -> Bool
isStorageVariableDeclaration Value
x =
  Text -> Value -> Bool
nodeIs Text
"VariableDeclaration" Value
x
    Bool -> Bool -> Bool
&& Optic' An_AffineTraversal NoIx Value Bool -> Value -> Maybe Bool
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"attributes" AffineTraversal' Value Value
-> AffineTraversal' Value Value -> AffineTraversal' Value Value
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"constant" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Bool Bool
-> Optic' An_AffineTraversal NoIx Value Bool
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Bool Bool
forall (t :: OpticKind). AsValue t => Prism' t Bool
_Bool) Value
x Maybe Bool -> Maybe Bool -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall (a :: OpticKind). a -> Maybe a
Just Bool
True

slotTypeForDeclaration :: Value -> SlotType
slotTypeForDeclaration :: Value -> SlotType
slotTypeForDeclaration Value
node =
  case Vector Value -> [Value]
forall (a :: OpticKind). Vector a -> [a]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Value -> Maybe (Vector Value)
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"children" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array) Value
node of
    Just (Value
x:[Value]
_) ->
      Value -> SlotType
grokDeclarationType Value
x
    Maybe [Value]
_ ->
      [Char] -> SlotType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"malformed AST"

grokDeclarationType :: Value -> SlotType
grokDeclarationType :: Value -> SlotType
grokDeclarationType Value
x =
  case Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
x of
    Just Text
"Mapping" ->
      case Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Value -> Maybe (Vector Value)
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"children" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array) Value
x of
        Just (Vector Value -> [Value]
forall (a :: OpticKind). Vector a -> [a]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList -> [Value]
xs) ->
          [Value] -> SlotType
grokMappingType [Value]
xs
        Maybe (Vector Value)
_ ->
          [Char] -> SlotType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"malformed AST"
    Just Text
_ ->
      AbiType -> SlotType
StorageValue (Value -> AbiType
grokValueType Value
x)
    Maybe Text
_ ->
      [Char] -> SlotType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError ([Char]
"malformed AST " [Char] -> [Char] -> [Char]
forall (a :: OpticKind). [a] -> [a] -> [a]
++ Value -> [Char]
forall (a :: OpticKind). Show a => a -> [Char]
show Value
x)

grokMappingType :: [Value] -> SlotType
grokMappingType :: [Value] -> SlotType
grokMappingType [Value
s, Value
t] =
  case (Value -> SlotType
grokDeclarationType Value
s, Value -> SlotType
grokDeclarationType Value
t) of
    (StorageValue AbiType
s', StorageMapping NonEmpty AbiType
t' AbiType
x) ->
      NonEmpty AbiType -> AbiType -> SlotType
StorageMapping (AbiType -> NonEmpty AbiType -> NonEmpty AbiType
forall (a :: OpticKind). a -> NonEmpty a -> NonEmpty a
NonEmpty.cons AbiType
s' NonEmpty AbiType
t') AbiType
x
    (StorageValue AbiType
s', StorageValue AbiType
t') ->
      NonEmpty AbiType -> AbiType -> SlotType
StorageMapping (AbiType -> NonEmpty AbiType
forall (a :: OpticKind). a -> NonEmpty a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure AbiType
s') AbiType
t'
    (StorageMapping NonEmpty AbiType
_ AbiType
_, SlotType
_) ->
      [Char] -> SlotType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"unexpected mapping as mapping key"
grokMappingType [Value]
_ =
  [Char] -> SlotType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"unexpected AST child count for mapping"

grokValueType :: Value -> AbiType
grokValueType :: Value -> AbiType
grokValueType Value
x =
  case ( Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
x
       , Optic' An_AffineTraversal NoIx Value (Vector Value)
-> Value -> Maybe (Vector Value)
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"children" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic' An_AffineTraversal NoIx Value (Vector Value)
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array) Value
x
       , Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"attributes" AffineTraversal' Value Value
-> AffineTraversal' Value Value -> AffineTraversal' Value Value
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"type" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
x
       ) of
    (Just Text
"ElementaryTypeName", Maybe (Vector Value)
_, Just Text
typeName) ->
      AbiType -> Maybe AbiType -> AbiType
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe ([Char] -> AbiType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError ([Char] -> AbiType) -> [Char] -> AbiType
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Char]
"ungrokked value type: " [Char] -> [Char] -> [Char]
forall (a :: OpticKind). [a] -> [a] -> [a]
++ Text -> [Char]
forall (a :: OpticKind). Show a => a -> [Char]
show Text
typeName)
        (Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall (a :: OpticKind). Monoid a => a
mempty ([Text] -> Text
forall (a :: OpticKind). HasCallStack => [a] -> a
head (Text -> [Text]
words Text
typeName)))
    (Just Text
"UserDefinedTypeName", Maybe (Vector Value)
_, Maybe Text
_) ->
      AbiType
AbiAddressType
    (Just Text
"ArrayTypeName", (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> Maybe a -> Maybe b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap Vector Value -> [Value]
forall (a :: OpticKind). Vector a -> [a]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList -> Just [Value
t], Maybe Text
_)->
      AbiType -> AbiType
AbiArrayDynamicType (Value -> AbiType
grokValueType Value
t)
    (Just Text
"ArrayTypeName", (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> Maybe a -> Maybe b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap Vector Value -> [Value]
forall (a :: OpticKind). Vector a -> [a]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList -> Just [Value
t, Value
n], Maybe Text
_)->
      case ( Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"name" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
n
           , Optic' An_AffineTraversal NoIx Value Text -> Value -> Maybe Text
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"attributes" AffineTraversal' Value Value
-> AffineTraversal' Value Value -> AffineTraversal' Value Value
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Key -> AffineTraversal' Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"value" AffineTraversal' Value Value
-> Optic A_Prism NoIx Value Value Text Text
-> Optic' An_AffineTraversal NoIx Value Text
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx Value Value Text Text
forall (t :: OpticKind). AsValue t => Prism' t Text
_String) Value
n
           ) of
        (Just Text
"Literal", Just (([Char] -> Int
forall (a :: OpticKind). Read a => [Char] -> a
read ([Char] -> Int) -> (Text -> [Char]) -> Text -> Int
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) -> Int
i)) ->
          Int -> AbiType -> AbiType
AbiArrayType Int
i (Value -> AbiType
grokValueType Value
t)
        (Maybe Text, Maybe Text)
_ ->
          [Char] -> AbiType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError [Char]
"malformed AST"
    (Maybe Text, Maybe (Vector Value), Maybe Text)
_ ->
      [Char] -> AbiType
forall (a :: OpticKind). HasCallStack => [Char] -> a
internalError ([Char]
"unknown value type " [Char] -> [Char] -> [Char]
forall (a :: OpticKind). [a] -> [a] -> [a]
++ Value -> [Char]
forall (a :: OpticKind). Show a => a -> [Char]
show Value
x)