hydra-demo/src/Hydra/Devnet.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

-- | 

module Hydra.Devnet
  ( HydraScriptTxId
  , HydraKeyInfo(..)
  , SigningKey
  , KeyPair(..)
  , getCardanoAddress
  , seedAddressFromFaucetAndWait
  , publishReferenceScripts
  , queryAddressUTXOs
  , buildSignedHydraTx
  , generateKeys
  , cardanoNodePath
  , hydraNodePath
  , prepareDevnet
  , devnetMagic
  , minTxLovelace
  )

where

import System.Which
import System.Directory
import System.Process

import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson

import Control.Concurrent


import Data.Map (Map)

import Data.Bool
import qualified Data.Text as T
import qualified Data.Map as Map
import Data.String.Interpolate (i)
import Paths

import qualified Data.ByteString.Lazy.Char8 as BS

import Hydra.Types
import qualified Data.UUID.V4 as UUIDV4
import qualified Data.UUID as UUID
import Data.UUID (UUID)
import Data.Maybe (fromMaybe)


devnetMagic :: Int
devnetMagic = 42

prepareDevnet :: IO ()
prepareDevnet = do
  output <- readCreateProcess (shell "[ -d devnet ] || ./demo/prepare-devnet.sh") ""
  putStrLn output

cardanoNodePath :: FilePath
cardanoNodePath = $(staticWhich "cardano-node")

cardanoCliPath :: FilePath
cardanoCliPath = $(staticWhich "cardano-cli")

hydraNodePath :: FilePath
hydraNodePath = $(staticWhich "hydra-node")

jqPath :: FilePath
jqPath = $(staticWhich "jq")

type TxId = T.Text

type HydraScriptTxId = T.Text

type DraftTx = FilePath
type SignedTx = FilePath

devnetNetworkId :: Int
devnetNetworkId = 42

generateKeys :: (MonadIO m) => m HydraKeyInfo
generateKeys = do
  basePath <- liftIO getTempPath'
  HydraKeyInfo <$> generateCardanoKeys basePath <*> generateHydraKeys basePath


type SigningKey = String
type VerificationKey = String

data KeyPair = KeyPair
  { _signingKey :: SigningKey
  , _verificationKey :: VerificationKey
  }
  deriving (Show,Read)


data HydraKeyInfo = HydraKeyInfo
  { _cardanoKeys :: KeyPair
  , _hydraKeys :: KeyPair
  }
  deriving (Show,Read)

