{-# LANGUAGE AllowAmbiguousTypes #-}

module Hydra.Chain.Direct.Util where

import Hydra.Prelude

import Cardano.Crypto.DSIGN qualified as Crypto
import Cardano.Ledger.Crypto (DSIGN)
import Hydra.Cardano.Api hiding (Block, SigningKey, VerificationKey)
import Hydra.Cardano.Api qualified as Shelley
import Ouroboros.Consensus.Cardano (CardanoBlock)

type Block = CardanoBlock StandardCrypto
type VerificationKey = Crypto.VerKeyDSIGN (DSIGN StandardCrypto)
type SigningKey = Crypto.SignKeyDSIGN (DSIGN StandardCrypto)

readKeyPair :: FilePath -> IO (Shelley.VerificationKey PaymentKey, Shelley.SigningKey PaymentKey)
readKeyPair :: FilePath -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
readKeyPair FilePath
keyPath = do
  SigningKey PaymentKey
sk <- AsType (SigningKey PaymentKey)
-> FilePath -> IO (SigningKey PaymentKey)
forall a. HasTextEnvelope a => AsType a -> FilePath -> IO a
readFileTextEnvelopeThrow (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey) FilePath
keyPath
  (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
sk, SigningKey PaymentKey
sk)

-- XXX: Should accept a 'File' path
readFileTextEnvelopeThrow ::
  HasTextEnvelope a =>
  AsType a ->
  FilePath ->
  IO a
readFileTextEnvelopeThrow :: forall a. HasTextEnvelope a => AsType a -> FilePath -> IO a
readFileTextEnvelopeThrow AsType a
asType FilePath
fileContents =
  (FileError TextEnvelopeError -> IO a)
-> (a -> IO a) -> Either (FileError TextEnvelopeError) a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO a
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO a)
-> (FileError TextEnvelopeError -> FilePath)
-> FileError TextEnvelopeError
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> FilePath
forall b a. (Show a, IsString b) => a -> b
show) a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (FileError TextEnvelopeError) a -> IO a)
-> IO (Either (FileError TextEnvelopeError) a) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AsType a
-> File Any 'In -> IO (Either (FileError TextEnvelopeError) a)
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType a
asType (FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
fileContents)

readVerificationKey :: FilePath -> IO (Shelley.VerificationKey PaymentKey)
readVerificationKey :: FilePath -> IO (VerificationKey PaymentKey)
readVerificationKey = AsType (VerificationKey PaymentKey)
-> FilePath -> IO (VerificationKey PaymentKey)
forall a. HasTextEnvelope a => AsType a -> FilePath -> IO a
readFileTextEnvelopeThrow (AsType PaymentKey -> AsType (VerificationKey PaymentKey)
forall a. AsType a -> AsType (VerificationKey a)
Shelley.AsVerificationKey AsType PaymentKey
Shelley.AsPaymentKey)

-- | A simple retrying function with a constant delay. Retries only if the given
-- predicate evaluates to 'True'.
--
-- Better coupled with a 'timeout' function.
retry ::
  forall e m a.
  (MonadCatch m, MonadDelay m, Exception e) =>
  (e -> Bool) ->
  m a ->
  m a
retry :: forall e (m :: * -> *) a.
(MonadCatch m, MonadDelay m, Exception e) =>
(e -> Bool) -> m a -> m a
retry e -> Bool
predicate m a
action =
  (e -> Bool) -> m a -> (e -> m a) -> m a
forall {m :: * -> *} {e} {a}.
(MonadCatch m, Exception e) =>
(e -> Bool) -> m a -> (e -> m a) -> m a
catchIf e -> Bool
predicate m a
action ((e -> m a) -> m a) -> (e -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \e
_ ->
    DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.5 m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (e -> Bool) -> m a -> m a
forall e (m :: * -> *) a.
(MonadCatch m, MonadDelay m, Exception e) =>
(e -> Bool) -> m a -> m a
retry e -> Bool
predicate m a
action
 where
  catchIf :: (e -> Bool) -> m a -> (e -> m a) -> m a
catchIf e -> Bool
f m a
a e -> m a
b = m a
a m a -> (e -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> if e -> Bool
f e
e then e -> m a
b e
e else e -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO e
e