module Freckle.App.Ecs ( EcsMetadata(..) , EcsMetadataError(..) , EcsContainerMetadata(..) , EcsContainerTaskMetadata(..) , getEcsMetadata ) where import Freckle.App.Prelude import Control.Monad.Except (MonadError(..)) import Data.Aeson import Data.List.Extra (dropPrefix) import Freckle.App.Http import System.Environment (lookupEnv) import UnliftIO.Exception (Exception(..)) data EcsMetadata = EcsMetadata { EcsMetadata -> EcsContainerMetadata emContainerMetadata :: EcsContainerMetadata , EcsMetadata -> EcsContainerTaskMetadata emContainerTaskMetadata :: EcsContainerTaskMetadata } data EcsMetadataError = EcsMetadataErrorInvalidURI String | EcsMetadataErrorInvalidJSON HttpDecodeError deriving stock Int -> EcsMetadataError -> ShowS [EcsMetadataError] -> ShowS EcsMetadataError -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [EcsMetadataError] -> ShowS $cshowList :: [EcsMetadataError] -> ShowS show :: EcsMetadataError -> String $cshow :: EcsMetadataError -> String showsPrec :: Int -> EcsMetadataError -> ShowS $cshowsPrec :: Int -> EcsMetadataError -> ShowS Show data EcsContainerMetadata = EcsContainerMetadata { EcsContainerMetadata -> Text ecmDockerId :: Text , EcsContainerMetadata -> Text ecmDockerName :: Text , EcsContainerMetadata -> Text ecmImage :: Text , EcsContainerMetadata -> Text ecmImageID :: Text } deriving stock forall x. Rep EcsContainerMetadata x -> EcsContainerMetadata forall x. EcsContainerMetadata -> Rep EcsContainerMetadata x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep EcsContainerMetadata x -> EcsContainerMetadata $cfrom :: forall x. EcsContainerMetadata -> Rep EcsContainerMetadata x Generic instance FromJSON EcsContainerMetadata where parseJSON :: Value -> Parser EcsContainerMetadata parseJSON = forall a. (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a genericParseJSON forall a b. (a -> b) -> a -> b $ String -> Options aesonDropPrefix String "ecm" data EcsContainerTaskMetadata = EcsContainerTaskMetadata { EcsContainerTaskMetadata -> Text ectmCluster :: Text , EcsContainerTaskMetadata -> Text ectmTaskARN :: Text , EcsContainerTaskMetadata -> Text ectmFamily :: Text , EcsContainerTaskMetadata -> Text ectmRevision :: Text } deriving stock forall x. Rep EcsContainerTaskMetadata x -> EcsContainerTaskMetadata forall x. EcsContainerTaskMetadata -> Rep EcsContainerTaskMetadata x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep EcsContainerTaskMetadata x -> EcsContainerTaskMetadata $cfrom :: forall x. EcsContainerTaskMetadata -> Rep EcsContainerTaskMetadata x Generic instance FromJSON EcsContainerTaskMetadata where parseJSON :: Value -> Parser EcsContainerTaskMetadata parseJSON = forall a. (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a genericParseJSON forall a b. (a -> b) -> a -> b $ String -> Options aesonDropPrefix String "ectm" aesonDropPrefix :: String -> Options aesonDropPrefix :: String -> Options aesonDropPrefix String x = Options defaultOptions { fieldLabelModifier :: ShowS fieldLabelModifier = forall a. Eq a => [a] -> [a] -> [a] dropPrefix String x } getEcsMetadata :: (MonadIO m, MonadError EcsMetadataError m) => m (Maybe EcsMetadata) getEcsMetadata :: forall (m :: * -> *). (MonadIO m, MonadError EcsMetadataError m) => m (Maybe EcsMetadata) getEcsMetadata = do Maybe String mURI <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ String -> IO (Maybe String) lookupEnv String "ECS_CONTAINER_METADATA_URI" forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) for Maybe String mURI forall a b. (a -> b) -> a -> b $ \String uri -> EcsContainerMetadata -> EcsContainerTaskMetadata -> EcsMetadata EcsMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. (MonadIO m, MonadError EcsMetadataError m, FromJSON a) => String -> m a makeContainerMetadataRequest (String uri forall a. Semigroup a => a -> a -> a <> String "/") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall (m :: * -> *) a. (MonadIO m, MonadError EcsMetadataError m, FromJSON a) => String -> m a makeContainerMetadataRequest (String uri forall a. Semigroup a => a -> a -> a <> String "/task") makeContainerMetadataRequest :: (MonadIO m, MonadError EcsMetadataError m, FromJSON a) => String -> m a makeContainerMetadataRequest :: forall (m :: * -> *) a. (MonadIO m, MonadError EcsMetadataError m, FromJSON a) => String -> m a makeContainerMetadataRequest = forall e (m :: * -> *) x a. MonadError e m => (x -> e) -> Either x a -> m a mapEither HttpDecodeError -> EcsMetadataError EcsMetadataErrorInvalidJSON forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Response a -> a getResponseBody forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Request -> m (Response (Either HttpDecodeError a)) httpJson forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall e (m :: * -> *) x a. MonadError e m => (x -> e) -> Either x a -> m a mapEither (String -> EcsMetadataError EcsMetadataErrorInvalidURI forall b c a. (b -> c) -> (a -> b) -> a -> c . forall e. Exception e => e -> String displayException) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadThrow m => String -> m Request parseRequest mapEither :: MonadError e m => (x -> e) -> Either x a -> m a mapEither :: forall e (m :: * -> *) x a. MonadError e m => (x -> e) -> Either x a -> m a mapEither x -> e f = 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 . x -> e f) forall (f :: * -> *) a. Applicative f => a -> f a pure