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
  = EcsMetadataErrorNotEnabled
  | EcsMetadataErrorInvalidURI String
  | EcsMetadataErrorUnexpectedStatus Request Status
  | EcsMetadataErrorInvalidJSON Request 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)

-- | 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. 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"

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

  String
uri <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EcsMetadataError
EcsMetadataErrorNotEnabled) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
mURI

  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 (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 String
uri = do
  Request
req <-
    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 a b. (a -> b) -> a -> b
$
      forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
uri
  Response (Either HttpDecodeError a)
resp <- forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either HttpDecodeError a))
httpJson Request
req

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

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
statusIsSuccessful Status
status) forall a b. (a -> b) -> a -> b
$
    forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
      Request -> Status -> EcsMetadataError
EcsMetadataErrorUnexpectedStatus Request
req Status
status

  forall e (m :: * -> *) x a.
MonadError e m =>
(x -> e) -> Either x a -> m a
mapEither (Request -> HttpDecodeError -> EcsMetadataError
EcsMetadataErrorInvalidJSON Request
req) forall a b. (a -> b) -> a -> b
$ forall a. Response a -> a
getResponseBody Response (Either HttpDecodeError a)
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 = 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