Amazonka: example dynamo & s3

amazonka_eg.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Protolude hiding (to, (&))
import qualified System.IO as IO
import           Control.Lens ((<&>), (^.), (.~), (&), set, view)
import qualified Data.Text as Txt
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import qualified Network.AWS.S3 as S3
import qualified Network.AWS.Data as AWS
import qualified Control.Monad.Trans.AWS as AWS
import qualified Network.AWS.DynamoDB as AwsD

putChunkedFile :: AWS.Region    -- ^ Region to operate in.
               -> S3.BucketName -- ^ The bucket to store the file in.
               -> S3.ObjectKey  -- ^ The destination object key.
               -> AWS.ChunkSize -- ^ The chunk size to send.
               -> FilePath      -- ^ The source file to upload.
               -> IO ()
putChunkedFile r b k c f = do
    lgr <- AWS.newLogger AWS.Debug stdout
    env <- AWS.newEnv AWS.Discover <&> set AWS.envLogger lgr . set AWS.envRegion r

    AWS.runResourceT . AWS.runAWST env $ do
        bdy <- AWS.chunkedFile c f
        void . AWS.send $ S3.putObject b k bdy
        liftIO . putText $ "Successfully Uploaded: " <> AWS.toText f <> " to " <> AWS.toText b <> " - " <> AWS.toText k


getFile :: AWS.Region    -- ^ Region to operate in.
        -> S3.BucketName
        -> S3.ObjectKey  -- ^ The source object key.
        -> FilePath      -- ^ The destination file to save as.
        -> IO ()
getFile r b k f = do
    lgr <- AWS.newLogger AWS.Debug stdout
    env <- AWS.newEnv AWS.Discover <&> set AWS.envLogger lgr . set AWS.envRegion r

    AWS.runResourceT . AWS.runAWST env $ do
        rs <- AWS.send (S3.getObject b k)
        view S3.gorsBody rs `AWS.sinkBody` CB.sinkFile f
        liftIO . putText $ "Successfully Download: " <> AWS.toText b <> " - " <> AWS.toText k <> " to " <> AWS.toText f


insertItem :: AWS.Region
              -- ^ Region to operate in.
           -> Text
              -- ^ The table to insert the item into.
           -> HashMap Text AwsD.AttributeValue
              -- ^ The attribute name-value pairs that constitute an item.
           -> IO AwsD.PutItemResponse
insertItem region table item = do
    lgr <- AWS.newLogger AWS.Debug stdout
    env <- AWS.newEnv AWS.Discover <&> set AWS.envLogger lgr

    AWS.runResourceT . AWS.runAWST env . AWS.within region $ do
        -- Scoping the endpoint change using 'reconfigure':
        liftIO . putText $ "Inserting item into table '" <> table <> "' with attribute names: " <> Txt.intercalate ", " (Map.keys item)
        -- Insert the new item into the specified table:
        AWS.send $ AwsD.putItem table & AwsD.piItem .~ item
  
  
testUpdateItem :: AWS.Region
               -- ^ Region to operate in.
               -> Text
               -- ^ The table to insert the item into.
               -> HashMap Text AwsD.AttributeValue
               -- ^ The attribute name-value pairs that constitute a key
               -> Text
               -- ^ The update expression
               -> HashMap Text AwsD.AttributeValue
               -- ^ The attribute name-value pairs of values to update
               -> IO AwsD.UpdateItemResponse
testUpdateItem region table key updateExpr updateVals = do
    lgr <- AWS.newLogger AWS.Debug stdout
    env <- AWS.newEnv AWS.Discover <&> set AWS.envLogger lgr

    AWS.runResourceT . AWS.runAWST env . AWS.within region $ do
        liftIO . putText $ "Updating item in table '" <> table <> "' with key: " <> Txt.intercalate ", " (Map.keys key)
        
        -- Update the new item in the specified table:
        AWS.send $ AwsD.updateItem table
                     & AwsD.uiKey .~ key
                     & AwsD.uiUpdateExpression .~ Just updateExpr
                     & AwsD.uiExpressionAttributeValues .~ updateVals
  
  
testGetItem :: AWS.Region
            -- ^ Region to operate in.
            -> Text
            -- ^ The table to get the item from.
            -> HashMap Text AwsD.AttributeValue
            -- ^ The attribute name-value pairs that represent the key
            -> IO AwsD.GetItemResponse
testGetItem region table key = do
    lgr <- AWS.newLogger AWS.Debug stdout
    env <- AWS.newEnv AWS.Discover <&> set AWS.envLogger lgr

    AWS.runResourceT . AWS.runAWST env . AWS.within region $ do
        liftIO . putText $ "Getting item from table '"
        
        -- Update the new item in the specified table:
        AWS.send $ AwsD.getItem table & AwsD.giKey .~ key 
  
  
main :: IO ()
main = do
  putChunkedFile AWS.Ireland "my-s3-bucket" "test.txt" (1024 * 1024) "test.txt"
  getFile AWS.Ireland "my-s3-bucket" "test.txt" "test.out.txt"

  insertItem AWS.Ireland "dbName" $ Map.fromList [ ("uid", AwsD.attributeValue & AwsD.avS .~ Just "test")
                                                 , ("test", AwsD.attributeValue & AwsD.avS .~ Just "test1")
                                                 ]
  
  testUpdateItem
    AWS.Ireland
    "dbName"
    (Map.fromList [ ("uid", AwsD.attributeValue & AwsD.avS .~ Just "test") ])
    "SET test = :test"
    (Map.fromList [ (":test", AwsD.attributeValue & AwsD.avS .~ Just "new") ])
    
  r <- testGetItem
         AWS.Ireland
         "dbName"
         (Map.fromList [ ("uid", AwsD.attributeValue & AwsD.avS .~ Just "test") ])
  
  -- Get the response
  print $ r ^. AwsD.girsResponseStatus
  -- Get the returned items as a map
  print $ r ^. AwsD.girsItem 

  -- Lookup a single value, NB partial, don't do this
  let (Just v) = Map.lookup "uid" (r ^. AwsD.girsItem)
  print $ v ^. AwsD.avS

  -- Same as above, but using join . fmap to do it in a single step
  print . join $ view AwsD.avS <$> Map.lookup "uid" (r ^. AwsD.girsItem)