Lazy.hs

{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HaskellWorks.Ci.Assist.IO.Lazy
  ( readResource
  , resourceExists
  , headS3Uri
  , writeResource
  , createLocalDirectoryIfMissing
  ) where

import Antiope.Core
import Antiope.S3.Lazy
import Control.Lens
import Control.Monad                   (void)
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Conduit.Lazy               (lazyConsume)
import Data.Either                     (isRight)
import Data.Text                       (Text)
import HaskellWorks.Ci.Assist.Location (Location (..))
import Network.AWS                     (MonadAWS, chunkedFile)
import Network.AWS.Data.Body           (_streamBody)

import qualified Antiope.S3.Lazy                   as AWS
import qualified Antiope.S3.Types                  as AWS
import qualified Data.ByteString.Lazy              as LBS
import qualified Data.Text                         as T
import qualified Data.Text.IO                      as T
import qualified HaskellWorks.Ci.Assist.IO.Console as CIO
import qualified Network.AWS                       as AWS
import qualified Network.AWS.Data                  as AWS
import qualified Network.AWS.S3.HeadObject         as AWS
import qualified Network.AWS.S3.PutObject          as AWS
import qualified Network.HTTP.Types                as HTTP
import qualified System.Directory                  as IO
import qualified System.IO                         as IO

{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}

readResource :: MonadResource m => AWS.Env -> Location -> m (Maybe LBS.ByteString)
readResource envAws = \case
  S3 s3Uri    -> runAws envAws $ AWS.downloadFromS3Uri s3Uri
  Local path  -> liftIO $ Just <$> LBS.readFile path

resourceExists :: (MonadResource m, MonadCatch m, MonadIO m) => AWS.Env -> Location -> m Bool
resourceExists envAws = \case
  S3 s3Uri    -> isRight <$> headS3Uri envAws s3Uri
  Local path  -> liftIO $ IO.doesFileExist path

headS3Uri :: (MonadResource m, MonadCatch m) => AWS.Env -> AWS.S3Uri -> m (Either String AWS.HeadObjectResponse)
headS3Uri envAws (AWS.S3Uri b k) =
  catch (Right <$> runAws envAws (AWS.send (AWS.headObject b k))) $ \(e :: AWS.Error) ->
    case e of
      (AWS.ServiceError (AWS.ServiceError' _ (HTTP.Status 404 _) _ _ _ _)) -> return (Left "Not found")
      _                                                                    -> throwM e

chunkSize :: AWS.ChunkSize
chunkSize = AWS.ChunkSize (1024 * 1024)

uploadeToS3 :: MonadUnliftIO m => AWS.Env -> AWS.S3Uri -> LBS.ByteString -> m ()
uploadeToS3 envAws (AWS.S3Uri b k) lbs = do
  let req = AWS.toBody lbs
  let po  = AWS.putObject b k req
  void $ runResAws envAws $ AWS.send po

writeResource :: MonadUnliftIO m => AWS.Env -> Location -> LBS.ByteString -> m ()
writeResource envAws loc lbs = case loc of
  S3 s3Uri   -> uploadeToS3 envAws s3Uri lbs
  Local path -> liftIO $ LBS.writeFile path lbs

createLocalDirectoryIfMissing :: (MonadCatch m, MonadIO m) => Location -> m ()
createLocalDirectoryIfMissing = \case
  S3 s3Uri   -> return ()
  Local path -> liftIO $ IO.createDirectoryIfMissing True path