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