{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE ViewPatterns      #-}
{-| Conversion functions and other conveniences
-}
module Convex.Utils(
  scriptFromCbor,
  unsafeScriptFromCbor,
  scriptAddress,
  -- * Plutus V1
  scriptFromCborV1,
  unsafeScriptFromCborV1,
  scriptAddressV1,
  -- * Serialised transactions
  txFromCbor,
  unsafeTxFromCbor,

  -- * Dealing with errors
  liftResult,
  liftEither,
  mapError,
  failOnLeft,
  failOnLeftLog,

  -- * Reading key files
  readSigningKeyFromFile,
  readVerificationKeyFromFile,
  readStakingKeyFromFile,

  -- * Etc.
  extractTx,
  txnUtxos,
  slotToUtcTime,
  utcTimeToSlot,
  utcTimeToSlotUnsafe,
  utcTimeToPosixTime,
  posixTimeToSlot,
  posixTimeToSlotUnsafe,
  toShelleyPaymentCredential
) where

import           Cardano.Api                              (BabbageEra,
                                                           Block (..),
                                                           BlockInMode (..),
                                                           CardanoMode,
                                                           NetworkId,
                                                           PaymentCredential (..),
                                                           PlutusScript,
                                                           PlutusScriptV1,
                                                           PlutusScriptV2,
                                                           SlotNo, Tx, TxIn)
import qualified Cardano.Api.Shelley                      as C
import qualified Cardano.Ledger.Credential                as Shelley
import           Cardano.Ledger.Crypto                    (StandardCrypto)
import           Cardano.Slotting.EpochInfo.API           (EpochInfo,
                                                           epochInfoSlotToUTCTime,
                                                           hoistEpochInfo)
import qualified Cardano.Slotting.Time                    as Time
import           Control.Monad                            (void, when)
import           Control.Monad.Except                     (MonadError,
                                                           runExcept)
import           Control.Monad.IO.Class                   (MonadIO (..))
import           Control.Monad.Result                     (ResultT, throwError)
import qualified Control.Monad.Result                     as Result
import           Control.Monad.Trans.Except               (ExceptT, runExceptT)
import           Convex.MonadLog                          (MonadLog, logWarnS)
import           Convex.PlutusLedger                      (transPOSIXTime,
                                                           unTransPOSIXTime)
import           Data.Aeson                               (Result (..),
                                                           fromJSON, object,
                                                           (.=))
import           Data.Bifunctor                           (Bifunctor (..))
import           Data.Foldable                            (traverse_)
import           Data.Function                            ((&))
import           Data.Proxy                               (Proxy (..))
import           Data.Set                                 (Set)
import qualified Data.Set                                 as Set
import qualified Data.Text.IO                             as Text
import           Data.Time.Clock                          (NominalDiffTime,
                                                           UTCTime)
import           Data.Time.Clock.POSIX                    (posixSecondsToUTCTime,
                                                           utcTimeToPOSIXSeconds)
import qualified Ouroboros.Consensus.HardFork.History     as Consensus
import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry
import qualified PlutusLedgerApi.V1                       as PV1
import           System.Exit                              (exitFailure)

scriptFromCborV1 :: String -> Either String (PlutusScript PlutusScriptV1)
scriptFromCborV1 :: String -> Either String (PlutusScript PlutusScriptV1)
scriptFromCborV1 String
cbor = do
  let vl :: Value
vl = [Pair] -> Value
object [Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
s String
"PlutusScriptV1", Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
s String
"", Key
"cborHex" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
cbor]
  TextEnvelope
textEnvelope <- forall a. FromJSON a => Value -> Result a
fromJSON Value
vl forall a b. a -> (a -> b) -> b
& (\case { Error String
err -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
err); Success TextEnvelope
e -> forall a b. b -> Either a b
Right TextEnvelope
e })
  forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
C.deserialiseFromTextEnvelope (forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(PlutusScript PlutusScriptV1)) TextEnvelope
textEnvelope forall a b. a -> (a -> b) -> b
& forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show

unsafeScriptFromCborV1 :: String -> PlutusScript PlutusScriptV1
unsafeScriptFromCborV1 :: String -> PlutusScript PlutusScriptV1
unsafeScriptFromCborV1 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (PlutusScript PlutusScriptV1)
scriptFromCborV1

