module Tendermint.SDK.Types.Transaction where

import           Control.Error                  (note)
import           Control.Lens                   (Wrapped (..), from, iso, view,
                                                 (&), (.~), (^.), _Unwrapped')
import           Crypto.Hash                    (Digest, hashWith)
import           Crypto.Hash.Algorithms         (SHA256 (..))
import           Data.Bifunctor                 (bimap)
import           Data.ByteString                (ByteString)
import           Data.Int                       (Int64)
import qualified Data.ProtoLens                 as P
import           Data.Proxy
import           Data.String.Conversions        (cs)
import           Data.Text                      (Text)
import           Data.Word                      (Word64)
import           GHC.Generics                   (Generic)
import qualified Proto.Types.Transaction        as T
import qualified Proto.Types.Transaction_Fields as T
import           Tendermint.SDK.Codec           (HasCodec (..))
import           Tendermint.SDK.Crypto          (MakeDigest (..),
                                                 RecoverableSignatureSchema (..),
                                                 SignatureSchema (..))
import           Tendermint.SDK.Types.Message   (Msg (..), TypedMessage (..))

-- Our standard transaction type parameterized by the signature schema 'alg'
-- and an underlying message type 'msg'.
data Tx alg msg = Tx
  { Tx alg msg -> Msg msg
txMsg       :: Msg msg
  , Tx alg msg -> Text
txRoute     :: Text
  , Tx alg msg -> Int64
txGas       :: Int64
  , Tx alg msg -> RecoverableSignature alg
txSignature :: RecoverableSignature alg
  , Tx alg msg -> Message alg
txSignBytes :: Message alg
  , Tx alg msg -> PubKey alg
txSigner    :: PubKey alg
  , Tx alg msg -> Word64
txNonce     :: Word64
  }

instance Functor (Tx alg) where
  fmap :: (a -> b) -> Tx alg a -> Tx alg b
fmap f :: a -> b
f tx :: Tx alg a
tx@Tx{Msg a
txMsg :: Msg a
txMsg :: forall k (alg :: k) msg. Tx alg msg -> Msg msg
txMsg} = Tx alg a
tx {txMsg :: Msg b
txMsg = (a -> b) -> Msg a -> Msg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Msg a
txMsg}

--------------------------------------------------------------------------------

-- TODO: figure out what the actual standards are for these things, if there
-- even are any.

-- | Raw transaction type coming in over the wire
data RawTransaction = RawTransaction
  { RawTransaction -> TypedMessage
rawTransactionData      :: TypedMessage
  -- ^ the encoded message via protobuf encoding
  , RawTransaction -> Int64
rawTransactionGas       :: Int64
  , RawTransaction -> Text
rawTransactionRoute     :: Text
  -- ^ module name
  , RawTransaction -> ByteString
rawTransactionSignature :: ByteString
  , RawTransaction -> Word64
rawTransactionNonce     :: Word64
  } deriving (forall x. RawTransaction -> Rep RawTransaction x)
-> (forall x. Rep RawTransaction x -> RawTransaction)
-> Generic RawTransaction
forall x. Rep RawTransaction x -> RawTransaction
forall x. RawTransaction -> Rep RawTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawTransaction x -> RawTransaction
$cfrom :: forall x. RawTransaction -> Rep RawTransaction x
Generic

instance Wrapped RawTransaction where
  type Unwrapped RawTransaction = T.RawTransaction

  _Wrapped' :: p (Unwrapped RawTransaction) (f (Unwrapped RawTransaction))
-> p RawTransaction (f RawTransaction)
_Wrapped' = (RawTransaction -> RawTransaction)
-> (RawTransaction -> RawTransaction)
-> Iso RawTransaction RawTransaction RawTransaction RawTransaction
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso RawTransaction -> RawTransaction
forall b.
(Message b, HasField b "data'" TypedMessage,
 HasField b "gas" Int64, HasField b "nonce" Word64,
 HasField b "route" Text, HasField b "signature" ByteString) =>
RawTransaction -> b
t RawTransaction -> RawTransaction
forall s.
(HasField s "data'" TypedMessage, HasField s "gas" Int64,
 HasField s "nonce" Word64, HasField s "route" Text,
 HasField s "signature" ByteString) =>
s -> RawTransaction
f
   where
    t :: RawTransaction -> b
t RawTransaction {..} =
      b
forall msg. Message msg => msg
P.defMessage
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b TypedMessage
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
T.data' LensLike' Identity b TypedMessage -> TypedMessage -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TypedMessage
rawTransactionData TypedMessage
-> Getting TypedMessage TypedMessage TypedMessage -> TypedMessage
forall s a. s -> Getting a s a -> a
^. Getting TypedMessage TypedMessage TypedMessage
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gas" a) =>
LensLike' f s a
T.gas LensLike' Identity b Int64 -> Int64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int64
rawTransactionGas
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Text
forall (f :: * -> *) s a.
(Functor f, HasField s "route" a) =>
LensLike' f s a
T.route LensLike' Identity b Text -> Text -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
rawTransactionRoute
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "signature" a) =>
LensLike' f s a
T.signature LensLike' Identity b ByteString -> ByteString -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
rawTransactionSignature
        b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& LensLike' Identity b Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "nonce" a) =>
