{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Antiope.Shell.S3
( putFile
) where
import Antiope.S3.Types (ETag (ETag), S3Uri)
import Control.Lens
import Control.Monad.Except
import Data.Aeson ((.:))
import Data.Generics.Product.Any
import Data.Monoid ((<>))
import Data.Text as T (Text, pack, unpack)
import GHC.Generics
import qualified Data.Aeson as J
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Encoding as T
import qualified System.Exit as IO
import qualified System.Process as IO
newtype PutObjectReply = PutObjectReply
{ eTag :: Text
} deriving (Eq, Show, Generic)
instance J.FromJSON PutObjectReply where
parseJSON = J.withObject "PutObjectReply" $ \v -> PutObjectReply
<$> v .: "ETag"
putFile :: MonadIO m
=> S3Uri
-> FilePath
-> ExceptT Text m ETag
putFile s3Uri filePath = do
(exitCode, stdout, _) <- liftIO $ IO.readProcessWithExitCode "aws"
[ "s3api"
, "put-object"
, "--bucket"
, T.unpack $ s3Uri ^. the @"bucket" . the @1
, "--key"
, T.unpack $ s3Uri ^. the @"objectKey" . the @1
, "--body"
, filePath
]
""
case exitCode of
IO.ExitSuccess -> do
let stdoutText = T.pack stdout
let bs = LBS.fromStrict (T.encodeUtf8 stdoutText)
let repResult = J.eitherDecode bs :: Either String PutObjectReply
case repResult of
Right rep -> return (ETag (T.encodeUtf8 (rep ^. the @"eTag")))
Left msg -> throwError $ "Command failed to return expected metadata: " <> T.pack msg <> " given stdout: " <> stdoutText
IO.ExitFailure n -> throwError $ "Command failed with exit code: " <> T.pack (show n)