{-| Script address without staking key
-}
scriptAddressV1 :: NetworkId -> PlutusScript PlutusScriptV1 -> C.AddressInEra C.BabbageEra
scriptAddressV1 :: NetworkId -> PlutusScript PlutusScriptV1 -> AddressInEra BabbageEra
scriptAddressV1 NetworkId
network PlutusScript PlutusScriptV1
script =
  let hash :: ScriptHash
hash = forall lang. Script lang -> ScriptHash
C.hashScript (forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1 PlutusScript PlutusScriptV1
script)
  in forall era.
IsShelleyBasedEra era =>
NetworkId
-> PaymentCredential -> StakeAddressReference -> AddressInEra era
C.makeShelleyAddressInEra NetworkId
network (ScriptHash -> PaymentCredential
C.PaymentCredentialByScript ScriptHash
hash) StakeAddressReference
C.NoStakeAddress

scriptFromCbor :: String -> Either String (PlutusScript PlutusScriptV2)
scriptFromCbor :: String -> Either String (PlutusScript PlutusScriptV2)
scriptFromCbor String
cbor = do
  let vl :: Value
vl = [Pair] -> Value
object [Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
s String
"PlutusScriptV2", Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
s String
"", Key
"cborHex" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
cbor]
  TextEnvelope
textEnvelope <- forall a. FromJSON a => Value -> Result a
fromJSON Value
vl forall a b. a -> (a -> b) -> b
& (\case { Error String
err -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
err); Success TextEnvelope
e -> forall a b. b -> Either a b
Right TextEnvelope
e })
  forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
C.deserialiseFromTextEnvelope (forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(PlutusScript PlutusScriptV2)) TextEnvelope
textEnvelope forall a b. a -> (a -> b) -> b
& forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show

txFromCbor :: String -> Either String (Tx BabbageEra)
txFromCbor :: String -> Either String (Tx BabbageEra)
txFromCbor String
cbor = do
  let vl :: Value
vl = [Pair] -> Value
object [Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
s String
"Tx BabbageEra", Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
s String
"", Key
"cborHex" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
cbor]
  TextEnvelope
textEnvelope <- forall a. FromJSON a => Value -> Result a
fromJSON Value
vl forall a b. a -> (a -> b) -> b
& (\case { Error String
err -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show String
err); Success TextEnvelope
e -> forall a b. b -> Either a b
Right TextEnvelope
e })
  forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
C.deserialiseFromTextEnvelope (forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(Tx BabbageEra)) TextEnvelope
textEnvelope forall a b. a -> (a -> b) -> b
& forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show

unsafeScriptFromCbor :: String -> PlutusScript PlutusScriptV2
unsafeScriptFromCbor :: String -> PlutusScript PlutusScriptV2
unsafeScriptFromCbor = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (PlutusScript PlutusScriptV2)
scriptFromCbor

unsafeTxFromCbor :: String -> Tx BabbageEra
unsafeTxFromCbor :: String -> Tx BabbageEra
unsafeTxFromCbor = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Tx BabbageEra)
txFromCbor

{-| Script address without staking key
-}
scriptAddress :: NetworkId -> PlutusScript PlutusScriptV2 -> C.AddressInEra C.BabbageEra
scriptAddress :: NetworkId -> PlutusScript PlutusScriptV2 -> AddressInEra BabbageEra
scriptAddress NetworkId
network PlutusScript PlutusScriptV2
script =
  let hash :: ScriptHash
hash = forall lang. Script lang -> ScriptHash
C.hashScript (forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2 PlutusScript PlutusScriptV2
script)
  in forall era.
IsShelleyBasedEra era =>
NetworkId
-> PaymentCredential -> StakeAddressReference -> AddressInEra era
C.makeShelleyAddressInEra NetworkId
network (ScriptHash -> PaymentCredential
C.PaymentCredentialByScript ScriptHash
hash) StakeAddressReference
C.NoStakeAddress

s :: String -> String
s :: String -> String
s = forall a. a -> a
id