LensLike' f s a
T.nonce LensLike' Identity b Word64 -> Word64 -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
rawTransactionNonce
    f :: s -> RawTransaction
f message :: s
message = RawTransaction :: TypedMessage
-> Int64 -> Text -> ByteString -> Word64 -> RawTransaction
RawTransaction
      { rawTransactionData :: TypedMessage
rawTransactionData      = s
message s -> Getting TypedMessage s TypedMessage -> TypedMessage
forall s a. s -> Getting a s a -> a
^. LensLike' (Const TypedMessage) s TypedMessage
forall (f :: * -> *) s a.
(Functor f, HasField s "data'" a) =>
LensLike' f s a
T.data' LensLike' (Const TypedMessage) s TypedMessage
-> ((TypedMessage -> Const TypedMessage TypedMessage)
    -> TypedMessage -> Const TypedMessage TypedMessage)
-> Getting TypedMessage s TypedMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypedMessage -> Const TypedMessage TypedMessage)
-> TypedMessage -> Const TypedMessage TypedMessage
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
      , rawTransactionGas :: Int64
rawTransactionGas = s
message s -> Getting Int64 s Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 s Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "gas" a) =>
LensLike' f s a
T.gas
      , rawTransactionRoute :: Text
rawTransactionRoute = s
message s -> Getting Text s Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text s Text
forall (f :: * -> *) s a.
(Functor f, HasField s "route" a) =>
LensLike' f s a
T.route
      , rawTransactionSignature :: ByteString
rawTransactionSignature = s
message s -> Getting ByteString s ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString s ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "signature" a) =>
LensLike' f s a
T.signature
      , rawTransactionNonce :: Word64
rawTransactionNonce = s
message s -> Getting Word64 s Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 s Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "nonce" a) =>
LensLike' f s a
T.nonce
      }

instance HasCodec RawTransaction where
  encode :: RawTransaction -> ByteString
encode = RawTransaction -> ByteString
forall msg. Message msg => msg -> ByteString
P.encodeMessage (RawTransaction -> ByteString)
-> (RawTransaction -> RawTransaction)
-> RawTransaction
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting RawTransaction RawTransaction RawTransaction
-> RawTransaction -> RawTransaction
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting RawTransaction RawTransaction RawTransaction
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
  decode :: ByteString -> Either Text RawTransaction
decode = (String -> Text)
-> (RawTransaction -> RawTransaction)
-> Either String RawTransaction
-> Either Text RawTransaction
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 (Getting RawTransaction RawTransaction RawTransaction
-> RawTransaction -> RawTransaction
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting RawTransaction RawTransaction RawTransaction
 -> RawTransaction -> RawTransaction)
-> Getting RawTransaction RawTransaction RawTransaction
-> RawTransaction
-> RawTransaction
forall a b. (a -> b) -> a -> b
$ AnIso RawTransaction RawTransaction RawTransaction RawTransaction
-> Iso RawTransaction RawTransaction RawTransaction RawTransaction
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso RawTransaction RawTransaction RawTransaction RawTransaction
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Either String RawTransaction -> Either Text RawTransaction)
-> (ByteString -> Either String RawTransaction)
-> ByteString
-> Either Text RawTransaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String RawTransaction
forall msg. Message msg => ByteString -> Either String msg
P.decodeMessage

instance MakeDigest RawTransaction where
  makeDigest :: RawTransaction -> Digest SHA256
makeDigest tx :: RawTransaction
tx = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 (ByteString -> Digest SHA256)
-> (RawTransaction -> ByteString)
-> RawTransaction
-> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawTransaction -> ByteString
forall a. HasCodec a => a -> ByteString
encode (RawTransaction -> Digest SHA256)
-> RawTransaction -> Digest SHA256
forall a b. (a -> b) -> a -> b
$ RawTransaction
tx {rawTransactionSignature :: ByteString
rawTransactionSignature = ""}

signRawTransaction
  :: forall alg.
     RecoverableSignatureSchema alg
  => Message alg ~ Digest SHA256
  => Proxy alg
  -> PrivateKey alg --
  -> RawTransaction
  -> RecoverableSignature alg
