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)

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

data EcsMetadataError
  = EcsMetadataErrorNotEnabled
  | EcsMetadataErrorInvalidURI String
  | EcsMetadataErrorUnexpectedStatus Request Status
  | EcsMetadataErrorInvalidJSON Request HttpDecodeError
  deriving stock (Int -> EcsMetadataError -> ShowS
[EcsMetadataError] -> ShowS
EcsMetadataError -> String
(Int -> EcsMetadataError -> ShowS)
-> (EcsMetadataError -> String)
-> ([EcsMetadataError] -> ShowS)
-> Show EcsMetadataError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EcsMetadataError -> ShowS
showsPrec :: Int -> EcsMetadataError -> ShowS
$cshow :: EcsMetadataError -> String
show :: EcsMetadataError -> String
$cshowList :: [EcsMetadataError] -> ShowS
showList :: [EcsMetadataError] -> ShowS
Show)

-- | Parsing for the @/@ response
--
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-metadata-endpoint-v4.html#task-metadata-endpoint-v4-examples>
data EcsContainerMetadata = EcsContainerMetadata
  { EcsContainerMetadata -> Text
ecmDockerId :: Text
  , EcsContainerMetadata -> Text
ecmDockerName :: Text
  , EcsContainerMetadata -> Text
ecmImage :: Text
  , EcsContainerMetadata -> Text
ecmImageID :: Text
  }
  deriving stock ((forall x. EcsContainerMetadata -> Rep EcsContainerMetadata x)
-> (forall x. Rep EcsContainerMetadata x -> EcsContainerMetadata)
-> Generic EcsContainerMetadata
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
$cfrom :: forall x. EcsContainerMetadata -> Rep EcsContainerMetadata x
from :: forall x. EcsContainerMetadata -> Rep EcsContainerMetadata x
$cto :: forall x. Rep EcsContainerMetadata x -> EcsContainerMetadata
to :: forall x. Rep EcsContainerMetadata x -> EcsContainerMetadata
Generic)

instance FromJSON EcsContainerMetadata where
  parseJSON :: Value -> Parser EcsContainerMetadata
parseJSON = Options -> Value -> Parser EcsContainerMetadata
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser EcsContainerMetadata)
-> Options -> Value -> Parser EcsContainerMetadata
forall a b. (a -> b) -> a -> b
$ String -> Options
aesonDropPrefix String
"ecm"

-- | Parsing of the @/task@ response
--
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-metadata-endpoint-v4.html#task-metadata-endpoint-v4-response>
data EcsContainerTaskMetadata = EcsContainerTaskMetadata
  { EcsContainerTaskMetadata -> Text
ectmCluster :: Text
  , EcsContainerTaskMetadata -> Text
ectmTaskARN :: Text
  , EcsContainerTaskMetadata -> Text
ectmFamily :: Text
  , EcsContainerTaskMetadata -> Text
ectmRevision :: Text
  }
  deriving stock ((forall x.
 EcsContainerTaskMetadata -> Rep EcsContainerTaskMetadata x)
-> (forall x.
    Rep EcsContainerTaskMetadata x -> EcsContainerTaskMetadata)
-> Generic EcsContainerTaskMetadata
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
$cfrom :: forall x.
EcsContainerTaskMetadata -> Rep EcsContainerTaskMetadata x
from :: forall x.
EcsContainerTaskMetadata -> Rep EcsContainerTaskMetadata x
$cto :: forall x.
Rep EcsContainerTaskMetadata x -> EcsContainerTaskMetadata
to :: forall x.
Rep EcsContainerTaskMetadata x -> EcsContainerTaskMetadata
Generic)

instance FromJSON EcsContainerTaskMetadata where
  parseJSON :: Value -> Parser EcsContainerTaskMetadata
parseJSON = Options -> Value -> Parser EcsContainerTaskMetadata
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser EcsContainerTaskMetadata)
-> Options -> Value -> Parser EcsContainerTaskMetadata
forall a b. (a -> b) -> a -> b
$ String -> Options
aesonDropPrefix String
"ectm"

aesonDropPrefix :: String -> Options
aesonDropPrefix :: String -> Options
aesonDropPrefix String
x = Options
defaultOptions {fieldLabelModifier = dropPrefix x}

getEcsMetadata :: (MonadIO m, MonadError EcsMetadataError m) => m EcsMetadata
getEcsMetadata :: forall (m :: * -> *).
(MonadIO m, MonadError EcsMetadataError m) =>
m EcsMetadata
getEcsMetadata = do
  mURI <-
    IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$
      Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
        (Maybe String -> Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String -> Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"ECS_CONTAINER_METADATA_URI_V4"
        IO (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO (Maybe String)
lookupEnv
          String
"ECS_CONTAINER_METADATA_URI"

  uri <- maybe (throwError EcsMetadataErrorNotEnabled) pure mURI

  EcsMetadata
    <$> makeContainerMetadataRequest uri
    <*> makeContainerMetadataRequest (uri <> "/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 String
uri = do
  req <-
    (SomeException -> EcsMetadataError)
-> Either SomeException Request -> m Request
forall e (m :: * -> *) x a.
MonadError e m =>
(x -> e) -> Either x a -> m a
mapEither (String -> EcsMetadataError
EcsMetadataErrorInvalidURI (String -> EcsMetadataError)
-> (SomeException -> String) -> SomeException -> EcsMetadataError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) (Either SomeException Request -> m Request)
-> Either SomeException Request -> m Request
forall a b. (a -> b) -> a -> b
$
      String -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
uri
  resp <- liftIO $ httpJson req

  let status = Response (Either HttpDecodeError a) -> Status
forall a. Response a -> Status
getResponseStatus Response (Either HttpDecodeError a)
resp

  unless (statusIsSuccessful status) $
    throwError $
      EcsMetadataErrorUnexpectedStatus req status

  mapEither (EcsMetadataErrorInvalidJSON req) $ getResponseBody resp

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 = (x -> m a) -> (a -> m a) -> Either x a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m a) -> (x -> e) -> x -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> e
f) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure