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 :: ShowS
fieldLabelModifier = String -> ShowS
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 <-
    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"

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

  EcsContainerMetadata -> EcsContainerTaskMetadata -> EcsMetadata
EcsMetadata
    (EcsContainerMetadata -> EcsContainerTaskMetadata -> EcsMetadata)
-> m EcsContainerMetadata
-> m (EcsContainerTaskMetadata -> EcsMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m EcsContainerMetadata
forall (m :: * -> *) a.
(MonadIO m, MonadError EcsMetadataError m, FromJSON a) =>
String -> m a
makeContainerMetadataRequest String
uri
    m (EcsContainerTaskMetadata -> EcsMetadata)
-> m EcsContainerTaskMetadata -> m EcsMetadata
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> m EcsContainerTaskMetadata
forall (m :: * -> *) a.
(MonadIO m, MonadError EcsMetadataError m, FromJSON a) =>
String -> m a
makeContainerMetadataRequest (String
uri String -> ShowS
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 <-
    (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
  Response (Either HttpDecodeError a)
resp <- Request -> m (Response (Either HttpDecodeError a))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either HttpDecodeError a))
httpJson Request
req

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

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

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