factor our common connection code

Network/AWS/Utils.hs

@@ -3,6 +3,7 @@ module Network.AWS.Utils
     , Local(..)
     , Remote(..)
     , Arg(..)
+    , withConnection
 
     -- * Local <-> Remote actions
     , pushObject
@@ -355,6 +356,15 @@ handleArgs msg parser f = do
         helpFlagPresent ("--help":_) = True
         helpFlagPresent (_:rest)     = helpFlagPresent rest
 
+-- | Get the AWS keys from the environment and execute the action with 
+--   the connection. If the keys aren't set, error
+withConnection :: (AWSConnection -> IO ()) -> IO ()
+withConnection f = do
+    maws <- amazonS3ConnectionFromEnv
+    case maws of
+        Just aws -> f aws
+        _        -> errorEnvNotSet
+
 -- | Either show the error or call the function on the result
 handleError :: AWSResult a -> (a -> IO ()) -> IO ()
 handleError (Left e)  _ = hPutStrLn stderr $ prettyReqError e
@@ -384,12 +394,12 @@ skip :: IOException -> IO ()
 skip e = hPutStrLn stderr $ show e
 
 -- | Invalid arguments for operation
-errorInvalidArgs :: String
-errorInvalidArgs = "Invalid arguments for operation"
+errorInvalidArgs :: IO ()
+errorInvalidArgs = hPutStrLn stderr "Invalid arguments for operation"
 
 -- | AWS environment variables are not set
-errorEnvNotSet :: String
-errorEnvNotSet = "AWS environment variables are not set"
+errorEnvNotSet :: IO ()
+errorEnvNotSet = hPutStrLn stderr "AWS environment variables are not set"
 
 -- | Taken from pandoc, Text.Pandoc.Shared
 getMimeType :: FilePath -> String

s3cp.hs

@@ -1,10 +1,7 @@
 module Main where
 
-import Network.AWS.AWSConnection
 import Network.AWS.Utils
-
 import Control.Monad (forM_, guard)
-import System.IO     (hPutStrLn, stderr)
 
 main :: IO ()
 main = handleArgs usage parseArgs $ \(srcs, dst) ->
@@ -29,22 +26,7 @@ parseArgs args = do
     return (srcs,dst)
 
 copy :: Arg -> Arg -> IO ()
-copy (R remote) (L local) = do
-    mconn <- amazonS3ConnectionFromEnv
-    case mconn of
-        Just conn -> pullObject conn remote local
-        _         -> hPutStrLn stderr errorEnvNotSet
-
-copy (L local) (R remote) = do
-    mconn <- amazonS3ConnectionFromEnv
-    case mconn of
-        Just conn -> pushObject conn local remote
-        _         -> hPutStrLn stderr errorEnvNotSet
-
-copy (R from) (R to) = do
-    mconn <- amazonS3ConnectionFromEnv
-    case mconn of
-        Just conn -> copyRemote conn from to
-        _         -> hPutStrLn stderr errorEnvNotSet
-
-copy _ _ = hPutStrLn stderr errorInvalidArgs
+copy (R remote) (L local ) = withConnection $ \aws -> pullObject aws remote local
+copy (L local ) (R remote) = withConnection $ \aws -> pushObject conn local remote
+copy (R from  ) (R to    ) = withConnection $ \aws -> copyRemote conn from to
+copy _          _          = errorInvalidArgs

s3ls.hs

@@ -1,11 +1,8 @@
 module Main where
 
-import Network.AWS.AWSConnection
 import Network.AWS.S3Bucket
 import Network.AWS.Utils
-
 import Control.Monad (guard)
-import System.IO     (hPutStrLn, stderr)
 
 main :: IO ()
 main = handleArgs usage parseArgs $ mapM_ ls
@@ -28,20 +25,15 @@ parseArgs args = do
         unRemote _          = undefined
 
 ls :: Remote -> IO ()
-ls remote@(Remote _ fp) = do
-    mconn <- amazonS3ConnectionFromEnv
-    case mconn of
-        Just conn -> do
-            isDirectory <- remoteIsDirectory conn remote
-            results <- if null fp || isDirectory
-                then listDirectory "" conn remote
-                else do
-                    resp <- listDirectory "" conn remote
-                    return $ filter ((== fp) . key) resp
-
-            mapM_ printResult results
-
-        _ -> hPutStrLn stderr errorEnvNotSet
+ls remote@(Remote _ fp) = withConnection $ \aws -> do
+    isDirectory <- remoteIsDirectory aws remote
+    results <- if null fp || isDirectory
+        then listDirectory "" aws remote
+        else do
+            resp <- listDirectory "" aws remote
+            return $ filter ((== fp) . key) resp
+
+    mapM_ printResult results
 
 printResult :: ListResult -> IO ()
 printResult (ListResult k m e s _) = putStrLn $ unwords [ m, e, prettySize s, k ]

s3mv.hs

@@ -1,10 +1,7 @@
 module Main where
 
-import Network.AWS.AWSConnection
 import Network.AWS.Utils
-
 import Control.Monad (forM_, guard)
-import System.IO     (hPutStrLn, stderr)
 
 main :: IO ()
 main = handleArgs usage parseArgs $ \(srcs, dst) ->
@@ -26,10 +23,5 @@ parseArgs args = do
     return (srcs,dst)
 
 move :: Arg -> Arg -> IO ()
-move (R from) (R to) = do
-    mconn <- amazonS3ConnectionFromEnv
-    case mconn of
-        Just conn -> moveRemote conn from to
-        _         -> hPutStrLn stderr errorEnvNotSet
-
-move _ _ = hPutStrLn stderr errorInvalidArgs
+move (R from) (R to) = withConnection $ \aws -> moveRemote aws from to
+move _        _      = errorInvalidArgs

s3rm.hs

@@ -1,10 +1,7 @@
 module Main where
 
-import Network.AWS.AWSConnection
 import Network.AWS.Utils
-
 import Control.Monad (guard)
-import System.IO     (hPutStrLn, stderr)
 
 main :: IO ()
 main = handleArgs usage parseArgs $ mapM_ rm
@@ -27,8 +24,4 @@ parseArgs args = do
         unRemote _          = undefined
 
 rm :: Remote -> IO ()
-rm remote = do
-    mconn <- amazonS3ConnectionFromEnv
-    case mconn of
-        Just conn -> removeRemote conn remote
-        _         -> hPutStrLn stderr errorEnvNotSet
+rm remote = withConnection $ \aws -> removeRemote aws remote