-- | Generate Cardano keys. Calling with an e.g. "my/keys/alice"
-- argument results in "my/keys/alice.cardano.{vk,sk}" keys being
-- written.
generateCardanoKeys :: (MonadIO m) => String -> m KeyPair
generateCardanoKeys path = do
  output <- liftIO $
    readCreateProcess
    (proc cardanoCliPath [ "address"
                         , "key-gen"
                         , "--verification-key-file"
                         , [i|#{path}.cardano.vk|]
                         , "--signing-key-file"
                         , [i|#{path}.cardano.sk|]
                         ])
    ""
  liftIO $ putStrLn output
  pure $ KeyPair [i|#{path}.cardano.sk|] [i|#{path}.cardano.vk|]

-- | Generate Hydra keys. Calling with an e.g. "my/keys/alice"
-- argument results in "my/keys/alice.hydra.{vk,sk}" keys being
-- written.
generateHydraKeys :: (MonadIO m) => String -> m KeyPair
generateHydraKeys path = do
  output <- liftIO $
    readCreateProcess
    (proc hydraToolsPath [ "gen-hydra-key"
                         , "--output-file"
                         , [i|#{path}.hydra|]
                         ])
    ""
  liftIO $ putStrLn output
  pure $ KeyPair [i|#{path}.hydra.sk|] [i|#{path}.hydra.vk|]


publishReferenceScripts :: (MonadIO m) => m HydraScriptTxId
publishReferenceScripts = do
  liftIO . putStrLn $ "Publishing reference scripts ('νInitial' & 'νCommit')..."
  fmap (T.strip . T.pack) $ liftIO $ readCreateProcess cp ""
  where
    cp = proc hydraNodePath [ "publish-scripts"
                              , "--network-id"
                              , show devnetNetworkId
                              , "--node-socket"
                              , "devnet/node.socket"
                              , "--cardano-signing-key"
                              , "devnet/credentials/faucet.sk"
                              ]


waitForTxIn :: (MonadIO m) => TxIn -> m ()
waitForTxIn txin = do
  liftIO . putStrLn $ "Waiting for utxo " <> show txin <> ".."
  liftIO waitFn
  where
    waitFn = do
      exists <- txInExists txin
      threadDelay 10000
      unless exists waitFn

txInExists :: TxIn -> IO Bool
txInExists txin = do
  result <- fmap (T.strip . T.pack) $ readCreateProcess cp "" >>= readProcess jqPath (pure $ ".\"" <> asStr <> "\"")
  pure $ case result of
    "null" -> False
    _ -> True
  where
    asStr = T.unpack txin
    cp = (proc cardanoCliPath [ "query"
                              , "utxo"
                              , "--tx-in"
                              , asStr
                              , "--out-file"
                              , "/dev/stdout"
                              , "--testnet-magic"
                              , "42"
                              ]) { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }

txInput :: Int -> TxId -> TxIn
txInput index txid = txid <> "#" <> (T.pack . show) index

-- TODO: use this in checks?
minTxLovelace :: Int
minTxLovelace = 857690

queryAddressUTXOs :: MonadIO m => Address -> m WholeUTXO
queryAddressUTXOs addr = liftIO $ do
  let queryProc =
        (proc cardanoCliPath [ "query"
                             , "utxo"
                             , "--address"
                             , addr
                             , "--testnet-magic"
                             , "42"
                             , "--out-file"
                             , "/dev/stdout"
                             ])
        { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }
  str <- readCreateProcess queryProc ""
  pure $ fromMaybe mempty $ decode $ BS.pack str


getTempPath' :: IO FilePath
getTempPath' = snd <$> getTempPath

getTempPath :: IO (UUID, FilePath)
getTempPath = do
  createDirectoryIfMissing True "tmp"
  uid <- UUIDV4.nextRandom
  pure . (uid,) . ("tmp/" <>) . UUID.toString $ uid

-- TODO(skylar): Check lovelace vs the full amount!
buildSignedHydraTx :: SigningKey -> Address -> Address -> Map TxIn Lovelace -> Lovelace -> IO String
buildSignedHydraTx signingKey fromAddr toAddr txInAmounts amount = do
  let fullAmount = sum txInAmounts
  txBodyPath <- snd <$> getTempPath
  void $ readCreateProcess (proc cardanoCliPath
                       ([ "transaction"
                        , "build-raw"
                        , "--babbage-era"
                        ]
                        <> (concatMap (\txin -> ["--tx-in", T.unpack txin]) . Map.keys $ txInAmounts)
                        <>
                        [ "--tx-out"
                        , [i|#{toAddr}+#{amount}|]
                        , "--tx-out"
                        , [i|#{fromAddr}+#{fullAmount - amount}|]
                        , "--fee"
                        , "0"
                        , "--out-file"
                        , txBodyPath
                        ]))
    ""
  readCreateProcess
    (proc cardanoCliPath
      [ "transaction"
      , "sign"
      , "--tx-body-file"
      , txBodyPath
      , "--signing-key-file"
      , signingKey
      , "--out-file"
      , "/dev/stdout"
      ])
    ""
--    { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }

-- | Convenience for getting faucet Output for seeding
getFirstTxIn :: Address -> IO TxIn
getFirstTxIn addr =
  readCreateProcess cp "" >>= readProcess jqPath ["-r", "keys[0]"] >>= \a -> pure $ T.strip $ T.pack a
  where
    cp = (proc cardanoCliPath [ "query"
                              , "utxo"
                              , "--address"
                              , addr
                              , "--testnet-magic"
                              , "42"
                              , "--out-file"
                              , "/dev/stdout"
                              ]) { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }


getCardanoAddress :: VerificationKey -> IO Address
getCardanoAddress keyPath =
  readCreateProcess cp ""
  where
    cp = (proc cardanoCliPath [ "address"
                              , "build"
                              , "--payment-verification-key-file"
                              , keyPath
                              , "--testnet-magic"
                              , "42"
                              ]) { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }


getFaucetAddress :: IO Address
getFaucetAddress = readCreateProcess cp ""
  where
    cp = (proc cardanoCliPath [ "address"
                              , "build"
                              , "--payment-verification-key-file"
                              , "devnet/credentials/faucet.vk"
                              , "--testnet-magic"
                              , "42"
                              ]) { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }

seedAddressFromFaucetAndWait :: (MonadIO m) => Address -> Lovelace -> Bool -> m TxIn
seedAddressFromFaucetAndWait addr amount isFuel = do
  txin <- liftIO $ seedAddressFromFaucet addr amount isFuel
  waitForTxIn txin
  pure txin

-- | Send an amount in lovelace to the named actor
seedAddressFromFaucet :: Address -> Lovelace -> Bool -> IO TxIn
seedAddressFromFaucet addr amount isFuel = do
  draftTx <- buildSeedTxForAddress addr amount isFuel
  signedTx <- signSeedTx' draftTx
  txin <- txInput 0 <$> seedTxIdFromSignedTx signedTx
  submitTx signedTx
  pure txin


buildSeedTxForAddress :: Address -> Lovelace -> Bool -> IO DraftTx
buildSeedTxForAddress addr amount isFuel = do
  filename <- getTempPath'
  -- when (amount < minTxLovelace) $ error $ "Minmum required UTxO: Lovelace " <> show minTxLovelace
  let cp faucet hash = (proc cardanoCliPath $ filter (/= "")
                              [ "transaction"
                              , "build"
                              , "--babbage-era"
                              , "--cardano-mode"
                              , "--change-address"
                              , faucet
                              , "--tx-in"
                              , hash
                              , "--tx-out"
                              , addr <> "+" <> show amount
                              ]
                              <> bool [] [ "--tx-out-datum-hash", T.unpack fuelMarkerDatumHash ] isFuel
                              <>
                              [ "--out-file"
                              , filename
                              , "--testnet-magic"
                              , "42"
                              ])
                            { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }
  faucet <- getFaucetAddress
  hash <- getFirstTxIn faucet
  _ <- readCreateProcess (cp faucet (T.unpack hash)) ""
  pure filename


signSeedTx' :: DraftTx -> IO SignedTx
signSeedTx' draftFile = do
  outFile <- getTempPath'
  let cp = (proc cardanoCliPath [ "transaction"
                                , "sign"
                                , "--tx-body-file"
                                , draftFile
                                , "--signing-key-file"
                                , "devnet/credentials/faucet.sk"
                                , "--out-file"
                                , outFile
                                , "--testnet-magic"
                                , "42"
                                ])
           { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }
  _ <- readCreateProcess cp ""
  pure outFile

seedTxIdFromSignedTx :: SignedTx -> IO TxId
seedTxIdFromSignedTx filename =
  T.strip . T.pack <$> readCreateProcess cp ""
  where
    cp = (proc cardanoCliPath [ "transaction"
                              , "txid"
                              , "--tx-file"
                              , filename
                              ]) { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }

submitTx :: SignedTx -> IO ()
submitTx signedFile = do
  _ <- readCreateProcess cp ""
  pure ()
  where
    cp = (proc cardanoCliPath [ "transaction"
                              , "submit"
                              , "--tx-file"
                              , signedFile
                              , "--testnet-magic"
                              , "42"
                              ]) { env = Just [("CARDANO_NODE_SOCKET_PATH", "devnet/node.socket")] }