signRawTransaction :: Proxy alg
-> PrivateKey alg -> RawTransaction -> RecoverableSignature alg
signRawTransaction p :: Proxy alg
p priv :: PrivateKey alg
priv tx :: RawTransaction
tx = Proxy alg
-> PrivateKey alg -> Message alg -> RecoverableSignature alg
forall k (alg :: k).
RecoverableSignatureSchema alg =>
Proxy alg
-> PrivateKey alg -> Message alg -> RecoverableSignature alg
signRecoverableMessage Proxy alg
p PrivateKey alg
priv (RawTransaction -> Digest SHA256
forall a. MakeDigest a => a -> Digest SHA256
makeDigest RawTransaction
tx)

-- | Attempt to parse a Bytestring into a 'RawTransaction' then as a 'Tx' without
-- | attempting to parse the underlying message. This is done as a preprocessing
-- | step to the router, allowing for failure before the router is ever
-- | reached.
parseTx
  :: forall alg.
     RecoverableSignatureSchema alg
  => Message alg ~ Digest SHA256
  => Proxy alg
  -> ByteString
  -> Either Text (Tx alg ByteString)
parseTx :: Proxy alg -> ByteString -> Either Text (Tx alg ByteString)
parseTx p :: Proxy alg
p bs :: ByteString
bs = do
  rawTx :: RawTransaction
rawTx@RawTransaction{..} <- ByteString -> Either Text RawTransaction
forall a. HasCodec a => ByteString -> Either Text a
decode ByteString
bs
  RecoverableSignature alg
recSig <- Text
-> Maybe (RecoverableSignature alg)
-> Either Text (RecoverableSignature alg)
forall a b. a -> Maybe b -> Either a b
note "Unable to parse transaction signature as a recovery signature." (Maybe (RecoverableSignature alg)
 -> Either Text (RecoverableSignature alg))
-> Maybe (RecoverableSignature alg)
-> Either Text (RecoverableSignature alg)
forall a b. (a -> b) -> a -> b
$
    Proxy alg -> ByteString -> Maybe (RecoverableSignature alg)
forall k (alg :: k).
RecoverableSignatureSchema alg =>
Proxy alg -> ByteString -> Maybe (RecoverableSignature alg)
makeRecoverableSignature Proxy alg
p ByteString
rawTransactionSignature
  let txForSigning :: RawTransaction
txForSigning = RawTransaction
rawTx {rawTransactionSignature :: ByteString
rawTransactionSignature = ""}
      signBytes :: Digest SHA256
signBytes = RawTransaction -> Digest SHA256
forall a. MakeDigest a => a -> Digest SHA256
makeDigest RawTransaction
txForSigning
  PubKey alg
signerPubKey <- Text -> Maybe (PubKey alg) -> Either Text (PubKey alg)
forall a b. a -> Maybe b -> Either a b
note "Signature recovery failed." (Maybe (PubKey alg) -> Either Text (PubKey alg))
-> Maybe (PubKey alg) -> Either Text (PubKey alg)
forall a b. (a -> b) -> a -> b
$ Proxy alg
-> RecoverableSignature alg -> Message alg -> Maybe (PubKey alg)
forall k (alg :: k).
RecoverableSignatureSchema alg =>
Proxy alg
-> RecoverableSignature alg -> Message alg -> Maybe (PubKey alg)
recover Proxy alg
p RecoverableSignature alg
recSig Digest SHA256
Message alg
signBytes
  Tx alg ByteString -> Either Text (Tx alg ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx alg ByteString -> Either Text (Tx alg ByteString))
-> Tx alg ByteString -> Either Text (Tx alg ByteString)
forall a b. (a -> b) -> a -> b
$ Tx :: forall k (alg :: k) msg.
Msg msg
-> Text
-> Int64
-> RecoverableSignature alg
-> Message alg
-> PubKey alg
-> Word64
-> Tx alg msg
Tx
    { txMsg :: Msg ByteString
txMsg = Msg :: forall msg. Address -> msg -> Text -> Msg msg
Msg
              { msgData :: ByteString
msgData = TypedMessage -> ByteString
typedMsgData TypedMessage
rawTransactionData
              , msgAuthor :: Address
msgAuthor = Proxy alg -> PubKey alg -> Address
forall k (alg :: k).
SignatureSchema alg =>
Proxy alg -> PubKey alg -> Address
addressFromPubKey Proxy alg
p PubKey alg
signerPubKey
              , msgType :: Text
msgType = TypedMessage -> Text
typedMsgType TypedMessage
rawTransactionData
              }
    , txRoute :: Text
txRoute = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
rawTransactionRoute
    , txGas :: Int64
txGas = Int64
rawTransactionGas
    , txSignature :: RecoverableSignature alg
txSignature = RecoverableSignature alg
recSig
    , txSignBytes :: Message alg
txSignBytes = Digest SHA256
Message alg
signBytes
    , txSigner :: PubKey alg
txSigner = PubKey alg
signerPubKey
    , txNonce :: Word64
txNonce = Word64
rawTransactionNonce
    }