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
  = EcsMetadataErrorNotEnabled
  | EcsMetadataErrorInvalidURI String
  | EcsMetadataErrorUnexpectedStatus Request Status
  | EcsMetadataErrorInvalidJSON Request HttpDecodeError
  deriving stock 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
  { ecmDockerId :: Text
  , ecmDockerName :: Text
  , ecmImage :: Text
  , ecmImageID :: Text
  }
  deriving stock Generic

instance FromJSON EcsContainerMetadata where
  parseJSON = genericParseJSON $ aesonDropPrefix "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
  { 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 EcsMetadata
getEcsMetadata = do
  mURI <-
    liftIO $ (<|>) <$> lookupEnv "ECS_CONTAINER_METADATA_URI_V4" <*> lookupEnv
      "ECS_CONTAINER_METADATA_URI"

  uri <- maybe (throwError EcsMetadataErrorNotEnabled) pure mURI

  EcsMetadata
    <$> makeContainerMetadataRequest uri
    <*> makeContainerMetadataRequest (uri <> "/task")

makeContainerMetadataRequest
  :: (MonadIO m, MonadError EcsMetadataError m, FromJSON a) => String -> m a
makeContainerMetadataRequest uri = do
  req <- mapEither (EcsMetadataErrorInvalidURI . displayException)
    $ parseRequest uri
  resp <- httpJson req

  let status = getResponseStatus resp

  unless (statusIsSuccessful status)
    $ throwError
    $ EcsMetadataErrorUnexpectedStatus req status

  mapEither (EcsMetadataErrorInvalidJSON req) $ getResponseBody resp

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