module Freckle.App.Ecs
  ( EcsMetadata(..)
  , EcsContainerMetadata(..)
  , EcsContainerTaskMetadata(..)
  , getEcsMetadata
  ) where

import Freckle.App.Prelude

import Control.Error.Util (hush)
import Data.Aeson
import Data.List.Extra (dropPrefix)
import Freckle.App.Http
import System.Environment (lookupEnv)

data EcsMetadata = EcsMetadata
  { EcsMetadata -> EcsContainerMetadata
emContainerMetadata :: EcsContainerMetadata
  , EcsMetadata -> EcsContainerTaskMetadata
emContainerTaskMetadata :: EcsContainerTaskMetadata
  }

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 :: String -> String
fieldLabelModifier = forall a. Eq a => [a] -> [a] -> [a]
dropPrefix String
x }

getEcsMetadata :: MonadIO m => m (Maybe EcsMetadata)
getEcsMetadata :: forall (m :: * -> *). MonadIO m => m (Maybe EcsMetadata)
getEcsMetadata =
  forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 EcsContainerMetadata -> EcsContainerTaskMetadata -> EcsMetadata
EcsMetadata
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Text -> m (Maybe a)
makeContainerMetadataRequest Text
"/"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Text -> m (Maybe a)
makeContainerMetadataRequest Text
"/task"

makeContainerMetadataRequest :: (MonadIO m, FromJSON a) => Text -> m (Maybe a)
makeContainerMetadataRequest :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Text -> m (Maybe a)
makeContainerMetadataRequest Text
path = 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"
  Maybe (Response (Either HttpDecodeError a))
meMetadata <- 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 -> do
    forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either HttpDecodeError a))
httpJson forall a b. (a -> b) -> a -> b
$ String -> Request
parseRequest_ forall a b. (a -> b) -> a -> b
$ String
uri forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
path
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Maybe b
hush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Response a -> a
getResponseBody forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Response (Either HttpDecodeError a))
meMetadata