{-# OPTIONS_GHC -fno-warn-orphans #-}
module Tendermint.Utils.Events where

import qualified Data.ByteArray.Base64String            as Base64
import qualified Data.ByteString                        as BS
import           Data.Char                              (toUpper)
import qualified Data.List                              as L
import           Data.String.Conversions                (cs)
import           Data.Text                              (Text, pack, unpack)
import           GHC.Generics
import           Network.ABCI.Types.Messages.FieldTypes (KVPair (..))
import           Tendermint.SDK.BaseApp.Events          (Event (..), ToEvent)
import           Tendermint.SDK.Codec                   (HasCodec (..))


class GFromNamedEventPrimatives f where
  gfromNamedEventPrimatives :: [(BS.ByteString, BS.ByteString)] -> Either Text (f a)

instance (Selector s, HasCodec a) => GFromNamedEventPrimatives (S1 s (K1 i a)) where
  gfromNamedEventPrimatives :: [(ByteString, ByteString)] -> Either Text (S1 s (K1 i a) a)
gfromNamedEventPrimatives kvs :: [(ByteString, ByteString)]
kvs =
    let name :: [Char]
name = M1 S s (K1 i a) Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName (forall p. M1 S s (K1 i a) p
forall a. HasCallStack => a
undefined :: S1 s (K1 i a) p)
    in case ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup ([Char] -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs [Char]
name) [(ByteString, ByteString)]
kvs of
         Nothing -> Text -> Either Text (S1 s (K1 i a) a)
forall a b. a -> Either a b
Left (Text -> Either Text (S1 s (K1 i a) a))
-> Text -> Either Text (S1 s (K1 i a) a)
forall a b. (a -> b) -> a -> b
$ "Could not find key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs [Char]
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " in Event key-values."
         Just val :: ByteString
val -> K1 i a a -> S1 s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> S1 s (K1 i a) a)
-> (a -> K1 i a a) -> a -> S1 s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> S1 s (K1 i a) a)
-> Either Text a -> Either Text (S1 s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text a
forall a. HasCodec a => ByteString -> Either Text a
decode ByteString
val

instance (GFromNamedEventPrimatives f) => GFromNamedEventPrimatives (C1 c f) where
  gfromNamedEventPrimatives :: [(ByteString, ByteString)] -> Either Text (C1 c f a)
gfromNamedEventPrimatives = (f a -> C1 c f a) -> Either Text (f a) -> Either Text (C1 c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either Text (f a) -> Either Text (C1 c f a))
-> ([(ByteString, ByteString)] -> Either Text (f a))
-> [(ByteString, ByteString)]
-> Either Text (C1 c f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, ByteString)] -> Either Text (f a)
forall (f :: * -> *) a.
GFromNamedEventPrimatives f =>
[(ByteString, ByteString)] -> Either Text (f a)
gfromNamedEventPrimatives


instance (GFromNamedEventPrimatives a, GFromNamedEventPrimatives b) => GFromNamedEventPrimatives (a :*: b) where
  gfromNamedEventPrimatives :: [(ByteString, ByteString)] -> Either Text ((:*:) a b a)
gfromNamedEventPrimatives kvs :: [(ByteString, ByteString)]
kvs =
    a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Either Text (a a) -> Either Text (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString, ByteString)] -> Either Text (a a)
forall (f :: * -> *) a.
GFromNamedEventPrimatives f =>
[(ByteString, ByteString)] -> Either Text (f a)
gfromNamedEventPrimatives [(ByteString, ByteString)]
kvs Either Text (b a -> (:*:) a b a)
-> Either Text (b a) -> Either Text ((:*:) a b a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(ByteString, ByteString)] -> Either Text (b a)
forall (f :: * -> *) a.
GFromNamedEventPrimatives f =>
[(ByteString, ByteString)] -> Either Text (f a)
gfromNamedEventPrimatives [(ByteString, ByteString)]
kvs

class GFromEvent f where
  gfromEventData :: Event -> Either Text (f p)

instance (GFromNamedEventPrimatives f, Datatype d) => GFromEvent (D1 d f) where
  gfromEventData :: Event -> Either Text (D1 d f p)
gfromEventData Event{Text
eventType :: Event -> Text
eventType :: Text
eventType, [KVPair]
eventAttributes :: Event -> [KVPair]
eventAttributes :: [KVPair]
eventAttributes} =
    let upperFirstChar :: [Char] -> [Char]
upperFirstChar []       = []
        upperFirstChar (x :: Char
x : xs :: [Char]
xs) = Char -> Char
toUpper Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
xs
        eventType' :: Text
eventType' = [Char] -> Text
pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
upperFirstChar ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
eventType
        dt :: Text
dt = [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ M1 D d f Any -> [Char]
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
datatypeName (forall p. M1 D d f p
forall a. HasCallStack => a
undefined ::  D1 d f p)
    in if Text
dt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
eventType'
         then (f p -> D1 d f p) -> Either Text (f p) -> Either Text (D1 d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> D1 d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either Text (f p) -> Either Text (D1 d f p))
-> ([(ByteString, ByteString)] -> Either Text (f p))
-> [(ByteString, ByteString)]
-> Either Text (D1 d f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, ByteString)] -> Either Text (f p)
forall (f :: * -> *) a.
GFromNamedEventPrimatives f =>
[(ByteString, ByteString)] -> Either Text (f a)
gfromNamedEventPrimatives ([(ByteString, ByteString)] -> Either Text (D1 d f p))
-> [(ByteString, ByteString)] -> Either Text (D1 d f p)
forall a b. (a -> b) -> a -> b
$
                (KVPair -> (ByteString, ByteString))
-> [KVPair] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(KVPair k :: Base64String
k v :: Base64String
v) -> (Base64String -> ByteString
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
k, Base64String -> ByteString
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
v)) [KVPair]
eventAttributes
         else Text -> Either Text (D1 d f p)
forall a b. a -> Either a b
Left (Text -> Either Text (D1 d f p)) -> Text -> Either Text (D1 d f p)
forall a b. (a -> b) -> a -> b
$ "Expected Event type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " does not match found Event type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
eventType' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."

class ToEvent e => FromEvent e where
  fromEvent :: Event -> Either Text e

  default fromEvent :: (Generic e, GFromEvent (Rep e)) => Event -> Either Text e
  fromEvent = (Rep e Any -> e) -> Either Text (Rep e Any) -> Either Text e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep e Any -> e
forall a x. Generic a => Rep a x -> a
to (Either Text (Rep e Any) -> Either Text e)
-> (Event -> Either Text (Rep e Any)) -> Event -> Either Text e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Either Text (Rep e Any)
forall (f :: * -> *) p. GFromEvent f => Event -> Either Text (f p)
gfromEventData