module Tendermint.SDK.Modules.Validators.Types where

import           Control.Lens                           (Wrapped (_Wrapped'),
                                                         iso, (^.), _Unwrapped')
import qualified Data.Aeson                             as A
import           Data.Bifunctor                         (Bifunctor (bimap, second))
import           Data.ByteString                        (ByteString)
import           Data.ByteString.Lazy                   (toStrict)
import           Data.Either                            (fromRight)
import           Data.Map                               (Map)
import           Data.ProtoLens                         (decodeMessage,
                                                         encodeMessage)
import           Data.Set                               (Set)
import           Data.String.Conversions                (cs)
import           Data.Word                              (Word64)
import           GHC.Generics                           (Generic)
import           Network.ABCI.Types.Messages.FieldTypes (PubKey (PubKey),
                                                         ValidatorUpdate)
import           Tendermint.SDK.BaseApp                 (QueryData, RawKey (..))
import           Tendermint.SDK.Codec                   (HasCodec (..))


data ValidatorsNameSpace

type ValidatorsName = "validators"


updatesListKey :: ByteString
updatesListKey :: ByteString
updatesListKey = "updatesList"

validatorsMapKey :: ByteString
validatorsMapKey :: ByteString
validatorsMapKey = "validatorsMap"

validatorsKeySetKey :: ByteString
validatorsKeySetKey :: ByteString
validatorsKeySetKey = "validatorsKeySet"


newtype ValidatorUpdate_ = ValidatorUpdate_ ValidatorUpdate deriving (ValidatorUpdate_ -> ValidatorUpdate_ -> Bool
(ValidatorUpdate_ -> ValidatorUpdate_ -> Bool)
-> (ValidatorUpdate_ -> ValidatorUpdate_ -> Bool)
-> Eq ValidatorUpdate_
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidatorUpdate_ -> ValidatorUpdate_ -> Bool
$c/= :: ValidatorUpdate_ -> ValidatorUpdate_ -> Bool
== :: ValidatorUpdate_ -> ValidatorUpdate_ -> Bool
$c== :: ValidatorUpdate_ -> ValidatorUpdate_ -> Bool
Eq, (forall x. ValidatorUpdate_ -> Rep ValidatorUpdate_ x)
-> (forall x. Rep ValidatorUpdate_ x -> ValidatorUpdate_)
-> Generic ValidatorUpdate_
forall x. Rep ValidatorUpdate_ x -> ValidatorUpdate_
forall x. ValidatorUpdate_ -> Rep ValidatorUpdate_ x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidatorUpdate_ x -> ValidatorUpdate_
$cfrom :: forall x. ValidatorUpdate_ -> Rep ValidatorUpdate_ x
Generic)

instance HasCodec ValidatorUpdate_ where
  encode :: ValidatorUpdate_ -> ByteString
encode (ValidatorUpdate_ vu :: ValidatorUpdate
vu) = ValidatorUpdate -> ByteString
forall msg. Message msg => msg -> ByteString
encodeMessage (ValidatorUpdate -> ByteString) -> ValidatorUpdate -> ByteString
forall a b. (a -> b) -> a -> b
$ (ValidatorUpdate
vu ValidatorUpdate
-> Getting ValidatorUpdate ValidatorUpdate ValidatorUpdate
-> ValidatorUpdate
forall s a. s -> Getting a s a -> a
^. Getting ValidatorUpdate ValidatorUpdate ValidatorUpdate
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')
  decode :: ByteString -> Either Text ValidatorUpdate_
decode bs :: ByteString
bs = (String -> Text)
-> (ValidatorUpdate -> ValidatorUpdate_)
-> Either String ValidatorUpdate
-> Either Text ValidatorUpdate_
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ValidatorUpdate -> ValidatorUpdate_
ValidatorUpdate_ (ValidatorUpdate -> ValidatorUpdate_)
-> (ValidatorUpdate -> ValidatorUpdate)
-> ValidatorUpdate
-> ValidatorUpdate_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidatorUpdate
-> Getting ValidatorUpdate ValidatorUpdate ValidatorUpdate
-> ValidatorUpdate
forall s a. s -> Getting a s a -> a
^. Getting ValidatorUpdate ValidatorUpdate ValidatorUpdate
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped')) (Either String ValidatorUpdate -> Either Text ValidatorUpdate_)
-> Either String ValidatorUpdate -> Either Text ValidatorUpdate_
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ValidatorUpdate
forall msg. Message msg => ByteString -> Either String msg
decodeMessage ByteString
bs

newtype PubKey_ = PubKey_ PubKey deriving (PubKey_ -> PubKey_ -> Bool
(PubKey_ -> PubKey_ -> Bool)
-> (PubKey_ -> PubKey_ -> Bool) -> Eq PubKey_
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKey_ -> PubKey_ -> Bool
$c/= :: PubKey_ -> PubKey_ -> Bool
== :: PubKey_ -> PubKey_ -> Bool
$c== :: PubKey_ -> PubKey_ -> Bool
Eq, Eq PubKey_
Eq PubKey_ =>
(PubKey_ -> PubKey_ -> Ordering)
-> (PubKey_ -> PubKey_ -> Bool)
-> (PubKey_ -> PubKey_ -> Bool)
-> (PubKey_ -> PubKey_ -> Bool)
-> (PubKey_ -> PubKey_ -> Bool)
-> (PubKey_ -> PubKey_ -> PubKey_)
-> (PubKey_ -> PubKey_ -> PubKey_)
-> Ord PubKey_
PubKey_ -> PubKey_ -> Bool
PubKey_ -> PubKey_ -> Ordering
PubKey_ -> PubKey_ -> PubKey_
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 :: PubKey_ -> PubKey_ -> PubKey_
$cmin :: PubKey_ -> PubKey_ -> PubKey_
max :: PubKey_ -> PubKey_ -> PubKey_
$cmax :: PubKey_ -> PubKey_ -> PubKey_
>= :: PubKey_ -> PubKey_ -> Bool
$c>= :: PubKey_ -> PubKey_ -> Bool
> :: PubKey_ -> PubKey_ -> Bool
$c> :: PubKey_ -> PubKey_ -> Bool
<= :: PubKey_ -> PubKey_ -> Bool
$c<= :: PubKey_ -> PubKey_ -> Bool
< :: PubKey_ -> PubKey_ -> Bool
$c< :: PubKey_ -> PubKey_ -> Bool
compare :: PubKey_ -> PubKey_ -> Ordering
$ccompare :: PubKey_ -> PubKey_ -> Ordering
$cp1Ord :: Eq PubKey_
Ord, (forall x. PubKey_ -> Rep PubKey_ x)
-> (forall x. Rep PubKey_ x -> PubKey_) -> Generic PubKey_
forall x. Rep PubKey_ x -> PubKey_
forall x. PubKey_ -> Rep PubKey_ x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PubKey_ x -> PubKey_
$cfrom :: forall x. PubKey_ -> Rep PubKey_ x
Generic)

instance RawKey PubKey_ where
  rawKey :: p ByteString (f ByteString) -> p PubKey_ (f PubKey_)
rawKey = (PubKey_ -> ByteString)
-> (ByteString -> PubKey_) -> Iso' PubKey_ ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso PubKey_ -> ByteString
t ByteString -> PubKey_
f
    where
      t :: PubKey_ -> ByteString
t (PubKey_ p :: PubKey
p) = PubKey -> ByteString
forall msg. Message msg => msg -> ByteString
encodeMessage (PubKey -> ByteString) -> PubKey -> ByteString
forall a b. (a -> b) -> a -> b
$ (PubKey
p PubKey -> Getting PubKey PubKey PubKey -> PubKey
forall s a. s -> Getting a s a -> a
^. Getting PubKey PubKey PubKey
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')
      f :: ByteString -> PubKey_
f = PubKey -> PubKey_
PubKey_ (PubKey -> PubKey_)
-> (ByteString -> PubKey) -> ByteString -> PubKey_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> Either String PubKey -> PubKey
forall b a. b -> Either a b -> b
fromRight (Text -> Base64String -> PubKey
PubKey "" "") (Either String PubKey -> PubKey)
-> (ByteString -> Either String PubKey) -> ByteString -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PubKey -> PubKey) -> Either String PubKey -> Either String PubKey
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (PubKey -> Getting PubKey PubKey PubKey -> PubKey
forall s a. s -> Getting a s a -> a
^. Getting PubKey PubKey PubKey
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped') (Either String PubKey -> Either String PubKey)
-> (ByteString -> Either String PubKey)
-> ByteString
-> Either String PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String PubKey
forall msg. Message msg => ByteString -> Either String msg
decodeMessage


instance A.ToJSON PubKey_
instance A.ToJSONKey PubKey_
instance A.FromJSON PubKey_
instance A.FromJSONKey PubKey_

instance HasCodec (Map PubKey_ Word64) where
  encode :: Map PubKey_ Word64 -> ByteString
encode = ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> ByteString)
-> (Map PubKey_ Word64 -> ByteString)
-> Map PubKey_ Word64
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PubKey_ Word64 -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode
  decode :: ByteString -> Either Text (Map PubKey_ Word64)
decode s :: ByteString
s =
    let Maybe (Map PubKey_ Word64)
ms :: Maybe (Map PubKey_ Word64) = ByteString -> Maybe (Map PubKey_ Word64)
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict ByteString
s
     in case Maybe (Map PubKey_ Word64)
ms of
          Just m :: Map PubKey_ Word64
m  -> Map PubKey_ Word64 -> Either Text (Map PubKey_ Word64)
forall a b. b -> Either a b
Right Map PubKey_ Word64
m
          Nothing -> Text -> Either Text (Map PubKey_ Word64)
forall a b. a -> Either a b
Left "failure to decode Map of Validators"

instance QueryData PubKey_

newtype KeySet = KeySet (Set PubKey_) deriving (forall x. KeySet -> Rep KeySet x)
-> (forall x. Rep KeySet x -> KeySet) -> Generic KeySet
forall x. Rep KeySet x -> KeySet
forall x. KeySet -> Rep KeySet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeySet x -> KeySet
$cfrom :: forall x. KeySet -> Rep KeySet x
Generic
instance A.ToJSON KeySet
instance A.FromJSON KeySet
instance HasCodec KeySet where
  encode :: KeySet -> ByteString
encode = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (KeySet -> ByteString) -> KeySet -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeySet -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode
  decode :: ByteString -> Either Text KeySet
decode s :: ByteString
s = Either Text KeySet
-> (KeySet -> Either Text KeySet)
-> Maybe KeySet
-> Either Text KeySet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text KeySet
forall a b. a -> Either a b
Left "failure to decode KeySet") KeySet -> Either Text KeySet
forall a b. b -> Either a b
Right (ByteString -> Maybe KeySet
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict ByteString
s)