{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} module LndClient.TestApp ( withEnv, Owner (..), proxyOwner, ) where import LndClient.Data.LndEnv import LndClient.Import import LndClient.LndTest import qualified Network.Bitcoin as BTC (Client) import Network.GRPC.Client.Helpers (Address (..), GrpcClientConfig (..)) data Env = Env { Env -> TestEnv envAlice :: TestEnv, Env -> TestEnv envBob :: TestEnv, Env -> Client envBtc :: BTC.Client, Env -> Namespace envKatipNS :: Namespace, Env -> LogContexts envKatipCTX :: LogContexts, Env -> LogEnv envKatipLE :: LogEnv } data Owner = Alice | Bob deriving stock ( Owner -> Owner -> Bool (Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> Eq Owner forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Owner -> Owner -> Bool $c/= :: Owner -> Owner -> Bool == :: Owner -> Owner -> Bool $c== :: Owner -> Owner -> Bool Eq, Eq Owner Eq Owner -> (Owner -> Owner -> Ordering) -> (Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> (Owner -> Owner -> Owner) -> (Owner -> Owner -> Owner) -> Ord Owner Owner -> Owner -> Bool Owner -> Owner -> Ordering Owner -> Owner -> Owner forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Owner -> Owner -> Owner $cmin :: Owner -> Owner -> Owner max :: Owner -> Owner -> Owner $cmax :: Owner -> Owner -> Owner >= :: Owner -> Owner -> Bool $c>= :: Owner -> Owner -> Bool > :: Owner -> Owner -> Bool $c> :: Owner -> Owner -> Bool <= :: Owner -> Owner -> Bool $c<= :: Owner -> Owner -> Bool < :: Owner -> Owner -> Bool $c< :: Owner -> Owner -> Bool compare :: Owner -> Owner -> Ordering $ccompare :: Owner -> Owner -> Ordering Ord, Int -> Owner -> ShowS [Owner] -> ShowS Owner -> String (Int -> Owner -> ShowS) -> (Owner -> String) -> ([Owner] -> ShowS) -> Show Owner forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Owner] -> ShowS $cshowList :: [Owner] -> ShowS show :: Owner -> String $cshow :: Owner -> String showsPrec :: Int -> Owner -> ShowS $cshowsPrec :: Int -> Owner -> ShowS Show, Owner Owner -> Owner -> Bounded Owner forall a. a -> a -> Bounded a maxBound :: Owner $cmaxBound :: Owner minBound :: Owner $cminBound :: Owner Bounded, Int -> Owner Owner -> Int Owner -> [Owner] Owner -> Owner Owner -> Owner -> [Owner] Owner -> Owner -> Owner -> [Owner] (Owner -> Owner) -> (Owner -> Owner) -> (Int -> Owner) -> (Owner -> Int) -> (Owner -> [Owner]) -> (Owner -> Owner -> [Owner]) -> (Owner -> Owner -> [Owner]) -> (Owner -> Owner -> Owner -> [Owner]) -> Enum Owner forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a enumFromThenTo :: Owner -> Owner -> Owner -> [Owner] $cenumFromThenTo :: Owner -> Owner -> Owner -> [Owner] enumFromTo :: Owner -> Owner -> [Owner] $cenumFromTo :: Owner -> Owner -> [Owner] enumFromThen :: Owner -> Owner -> [Owner] $cenumFromThen :: Owner -> Owner -> [Owner] enumFrom :: Owner -> [Owner] $cenumFrom :: Owner -> [Owner] fromEnum :: Owner -> Int $cfromEnum :: Owner -> Int toEnum :: Int -> Owner $ctoEnum :: Int -> Owner pred :: Owner -> Owner $cpred :: Owner -> Owner succ :: Owner -> Owner $csucc :: Owner -> Owner Enum, (forall x. Owner -> Rep Owner x) -> (forall x. Rep Owner x -> Owner) -> Generic Owner forall x. Rep Owner x -> Owner forall x. Owner -> Rep Owner x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Owner x -> Owner $cfrom :: forall x. Owner -> Rep Owner x Generic ) instance Out Owner proxyOwner :: Proxy Owner proxyOwner :: Proxy Owner proxyOwner = Proxy Owner forall {k} (t :: k). Proxy t Proxy newBobEnv :: LndEnv -> LndEnv newBobEnv :: LndEnv -> LndEnv newBobEnv LndEnv env = LndEnv env { envLndConfig :: GrpcClientConfig envLndConfig = GrpcClientConfig lnd { _grpcClientConfigAddress :: Address _grpcClientConfigAddress = case GrpcClientConfig -> Address _grpcClientConfigAddress GrpcClientConfig lnd of AddressTCP String host PortNumber _ -> String -> PortNumber -> Address AddressTCP String host PortNumber 11009 Address x -> Address x }, envLndCipherSeedMnemonic :: Maybe CipherSeedMnemonic envLndCipherSeedMnemonic = CipherSeedMnemonic -> Maybe CipherSeedMnemonic forall a. a -> Maybe a Just (CipherSeedMnemonic -> Maybe CipherSeedMnemonic) -> CipherSeedMnemonic -> Maybe CipherSeedMnemonic forall a b. (a -> b) -> a -> b $ [Text] -> CipherSeedMnemonic CipherSeedMnemonic [ Text "absent", Text "betray", Text "direct", Text "scheme", Text "sunset", Text "mechanic", Text "exhaust", Text "suggest", Text "boy", Text "arena", Text "sketch", Text "bone", Text "news", Text "south", Text "way", Text "survey", Text "clip", Text "dutch", Text "depart", Text "green", Text "furnace", Text "wire", Text "wave", Text "fall" ], envLndAezeedPassphrase :: Maybe AezeedPassphrase envLndAezeedPassphrase = Maybe AezeedPassphrase forall a. Maybe a Nothing } where lnd :: GrpcClientConfig lnd = LndEnv -> GrpcClientConfig envLndConfig LndEnv env withEnv :: AppM IO () -> IO () withEnv :: AppM IO () -> IO () withEnv AppM IO () action = do Client bc <- BtcEnv -> IO Client forall (m :: * -> *). MonadIO m => BtcEnv -> m Client newBtcClient BtcEnv btcEnv LndEnv aliceLndEnv <- IO LndEnv -> IO LndEnv forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO LndEnv readLndEnv Scribe handleScribe <- (forall a. LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe mkHandleScribeWithFormatter forall a. LogItem a => ItemFormatter a bracketFormat ColorStrategy ColorIfTerminal Handle stdout ( Severity -> Item a -> IO Bool forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool permitItem (Severity -> Item a -> IO Bool) -> (Maybe Severity -> Severity) -> Maybe Severity -> Item a -> IO Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Severity -> Maybe Severity -> Severity forall a. a -> Maybe a -> a fromMaybe Severity DebugS (Maybe Severity -> Item a -> IO Bool) -> Maybe Severity -> Item a -> IO Bool forall a b. (a -> b) -> a -> b $ LndEnv -> Maybe Severity envLndLogSeverity LndEnv aliceLndEnv ) Verbosity V2 let newLogEnv :: IO LogEnv newLogEnv = Text -> Scribe -> ScribeSettings -> LogEnv -> IO LogEnv registerScribe Text "stdout" Scribe handleScribe ScribeSettings defaultScribeSettings (LogEnv -> IO LogEnv) -> IO LogEnv -> IO LogEnv forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Namespace -> Environment -> IO LogEnv initLogEnv Namespace "LndClient" Environment "test" IO LogEnv -> (LogEnv -> IO ()) -> (LogEnv -> IO ()) -> IO () forall (m :: * -> *) a b c. MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c bracket IO LogEnv newLogEnv LogEnv -> IO () rmLogEnv ((LogEnv -> IO ()) -> IO ()) -> (LogEnv -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \LogEnv le -> LogEnv -> LogContexts -> Namespace -> KatipContextT IO () -> IO () forall c (m :: * -> *) a. LogItem c => LogEnv -> c -> Namespace -> KatipContextT m a -> m a runKatipContextT LogEnv le (LogContexts forall a. Monoid a => a mempty :: LogContexts) Namespace forall a. Monoid a => a mempty (KatipContextT IO () -> IO ()) -> KatipContextT IO () -> IO () forall a b. (a -> b) -> a -> b $ do LndEnv -> NodeLocation -> (TestEnv -> KatipContextT IO ()) -> KatipContextT IO () forall (m :: * -> *) a. MonadUnliftIO m => LndEnv -> NodeLocation -> (TestEnv -> KatipContextT m a) -> KatipContextT m a withTestEnv LndEnv aliceLndEnv (Text -> NodeLocation NodeLocation Text "localhost:9735") ((TestEnv -> KatipContextT IO ()) -> KatipContextT IO ()) -> (TestEnv -> KatipContextT IO ()) -> KatipContextT IO () forall a b. (a -> b) -> a -> b $ \TestEnv alice -> LndEnv -> NodeLocation -> (TestEnv -> KatipContextT IO ()) -> KatipContextT IO () forall (m :: * -> *) a. MonadUnliftIO m => LndEnv -> NodeLocation -> (TestEnv -> KatipContextT m a) -> KatipContextT m a withTestEnv (LndEnv -> LndEnv newBobEnv LndEnv aliceLndEnv) (Text -> NodeLocation NodeLocation Text "localhost:9734") ((TestEnv -> KatipContextT IO ()) -> KatipContextT IO ()) -> (TestEnv -> KatipContextT IO ()) -> KatipContextT IO () forall a b. (a -> b) -> a -> b $ \TestEnv bob -> IO () -> KatipContextT IO () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> KatipContextT IO ()) -> IO () -> KatipContextT IO () forall a b. (a -> b) -> a -> b $ Env -> AppM IO () -> IO () forall (m :: * -> *) a. Env -> AppM m a -> m a runApp Env :: TestEnv -> TestEnv -> Client -> Namespace -> LogContexts -> LogEnv -> Env Env { $sel:envAlice:Env :: TestEnv envAlice = TestEnv alice, $sel:envBob:Env :: TestEnv envBob = TestEnv bob, $sel:envBtc:Env :: Client envBtc = Client bc, $sel:envKatipLE:Env :: LogEnv envKatipLE = LogEnv le, $sel:envKatipCTX:Env :: LogContexts envKatipCTX = LogContexts forall a. Monoid a => a mempty, $sel:envKatipNS:Env :: Namespace envKatipNS = Namespace forall a. Monoid a => a mempty } (AppM IO () -> IO ()) -> AppM IO () -> IO () forall a b. (a -> b) -> a -> b $ do Proxy Owner -> AppM IO () forall (m :: * -> *) owner. LndTest m owner => Proxy owner -> m () setupZeroChannels Proxy Owner proxyOwner AppM IO () action where rmLogEnv :: LogEnv -> IO () rmLogEnv :: LogEnv -> IO () rmLogEnv = IO LogEnv -> IO () forall (f :: * -> *) a. Functor f => f a -> f () void (IO LogEnv -> IO ()) -> (LogEnv -> IO LogEnv) -> LogEnv -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . IO LogEnv -> IO LogEnv forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO LogEnv -> IO LogEnv) -> (LogEnv -> IO LogEnv) -> LogEnv -> IO LogEnv forall b c a. (b -> c) -> (a -> b) -> a -> c . LogEnv -> IO LogEnv closeScribes btcEnv :: BtcEnv btcEnv :: BtcEnv btcEnv = BtcEnv :: BtcUrl -> BtcLogin -> BtcPassword -> BtcEnv BtcEnv { btcUrl :: BtcUrl btcUrl = String -> BtcUrl BtcUrl String "http://localhost:18443", btcLogin :: BtcLogin btcLogin = ByteString -> BtcLogin BtcLogin ByteString "developer", btcPassword :: BtcPassword btcPassword = ByteString -> BtcPassword BtcPassword ByteString "developer" } newtype AppM m a = AppM { forall (m :: * -> *) a. AppM m a -> ReaderT Env m a unAppM :: ReaderT Env m a } deriving stock ((forall a b. (a -> b) -> AppM m a -> AppM m b) -> (forall a b. a -> AppM m b -> AppM m a) -> Functor (AppM m) forall a b. a -> AppM m b -> AppM m a forall a b. (a -> b) -> AppM m a -> AppM m b forall (m :: * -> *) a b. Functor m => a -> AppM m b -> AppM m a forall (m :: * -> *) a b. Functor m => (a -> b) -> AppM m a -> AppM m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> AppM m b -> AppM m a $c<$ :: forall (m :: * -> *) a b. Functor m => a -> AppM m b -> AppM m a fmap :: forall a b. (a -> b) -> AppM m a -> AppM m b $cfmap :: forall (m :: * -> *) a b. Functor m => (a -> b) -> AppM m a -> AppM m b Functor) deriving newtype (Functor (AppM m) Functor (AppM m) -> (forall a. a -> AppM m a) -> (forall a b. AppM m (a -> b) -> AppM m a -> AppM m b) -> (forall a b c. (a -> b -> c) -> AppM m a -> AppM m b -> AppM m c) -> (forall a b. AppM m a -> AppM m b -> AppM m b) -> (forall a b. AppM m a -> AppM m b -> AppM m a) -> Applicative (AppM m) forall a. a -> AppM m a forall a b. AppM m a -> AppM m b -> AppM m a forall a b. AppM m a -> AppM m b -> AppM m b forall a b. AppM m (a -> b) -> AppM m a -> AppM m b forall a b c. (a -> b -> c) -> AppM m a -> AppM m b -> AppM m c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f forall {m :: * -> *}. Applicative m => Functor (AppM m) forall (m :: * -> *) a. Applicative m => a -> AppM m a forall (m :: * -> *) a b. Applicative m => AppM m a -> AppM m b -> AppM m a forall (m :: * -> *) a b. Applicative m => AppM m a -> AppM m b -> AppM m b forall (m :: * -> *) a b. Applicative m => AppM m (a -> b) -> AppM m a -> AppM m b forall (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> AppM m a -> AppM m b -> AppM m c <* :: forall a b. AppM m a -> AppM m b -> AppM m a $c<* :: forall (m :: * -> *) a b. Applicative m => AppM m a -> AppM m b -> AppM m a *> :: forall a b. AppM m a -> AppM m b -> AppM m b $c*> :: forall (m :: * -> *) a b. Applicative m => AppM m a -> AppM m b -> AppM m b liftA2 :: forall a b c. (a -> b -> c) -> AppM m a -> AppM m b -> AppM m c $cliftA2 :: forall (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> AppM m a -> AppM m b -> AppM m c <*> :: forall a b. AppM m (a -> b) -> AppM m a -> AppM m b $c<*> :: forall (m :: * -> *) a b. Applicative m => AppM m (a -> b) -> AppM m a -> AppM m b pure :: forall a. a -> AppM m a $cpure :: forall (m :: * -> *) a. Applicative m => a -> AppM m a Applicative, Applicative (AppM m) Applicative (AppM m) -> (forall a b. AppM m a -> (a -> AppM m b) -> AppM m b) -> (forall a b. AppM m a -> AppM m b -> AppM m b) -> (forall a. a -> AppM m a) -> Monad (AppM m) forall a. a -> AppM m a forall a b. AppM m a -> AppM m b -> AppM m b forall a b. AppM m a -> (a -> AppM m b) -> AppM m b forall {m :: * -> *}. Monad m => Applicative (AppM m) forall (m :: * -> *) a. Monad m => a -> AppM m a forall (m :: * -> *) a b. Monad m => AppM m a -> AppM m b -> AppM m b forall (m :: * -> *) a b. Monad m => AppM m a -> (a -> AppM m b) -> AppM m b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: forall a. a -> AppM m a $creturn :: forall (m :: * -> *) a. Monad m => a -> AppM m a >> :: forall a b. AppM m a -> AppM m b -> AppM m b $c>> :: forall (m :: * -> *) a b. Monad m => AppM m a -> AppM m b -> AppM m b >>= :: forall a b. AppM m a -> (a -> AppM m b) -> AppM m b $c>>= :: forall (m :: * -> *) a b. Monad m => AppM m a -> (a -> AppM m b) -> AppM m b Monad, Monad (AppM m) Monad (AppM m) -> (forall a. IO a -> AppM m a) -> MonadIO (AppM m) forall a. IO a -> AppM m a forall (m :: * -> *). Monad m -> (forall a. IO a -> m a) -> MonadIO m forall {m :: * -> *}. MonadIO m => Monad (AppM m) forall (m :: * -> *) a. MonadIO m => IO a -> AppM m a liftIO :: forall a. IO a -> AppM m a $cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> AppM m a MonadIO, MonadReader Env, MonadIO (AppM m) MonadIO (AppM m) -> (forall b. ((forall a. AppM m a -> IO a) -> IO b) -> AppM m b) -> MonadUnliftIO (AppM m) forall b. ((forall a. AppM m a -> IO a) -> IO b) -> AppM m b forall (m :: * -> *). MonadIO m -> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b) -> MonadUnliftIO m forall {m :: * -> *}. MonadUnliftIO m => MonadIO (AppM m) forall (m :: * -> *) b. MonadUnliftIO m => ((forall a. AppM m a -> IO a) -> IO b) -> AppM m b withRunInIO :: forall b. ((forall a. AppM m a -> IO a) -> IO b) -> AppM m b $cwithRunInIO :: forall (m :: * -> *) b. MonadUnliftIO m => ((forall a. AppM m a -> IO a) -> IO b) -> AppM m b MonadUnliftIO) instance (MonadIO m) => Katip (AppM m) where getLogEnv :: AppM m LogEnv getLogEnv = (Env -> LogEnv) -> AppM m LogEnv forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Env -> LogEnv envKatipLE localLogEnv :: forall a. (LogEnv -> LogEnv) -> AppM m a -> AppM m a localLogEnv LogEnv -> LogEnv f (AppM ReaderT Env m a m) = ReaderT Env m a -> AppM m a forall (m :: * -> *) a. ReaderT Env m a -> AppM m a AppM ((Env -> Env) -> ReaderT Env m a -> ReaderT Env m a forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (\Env s -> Env s {$sel:envKatipLE:Env :: LogEnv envKatipLE = LogEnv -> LogEnv f (Env -> LogEnv envKatipLE Env s)}) ReaderT Env m a m) instance (MonadIO m) => KatipContext (AppM m) where getKatipContext :: AppM m LogContexts getKatipContext = (Env -> LogContexts) -> AppM m LogContexts forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Env -> LogContexts envKatipCTX localKatipContext :: forall a. (LogContexts -> LogContexts) -> AppM m a -> AppM m a localKatipContext LogContexts -> LogContexts f (AppM ReaderT Env m a m) = ReaderT Env m a -> AppM m a forall (m :: * -> *) a. ReaderT Env m a -> AppM m a AppM ((Env -> Env) -> ReaderT Env m a -> ReaderT Env m a forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (\Env s -> Env s {$sel:envKatipCTX:Env :: LogContexts envKatipCTX = LogContexts -> LogContexts f (Env -> LogContexts envKatipCTX Env s)}) ReaderT Env m a m) getKatipNamespace :: AppM m Namespace getKatipNamespace = (Env -> Namespace) -> AppM m Namespace forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Env -> Namespace envKatipNS localKatipNamespace :: forall a. (Namespace -> Namespace) -> AppM m a -> AppM m a localKatipNamespace Namespace -> Namespace f (AppM ReaderT Env m a m) = ReaderT Env m a -> AppM m a forall (m :: * -> *) a. ReaderT Env m a -> AppM m a AppM ((Env -> Env) -> ReaderT Env m a -> ReaderT Env m a forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (\Env s -> Env s {$sel:envKatipNS:Env :: Namespace envKatipNS = Namespace -> Namespace f (Env -> Namespace envKatipNS Env s)}) ReaderT Env m a m) instance (MonadUnliftIO m) => LndTest (AppM m) Owner where getBtcClient :: Owner -> AppM m Client getBtcClient = AppM m Client -> Owner -> AppM m Client forall a b. a -> b -> a const (AppM m Client -> Owner -> AppM m Client) -> AppM m Client -> Owner -> AppM m Client forall a b. (a -> b) -> a -> b $ (Env -> Client) -> AppM m Client forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Env -> Client envBtc getTestEnv :: Owner -> AppM m TestEnv getTestEnv = \case Owner Alice -> (Env -> TestEnv) -> AppM m TestEnv forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Env -> TestEnv envAlice Owner Bob -> (Env -> TestEnv) -> AppM m TestEnv forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Env -> TestEnv envBob runApp :: Env -> AppM m a -> m a runApp :: forall (m :: * -> *) a. Env -> AppM m a -> m a runApp Env env AppM m a app = ReaderT Env m a -> Env -> m a forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT (AppM m a -> ReaderT Env m a forall (m :: * -> *) a. AppM m a -> ReaderT Env m a unAppM AppM m a app) Env env