{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Haskoin.Transaction.Genesis
-- Copyright   : No rights reserved
-- License     : UNLICENSE
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- Code related to transactions parsing and serialization.
module Haskoin.Transaction.Genesis (genesisTx) where

import Crypto.Secp256k1 (Ctx, importPubKey)
import Data.Bytes.Get (runGetS)
import Haskoin.Crypto.Keys.Common
import Haskoin.Script.Standard
import Haskoin.Transaction.Common
import Haskoin.Util

-- | Transaction from Genesis block.
genesisTx :: Ctx -> Tx
genesisTx :: Ctx -> Tx
genesisTx Ctx
ctx =
  Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx Word32
1 [TxIn
txin] [TxOut
txout] [] Word32
locktime
  where
    txin :: TxIn
txin = OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
outpoint ByteString
inputBS Word32
forall a. Bounded a => a
maxBound
    txout :: TxOut
txout = Word64 -> ByteString -> TxOut
TxOut Word64
5000000000 (Ctx -> ScriptOutput -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx ScriptOutput
output)
    locktime :: Word32
locktime = Word32
0
    outpoint :: OutPoint
outpoint = TxHash -> Word32 -> OutPoint
OutPoint TxHash
z Word32
forall a. Bounded a => a
maxBound
    Just ByteString
inputBS =
      Text -> Maybe ByteString
decodeHex
        Text
"04ffff001d0104455468652054696d65732030332f4a616e2f323030392043686\
        \16e63656c6c6f72206f6e206272696e6b206f66207365636f6e64206261696c6f\
        \757420666f722062616e6b73"
    Just ByteString
pubKeyBS =
      Text -> Maybe ByteString
decodeHex
        Text
"04678afdb0fe5548271967f1a67130b7105cd6a828e03909a67962e0ea1f61deb\
        \649f6bc3f4cef38c4f35504e51ec112de5c384df7ba0b8d578a4c702b6bf11d5f"
    Right PublicKey
pubKey =
      Ctx -> ByteString -> Either String PublicKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
pubKeyBS
    output :: ScriptOutput
output = PublicKey -> ScriptOutput
PayPK PublicKey
pubKey
    z :: TxHash
z = TxHash
"0000000000000000000000000000000000000000000000000000000000000000"