{-| Search for interesting transactions in a block and serialise them to JSON files
-}
extractTx :: forall m. MonadIO m => Set C.TxId -> BlockInMode CardanoMode -> m ()
extractTx :: forall (m :: * -> *).
MonadIO m =>
Set TxId -> BlockInMode CardanoMode -> m ()
extractTx Set TxId
txIds =
  let extractTx' :: C.Tx C.BabbageEra -> m ()
      extractTx' :: Tx BabbageEra -> m ()
extractTx' tx :: Tx BabbageEra
tx@(C.Tx TxBody BabbageEra
txBody [KeyWitness BabbageEra]
_) = do
        let txi :: TxId
txi = forall era. TxBody era -> TxId
C.getTxId TxBody BabbageEra
txBody
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TxId
txi forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TxId
txIds) forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
C.writeFileTextEnvelope (forall content (direction :: FileDirection).
String -> File content direction
C.File forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TxId
txi forall a. Semigroup a => a -> a -> a
<> String
".json") forall a. Maybe a
Nothing Tx BabbageEra
tx
  in \case
    BlockInMode (Block BlockHeader
_ [Tx era]
txns) EraInMode era CardanoMode
C.BabbageEraInCardanoMode ->
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Tx BabbageEra -> m ()
extractTx' [Tx era]
txns
    BlockInMode CardanoMode
_                                                    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-| The UTxOs produced by the transaction
-}
txnUtxos :: Tx era -> [(TxIn, C.TxOut C.CtxTx era)]
txnUtxos :: forall era. Tx era -> [(TxIn, TxOut CtxTx era)]
txnUtxos Tx era
tx =
  let C.TxBody C.TxBodyContent{[TxOut CtxTx era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts :: [TxOut CtxTx era]
C.txOuts} = forall era. Tx era -> TxBody era
C.getTxBody Tx era
tx
      txi :: TxId
txi  = forall era. TxBody era -> TxId
C.getTxId (forall era. Tx era -> TxBody era
C.getTxBody Tx era
tx)
  in forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut CtxTx era]
txOuts) (forall a b. [a] -> [b] -> [(a, b)]
zip (TxId -> TxIx -> TxIn
C.TxIn TxId
txi forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> TxIx
C.TxIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word
0..]) [TxOut CtxTx era]
txOuts)

{-| Convert a slot number to UTC time
-}
slotToUtcTime :: C.EraHistory mode -> C.SystemStart -> SlotNo -> Either String UTCTime
slotToUtcTime :: forall mode.
EraHistory mode -> SystemStart -> SlotNo -> Either String UTCTime
slotToUtcTime (forall mode. EraHistory mode -> EpochInfo (Either String)
toLedgerEpochInfo -> EpochInfo (Either String)
info) SystemStart
systemStart SlotNo
slot = forall (m :: * -> *).
(HasCallStack, Monad m) =>
EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime EpochInfo (Either String)
info SystemStart
systemStart SlotNo
slot

{-| Convert a UTC time to slot no. Returns the time spent and time left in this slot.
-}
utcTimeToSlot :: C.EraHistory mode -> C.SystemStart -> UTCTime -> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
utcTimeToSlot :: forall mode.
EraHistory mode
-> SystemStart
-> UTCTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
utcTimeToSlot (C.EraHistory ConsensusMode mode
_ Interpreter xs
interpreter) SystemStart
systemStart UTCTime
t = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
  forall (xs :: [*]) a.
HasCallStack =>
Interpreter xs -> Qry a -> Either PastHorizonException a
Qry.interpretQuery Interpreter xs
interpreter (RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
Qry.wallclockToSlot (SystemStart -> UTCTime -> RelativeTime
Time.toRelativeTime SystemStart
systemStart UTCTime
t))

utcTimeToPosixTime :: UTCTime -> PV1.POSIXTime
utcTimeToPosixTime :: UTCTime -> POSIXTime
utcTimeToPosixTime =  NominalDiffTime -> POSIXTime
transPOSIXTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds

{-| Convert a 'PV1.POSIXTime' to slot no. Returns the time spent and time left in this slot.
-}
posixTimeToSlot :: C.EraHistory mode -> C.SystemStart -> PV1.POSIXTime -> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
posixTimeToSlot :: forall mode.
EraHistory mode
-> SystemStart
-> POSIXTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
posixTimeToSlot EraHistory mode
eraHistory SystemStart
systemStart (NominalDiffTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> NominalDiffTime
unTransPOSIXTime -> UTCTime
utcTime) =
  forall mode.
EraHistory mode
-> SystemStart
-> UTCTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
utcTimeToSlot EraHistory mode
eraHistory SystemStart
systemStart UTCTime
utcTime

{-| Convert a UTC time to slot no. Returns the time spent and time left in this slot.
Extends the interpreter range to infinity before running the query, ignoring
any future hard forks. This avoids horizon errors for times that are in the future.
It may still fail for times that are in the past (before the beginning of the horizin)
-}
utcTimeToSlotUnsafe :: C.EraHistory mode -> C.SystemStart -> UTCTime -> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
utcTimeToSlotUnsafe :: forall mode.
EraHistory mode
-> SystemStart
-> UTCTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
utcTimeToSlotUnsafe (C.EraHistory ConsensusMode mode
_ Interpreter xs
interpreter) SystemStart
systemStart UTCTime
t = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
  forall (xs :: [*]) a.
HasCallStack =>
Interpreter xs -> Qry a -> Either PastHorizonException a
Qry.interpretQuery (forall (xs :: [*]). Interpreter xs -> Interpreter xs
Qry.unsafeExtendSafeZone Interpreter xs
interpreter) (RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
Qry.wallclockToSlot (SystemStart -> UTCTime -> RelativeTime
Time.toRelativeTime SystemStart
systemStart UTCTime
t))

{-| Convert a 'PV1.POSIXTime' to slot no. Returns the time spent and time left in this slot.
-}
posixTimeToSlotUnsafe :: C.EraHistory mode -> C.SystemStart -> PV1.POSIXTime -> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
posixTimeToSlotUnsafe :: forall mode.
EraHistory mode
-> SystemStart
-> POSIXTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
posixTimeToSlotUnsafe EraHistory mode
eraHistory SystemStart
systemStart (NominalDiffTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> NominalDiffTime
unTransPOSIXTime -> UTCTime
utcTime) =
  forall mode.
EraHistory mode
-> SystemStart
-> UTCTime
-> Either String (SlotNo, NominalDiffTime, NominalDiffTime)
utcTimeToSlotUnsafe EraHistory mode
eraHistory SystemStart
systemStart UTCTime
utcTime

-- FIXME: Looks like this function is exposed by Cardano.Api in cardano-node@v1.36
toLedgerEpochInfo :: C.EraHistory mode -> EpochInfo (Either String)
toLedgerEpochInfo :: forall mode. EraHistory mode -> EpochInfo (Either String)
toLedgerEpochInfo (C.EraHistory ConsensusMode mode
_ Interpreter xs
interpreter) =
  forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Except e a -> Either e a
runExcept) forall a b. (a -> b) -> a -> b
$
    forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
Consensus.interpreterToEpochInfo Interpreter xs
interpreter

liftResult :: (MonadError e m) => (String -> e) -> ResultT m a -> m a
liftResult :: forall e (m :: * -> *) a.
MonadError e m =>
(String -> e) -> ResultT m a -> m a
liftResult String -> e
f ResultT m a
action = forall (m :: * -> *) a. Functor m => ResultT m a -> m (Result a)
Result.runResultT ResultT m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> e
f) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Result a -> Either String a
Result.toEither

liftEither :: (MonadError e m) => (ee -> e) -> m (Either ee a) -> m a
liftEither :: forall e (m :: * -> *) ee a.
MonadError e m =>
(ee -> e) -> m (Either ee a) -> m a
liftEither ee -> e
f m (Either ee a)
action = m (Either ee a)
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ee -> e
f) forall (f :: * -> *) a. Applicative f => a -> f a
pure

mapError :: (MonadError e m) => (ee -> e) -> ExceptT ee m a -> m a
mapError :: forall e (m :: * -> *) ee a.
MonadError e m =>
(ee -> e) -> ExceptT ee m a -> m a
mapError ee -> e
f ExceptT ee m a
action = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT ee m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ee -> e
f) forall (f :: * -> *) a. Applicative f => a -> f a
pure

