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