{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Network.Polkadot.Metadata
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Node runtime type information.
--

module Network.Polkadot.Metadata where

import           Codec.Scale                              (Decode, Encode,
                                                           Generic)
import           Data.Aeson                               (Options (constructorTagModifier, sumEncoding),
                                                           SumEncoding (ObjectWithSingleField),
                                                           defaultOptions)
import           Data.Aeson.TH                            (deriveJSON)
import           Data.Char                                (toLower)
import           Data.Set                                 (Set)
import qualified GHC.Generics                             as GHC (Generic)
import           Lens.Micro                               (_head, over)

import           Network.Polkadot.Metadata.MagicNumber    (MagicNumber (..))
import           Network.Polkadot.Metadata.Type           (Type)
import           Network.Polkadot.Metadata.Type.Discovery (runDiscovery)
import qualified Network.Polkadot.Metadata.V10            as V10 (Metadata (Metadata),
                                                                  moduleName)
import qualified Network.Polkadot.Metadata.V11            as V11 (Metadata (Metadata),
                                                                  moduleName)
import qualified Network.Polkadot.Metadata.V12            as V12 (Metadata (Metadata),
                                                                  moduleName)
import qualified Network.Polkadot.Metadata.V13            as V13 (Metadata (Metadata),
                                                                  moduleName)
import qualified Network.Polkadot.Metadata.V9             as V9 (Metadata (Metadata),
                                                                 moduleName)

-- | All supported metadata versions as enum.
--
-- It could have troubles of decoding for metadata V9 because of hack:
-- https://github.com/polkadot-js/api/commit/a9211690be6b68ad6c6dad7852f1665cadcfa5b2
data MetadataVersioned
  = V0 | V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8  -- Not defined
  | V9 V9.Metadata
  | V10 V10.Metadata
  | V11 V11.Metadata
  | V12 V12.Metadata
  | V13 V13.Metadata
  deriving (MetadataVersioned -> MetadataVersioned -> Bool
(MetadataVersioned -> MetadataVersioned -> Bool)
-> (MetadataVersioned -> MetadataVersioned -> Bool)
-> Eq MetadataVersioned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataVersioned -> MetadataVersioned -> Bool
== :: MetadataVersioned -> MetadataVersioned -> Bool
$c/= :: MetadataVersioned -> MetadataVersioned -> Bool
/= :: MetadataVersioned -> MetadataVersioned -> Bool
Eq, Int -> MetadataVersioned -> ShowS
[MetadataVersioned] -> ShowS
MetadataVersioned -> String
(Int -> MetadataVersioned -> ShowS)
-> (MetadataVersioned -> String)
-> ([MetadataVersioned] -> ShowS)
-> Show MetadataVersioned
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataVersioned -> ShowS
showsPrec :: Int -> MetadataVersioned -> ShowS
$cshow :: MetadataVersioned -> String
show :: MetadataVersioned -> String
$cshowList :: [MetadataVersioned] -> ShowS
showList :: [MetadataVersioned] -> ShowS
Show, All SListI (Code MetadataVersioned)
All SListI (Code MetadataVersioned) =>
(MetadataVersioned -> Rep MetadataVersioned)
-> (Rep MetadataVersioned -> MetadataVersioned)
-> Generic MetadataVersioned
Rep MetadataVersioned -> MetadataVersioned
MetadataVersioned -> Rep MetadataVersioned
forall a.
All SListI (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
$cfrom :: MetadataVersioned -> Rep MetadataVersioned
from :: MetadataVersioned -> Rep MetadataVersioned
$cto :: Rep MetadataVersioned -> MetadataVersioned
to :: Rep MetadataVersioned -> MetadataVersioned
Generic, (forall x. MetadataVersioned -> Rep MetadataVersioned x)
-> (forall x. Rep MetadataVersioned x -> MetadataVersioned)
-> Generic MetadataVersioned
forall x. Rep MetadataVersioned x -> MetadataVersioned
forall x. MetadataVersioned -> Rep MetadataVersioned x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetadataVersioned -> Rep MetadataVersioned x
from :: forall x. MetadataVersioned -> Rep MetadataVersioned x
$cto :: forall x. Rep MetadataVersioned x -> MetadataVersioned
to :: forall x. Rep MetadataVersioned x -> MetadataVersioned
GHC.Generic, Get MetadataVersioned
Get MetadataVersioned -> Decode MetadataVersioned
forall a. Get a -> Decode a
$cget :: Get MetadataVersioned
get :: Get MetadataVersioned
Decode, Putter MetadataVersioned
Putter MetadataVersioned -> Encode MetadataVersioned
forall a. Putter a -> Encode a
$cput :: Putter MetadataVersioned
put :: Putter MetadataVersioned
Encode)

$(deriveJSON (defaultOptions
    { constructorTagModifier = over _head toLower, sumEncoding = ObjectWithSingleField }) ''MetadataVersioned)

-- | The versioned runtime metadata as a decoded structure.
data Metadata = Metadata
    { Metadata -> MagicNumber
magicNumber :: MagicNumber
    , Metadata -> MetadataVersioned
metadata    :: MetadataVersioned
    } deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, All SListI (Code Metadata)
All SListI (Code Metadata) =>
(Metadata -> Rep Metadata)
-> (Rep Metadata -> Metadata) -> Generic Metadata
Rep Metadata -> Metadata
Metadata -> Rep Metadata
forall a.
All SListI (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
$cfrom :: Metadata -> Rep Metadata
from :: Metadata -> Rep Metadata
$cto :: Rep Metadata -> Metadata
to :: Rep Metadata -> Metadata
Generic, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metadata -> Rep Metadata x
from :: forall x. Metadata -> Rep Metadata x
$cto :: forall x. Rep Metadata x -> Metadata
to :: forall x. Rep Metadata x -> Metadata
GHC.Generic, Get Metadata
Get Metadata -> Decode Metadata
forall a. Get a -> Decode a
$cget :: Get Metadata
get :: Get Metadata
Decode, Putter Metadata
Putter Metadata -> Encode Metadata
forall a. Putter a -> Encode a
$cput :: Putter Metadata
put :: Putter Metadata
Encode)

$(deriveJSON defaultOptions ''Metadata)

isV9 :: Metadata -> Bool
isV9 :: Metadata -> Bool
isV9 (Metadata MagicNumber
_ (V9 Metadata
_)) = Bool
True
isV9 Metadata
_                   = Bool
False

isV10 :: Metadata -> Bool
isV10 :: Metadata -> Bool
isV10 (Metadata MagicNumber
_ (V10 Metadata
_)) = Bool
True
isV10 Metadata
_                    = Bool
False

isV11 :: Metadata -> Bool
isV11 :: Metadata -> Bool
isV11 (Metadata MagicNumber
_ (V11 Metadata
_)) = Bool
True
isV11 Metadata
_                    = Bool
False

isV12 :: Metadata -> Bool
isV12 :: Metadata -> Bool
isV12 (Metadata MagicNumber
_ (V12 Metadata
_)) = Bool
True
isV12 Metadata
_                    = Bool
False

isV13 :: Metadata -> Bool
isV13 :: Metadata -> Bool
isV13 (Metadata MagicNumber
_ (V13 Metadata
_)) = Bool
True
isV13 Metadata
_                    = Bool
False

isLatest :: Metadata -> Bool
{-# INLINE isLatest #-}
isLatest :: Metadata -> Bool
isLatest = Metadata -> Bool
isV13

toLatest :: Metadata -> V13.Metadata
toLatest :: Metadata -> Metadata
toLatest (Metadata MagicNumber
_ (V13 Metadata
m)) = Metadata
m
toLatest Metadata
_                    = Metadata
forall a. HasCallStack => a
undefined

metadataTypes :: Metadata -> (Metadata, Set Type)
metadataTypes :: Metadata -> (Metadata, Set Type)
metadataTypes (Metadata MagicNumber
_ (V9 (V9.Metadata [ModuleMetadata]
modules))) =
    let ([ModuleMetadata]
modules', Set Type
types) = (ModuleMetadata -> Text)
-> [ModuleMetadata] -> ([ModuleMetadata], Set Type)
forall a (t :: * -> *).
(Discovery a, Traversable t) =>
(a -> Text) -> t a -> (t a, Set Type)
runDiscovery ModuleMetadata -> Text
V9.moduleName [ModuleMetadata]
modules
    in (MagicNumber -> MetadataVersioned -> Metadata
Metadata MagicNumber
MagicNumber (Metadata -> MetadataVersioned
V9 ([ModuleMetadata] -> Metadata
V9.Metadata [ModuleMetadata]
modules')), Set Type
types)

metadataTypes (Metadata MagicNumber
_ (V10 (V10.Metadata [ModuleMetadata]
modules))) =
    let ([ModuleMetadata]
modules', Set Type
types) = (ModuleMetadata -> Text)
-> [ModuleMetadata] -> ([ModuleMetadata], Set Type)
forall a (t :: * -> *).
(Discovery a, Traversable t) =>
(a -> Text) -> t a -> (t a, Set Type)
runDiscovery ModuleMetadata -> Text
V10.moduleName [ModuleMetadata]
modules
    in (MagicNumber -> MetadataVersioned -> Metadata
Metadata MagicNumber
MagicNumber (Metadata -> MetadataVersioned
V10 ([ModuleMetadata] -> Metadata
V10.Metadata [ModuleMetadata]
modules')), Set Type
types)

{- XXX: OOM compilation on my laptop
metadataTypes (Metadata _ (V11 (V11.Metadata modules extrinsics))) =
    let (modules', types) = runDiscovery V11.moduleName modules
    in (Metadata MagicNumber (V11 (V11.Metadata modules' extrinsics)), types)
-}

metadataTypes (Metadata MagicNumber
_ (V12 (V12.Metadata [ModuleMetadata]
modules ExtrinsicMetadata
extrinsics))) =
    let ([ModuleMetadata]
modules', Set Type
types) = (ModuleMetadata -> Text)
-> [ModuleMetadata] -> ([ModuleMetadata], Set Type)
forall a (t :: * -> *).
(Discovery a, Traversable t) =>
(a -> Text) -> t a -> (t a, Set Type)
runDiscovery ModuleMetadata -> Text
V12.moduleName [ModuleMetadata]
modules
    in (MagicNumber -> MetadataVersioned -> Metadata
Metadata MagicNumber
MagicNumber (Metadata -> MetadataVersioned
V12 ([ModuleMetadata] -> ExtrinsicMetadata -> Metadata
V12.Metadata [ModuleMetadata]
modules' ExtrinsicMetadata
extrinsics)), Set Type
types)

metadataTypes (Metadata MagicNumber
_ (V13 (V13.Metadata [ModuleMetadata]
modules ExtrinsicMetadata
extrinsics))) =
    let ([ModuleMetadata]
modules', Set Type
types) = (ModuleMetadata -> Text)
-> [ModuleMetadata] -> ([ModuleMetadata], Set Type)
forall a (t :: * -> *).
(Discovery a, Traversable t) =>
(a -> Text) -> t a -> (t a, Set Type)
runDiscovery ModuleMetadata -> Text
V13.moduleName [ModuleMetadata]
modules
    in (MagicNumber -> MetadataVersioned -> Metadata
Metadata MagicNumber
MagicNumber (Metadata -> MetadataVersioned
V13 ([ModuleMetadata] -> ExtrinsicMetadata -> Metadata
V13.Metadata [ModuleMetadata]
modules' ExtrinsicMetadata
extrinsics)), Set Type
types)

metadataTypes Metadata
m = (Metadata
m, Set Type
forall a. Monoid a => a
mempty)