Ecs.hs

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
  { emContainerMetadata :: EcsContainerMetadata
  , emContainerTaskMetadata :: EcsContainerTaskMetadata
  }

data EcsMetadataError
  = EcsMetadataErrorInvalidURI String
  | EcsMetadataErrorInvalidJSON HttpDecodeError
  deriving stock Show

data EcsContainerMetadata = EcsContainerMetadata
  { ecmDockerId :: Text
  , ecmDockerName :: Text
  , ecmImage :: Text
  , ecmImageID :: Text
  }
  deriving stock Generic

instance FromJSON EcsContainerMetadata where
  parseJSON = genericParseJSON $ aesonDropPrefix "ecm"

data EcsContainerTaskMetadata = EcsContainerTaskMetadata
  { ectmCluster :: Text
  , ectmTaskARN :: Text
  , ectmFamily :: Text
  , ectmRevision :: Text
  }
  deriving stock Generic

instance FromJSON EcsContainerTaskMetadata where
  parseJSON = genericParseJSON $ aesonDropPrefix "ectm"

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

getEcsMetadata
  :: (MonadIO m, MonadError EcsMetadataError m) => m (Maybe EcsMetadata)
getEcsMetadata = do
  mURI <- liftIO $ lookupEnv "ECS_CONTAINER_METADATA_URI"

  for mURI $ \uri ->
    EcsMetadata
      <$> makeContainerMetadataRequest (uri <> "/")
      <*> makeContainerMetadataRequest (uri <> "/task")

makeContainerMetadataRequest
  :: (MonadIO m, MonadError EcsMetadataError m, FromJSON a) => String -> m a
makeContainerMetadataRequest =
  mapEither EcsMetadataErrorInvalidJSON
    . getResponseBody
    <=< httpJson
    <=< mapEither (EcsMetadataErrorInvalidURI . displayException)
    . parseRequest

mapEither :: MonadError e m => (x -> e) -> Either x a -> m a
mapEither f = either (throwError . f) pure