module HaskellWorks.Polysemy.Amazonka.LocalStack
( runReaderLocalAwsEnvDiscover,
getLocalStackEndpoint,
inspectContainer,
) where
import qualified Amazonka as AWS
import qualified Amazonka.Auth as AWS
import Control.Lens ((%~), (.~))
import qualified Data.Aeson as J
import Data.Generics.Product.Any
import HaskellWorks.Prelude
import HaskellWorks.TestContainers.LocalStack
import qualified HaskellWorks.TestContainers.LocalStack.Types as Z
import Polysemy
import Polysemy.Reader
import qualified System.IO as IO
import qualified TestContainers.Monad as TC
import qualified TestContainers.Tasty as TC
runReaderLocalAwsEnvDiscover :: forall a r. ()
=> Member (Embed IO) r
=> IO TC.Container
-> Sem (Reader AWS.Env : r) a
-> Sem r a
runReaderLocalAwsEnvDiscover :: forall a (r :: EffectRow).
Member (Embed IO) r =>
IO Container -> Sem (Reader Env : r) a -> Sem r a
runReaderLocalAwsEnvDiscover IO Container
mk Sem (Reader Env : r) a
f = do
Container
container <- IO Container -> Sem r Container
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO Container
mk
LocalStackEndpoint
ep <- Container -> Sem r LocalStackEndpoint
forall (r :: EffectRow). Container -> Sem r LocalStackEndpoint
getLocalStackEndpoint Container
container
LogLevel -> ByteStringBuilder -> IO ()
logger' <- IO (LogLevel -> ByteStringBuilder -> IO ())
-> Sem r (LogLevel -> ByteStringBuilder -> IO ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (LogLevel -> ByteStringBuilder -> IO ())
-> Sem r (LogLevel -> ByteStringBuilder -> IO ()))
-> IO (LogLevel -> ByteStringBuilder -> IO ())
-> Sem r (LogLevel -> ByteStringBuilder -> IO ())
forall a b. (a -> b) -> a -> b
$ LogLevel -> Handle -> IO (LogLevel -> ByteStringBuilder -> IO ())
forall (m :: * -> *).
MonadIO m =>
LogLevel -> Handle -> m (LogLevel -> ByteStringBuilder -> IO ())
AWS.newLogger LogLevel
AWS.Debug Handle
IO.stdout
let creds :: Env' withAuth -> Env
creds = AccessKey -> SecretKey -> Env' withAuth -> Env
forall (withAuth :: * -> *).
AccessKey -> SecretKey -> Env' withAuth -> Env
AWS.fromKeys (ByteString -> AccessKey
AWS.AccessKey ByteString
"test") (ByteString -> SecretKey
AWS.SecretKey ByteString
"test")
Env
credEnv <- IO Env -> Sem r Env
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Env -> Sem r Env) -> IO Env -> Sem r Env
forall a b. (a -> b) -> a -> b
$ (EnvNoAuth -> IO Env) -> IO Env
forall (m :: * -> *). MonadIO m => (EnvNoAuth -> m Env) -> m Env
AWS.newEnv ([EnvNoAuth -> IO Env] -> EnvNoAuth -> IO Env
forall (m :: * -> *) a b. MonadCatch m => [a -> m b] -> a -> m b
AWS.runCredentialChain [Env -> IO Env
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> IO Env) -> (EnvNoAuth -> Env) -> EnvNoAuth -> IO Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvNoAuth -> Env
forall {withAuth :: * -> *}. Env' withAuth -> Env
creds])
Env
awsEnv <- Env -> Sem r Env
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> Sem r Env) -> Env -> Sem r Env
forall a b. (a -> b) -> a -> b
$
Env
credEnv
Env -> (Env -> Env) -> Env
forall a b. a -> (a -> b) -> b
& forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"logger" (((LogLevel -> ByteStringBuilder -> IO ())
-> Identity (LogLevel -> ByteStringBuilder -> IO ()))
-> Env -> Identity Env)
-> (LogLevel -> ByteStringBuilder -> IO ()) -> Env -> Env
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel -> ByteStringBuilder -> IO ()
logger'
Env -> (Env -> Env) -> Env
forall a b. a -> (a -> b) -> b
& forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"overrides" (((Service -> Service) -> Identity (Service -> Service))
-> Env -> Identity Env)
-> ((Service -> Service) -> Service -> Service) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Service -> Service) -> (Service -> Service) -> Service -> Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> Int -> Service -> Service
AWS.setEndpoint Bool
False ByteString
"localhost" LocalStackEndpoint
ep.port)
Env -> Sem (Reader Env : r) a -> Sem r a
forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader Env
awsEnv Sem (Reader Env : r) a
f
getLocalStackEndpoint :: ()
=> TC.Container
-> Sem r LocalStackEndpoint
getLocalStackEndpoint :: forall (r :: EffectRow). Container -> Sem r LocalStackEndpoint
getLocalStackEndpoint Container
container = do
let localStackPort :: Int
localStackPort = Container -> Port -> Int
TC.containerPort Container
container Port
4566
LocalStackEndpoint -> Sem r LocalStackEndpoint
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Z.LocalStackEndpoint
{ $sel:host:LocalStackEndpoint :: String
Z.host = String
"0.0.0.0"
, $sel:port:LocalStackEndpoint :: Int
Z.port = Int
localStackPort
}
inspectContainer :: ()
=> Member (Embed IO) r
=> TC.Container
-> Sem r J.Value
inspectContainer :: forall (r :: EffectRow).
Member (Embed IO) r =>
Container -> Sem r Value
inspectContainer Container
container =
IO Value -> Sem r Value
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Value -> Sem r Value) -> IO Value -> Sem r Value
forall a b. (a -> b) -> a -> b
$ Config -> TestContainer Value -> IO Value
forall a. Config -> TestContainer a -> IO a
TC.runTestContainer Config
TC.defaultDockerConfig (TestContainer Value -> IO Value)
-> TestContainer Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Container -> TestContainer Value
TC.inspect Container
container