failOnLeft :: MonadIO m => (e -> String) -> Either e a -> m a
failOnLeft :: forall (m :: * -> *) e a.
MonadIO m =>
(e -> String) -> Either e a -> m a
failOnLeft e -> String
f = \case
  Left e
err -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn (e -> String
f e
err)
    forall a. IO a
exitFailure
  Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

failOnLeftLog :: (MonadLog m, MonadIO m) => (e -> String) -> Either e a -> m a
failOnLeftLog :: forall (m :: * -> *) e a.
(MonadLog m, MonadIO m) =>
(e -> String) -> Either e a -> m a
failOnLeftLog e -> String
f = \case
  Left e
err -> do
    forall (m :: * -> *). MonadLog m => String -> m ()
logWarnS (e -> String
f e
err)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
exitFailure
  Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

{-| Read a serialised signing key from a file
-}
readSigningKeyFromFile :: FilePath -> IO (C.SigningKey C.PaymentKey)
readSigningKeyFromFile :: String -> IO (SigningKey PaymentKey)
readSigningKeyFromFile = forall key.
(SerialiseAsBech32 key, HasTextEnvelope key) =>
Proxy key -> String -> IO key
readKeyFromFile forall {k} (t :: k). Proxy t
Proxy

{-| Read a serialised verification key from a file. Try bech32 encoding first, then text envelope (JSON)
-}
readVerificationKeyFromFile :: FilePath -> IO (C.VerificationKey C.PaymentKey)
readVerificationKeyFromFile :: String -> IO (VerificationKey PaymentKey)
readVerificationKeyFromFile = forall key.
(SerialiseAsBech32 key, HasTextEnvelope key) =>
Proxy key -> String -> IO key
readKeyFromFile forall {k} (t :: k). Proxy t
Proxy

{-| Read a serialised signing key from a file
-}
readStakingKeyFromFile :: FilePath -> IO (C.VerificationKey C.StakeKey)
readStakingKeyFromFile :: String -> IO (VerificationKey StakeKey)
readStakingKeyFromFile = forall key.
(SerialiseAsBech32 key, HasTextEnvelope key) =>
Proxy key -> String -> IO key
readKeyFromFile forall {k} (t :: k). Proxy t
Proxy

{-| Read a serialised key from a file. Try bech32 encoding first, then text envelope (JSON)
-}
readKeyFromFile :: (C.SerialiseAsBech32 key, C.HasTextEnvelope key) => Proxy key -> FilePath -> IO key
readKeyFromFile :: forall key.
(SerialiseAsBech32 key, HasTextEnvelope key) =>
Proxy key -> String -> IO key
readKeyFromFile Proxy key
p String
source = do
  Text
txt <- String -> IO Text
Text.readFile String
source
  case forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
C.deserialiseFromBech32 (forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType Proxy key
p) Text
txt of
    Left Bech32DecodeError
err1 -> forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
C.readFileTextEnvelope (forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType Proxy key
p) (forall content (direction :: FileDirection).
String -> File content direction
C.File String
source) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left FileError TextEnvelopeError
err2 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"readKeyFromFile: Failed to read " forall a. Semigroup a => a -> a -> a
<> String
source forall a. Semigroup a => a -> a -> a
<> String
". Errors: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Bech32DecodeError
err1 forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show FileError TextEnvelopeError
err2)
      Right key
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure key
k
    Right key
k  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure key
k

toShelleyPaymentCredential :: PaymentCredential -> Shelley.PaymentCredential StandardCrypto
toShelleyPaymentCredential :: PaymentCredential -> PaymentCredential StandardCrypto
toShelleyPaymentCredential (PaymentCredentialByKey (C.PaymentKeyHash KeyHash 'Payment StandardCrypto
kh)) =
    forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
Shelley.KeyHashObj KeyHash 'Payment StandardCrypto
kh
toShelleyPaymentCredential (PaymentCredentialByScript ScriptHash
sh) =
    forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
Shelley.ScriptHashObj (ScriptHash -> ScriptHash StandardCrypto
C.toShelleyScriptHash ScriptHash
sh)