1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
{-# LANGUAGE OverloadedStrings #-}
import qualified Aws
import qualified Aws.Core
import qualified Aws.Sqs as Sqs
import Control.Concurrent
import Control.Error
import Control.Monad.IO.Class
import Data.Monoid
import Data.String
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Control.Monad (forM_, forM, replicateM)
{-| Created by Tim Perry on September 18, 2013
|
| All code relies on a correctly configured ~/.aws-keys and will access that account which
| may incur charges for the user!
|
| This code will demonstrate:
| - Listing all queue's attached to the current AWS account.
| - Creating a queue
| - Adding messages to the queue
| - Retrieving messages from the queue
| - Deleting messages from the queue
| and finally
| - Deleting the queue.
| -}
main :: IO ()
main = do
{- Set up AWS credentials and the default configuration. -}
cfg <- Aws.baseConfiguration
let sqscfg = Sqs.sqs Aws.Core.HTTP Sqs.sqsEndpointUsWest2 False :: Sqs.SqsConfiguration Aws.NormalQuery
{- List any Queues you have already created in your SQS account -}
Sqs.ListQueuesResponse qUrls <- Aws.simpleAws cfg sqscfg $ Sqs.ListQueues Nothing
let origQUrlCount = length qUrls
putStrLn $ "originally had " ++ show origQUrlCount ++ " queue urls"
mapM_ print qUrls
{- Create a request object to create a queue and then print out the Queue URL -}
let qName = "scaledsoftwaretest1"
let createQReq = Sqs.CreateQueue (Just 8400) qName
Sqs.CreateQueueResponse qUrl <- Aws.simpleAws cfg sqscfg createQReq
T.putStrLn $ T.concat ["queue was created with Url: ", qUrl]
{- Create a QueueName object, sqsQName, to hold the name of this queue for the duration -}
let awsAccountNum = T.split (== '/') qUrl !! 3
let sqsQName = Sqs.QueueName qName awsAccountNum
{- list queue attributes -- for this example we will only list the approximateNumberOfMessages in this queue. -}
let qAttReq = Sqs.GetQueueAttributes sqsQName [Sqs.ApproximateNumberOfMessages]
Sqs.GetQueueAttributesResponse attPairs <- Aws.simpleAws cfg sqscfg qAttReq
mapM_ (\(attName, attText) -> T.putStrLn $ T.concat [" ", Sqs.printQueueAttribute attName, " ", attText]) attPairs
{- Here we add some messages to the queue -}
let messages = map (\n -> T.pack $ "msg" ++ show n) [1 .. 10]
{- Add messages to the queue -}
forM_ messages $ \mText -> do
T.putStrLn $ " Adding: " <> mText
let sqsSendMessage = Sqs.SendMessage mText sqsQName [] (Just 0)
Sqs.SendMessageResponse _ mid _ <- Aws.simpleAws cfg sqscfg sqsSendMessage
T.putStrLn $ " message id: " <> sshow mid
{- Here we remove messages from the queue one at a time. -}
let receiveMessageReq = Sqs.ReceiveMessage Nothing [] (Just 1) [] sqsQName (Just 20)
let numMessages = length messages
removedMsgs <- replicateM numMessages $ do
msgs <- exceptT (const $ return []) return . retryT 2 $ do
Sqs.ReceiveMessageResponse r <- liftIO $ Aws.simpleAws cfg sqscfg receiveMessageReq
case r of
[] -> throwE "no message received"
_ -> return r
putStrLn $ "number of messages received: " ++ show (length msgs)
forM msgs (\msg -> do
-- here we remove a message, delete it from the queue, and then return the
-- text sent in the body of the message
putStrLn $ " Received " ++ show (Sqs.mBody msg)
Aws.simpleAws cfg sqscfg $ Sqs.DeleteMessage (Sqs.mReceiptHandle msg) sqsQName
return $ Sqs.mBody msg)
{- Now we'll delete the queue we created at the start of this program -}
putStrLn $ "Deleting the queue: " ++ show (Sqs.qName sqsQName)
let dQReq = Sqs.DeleteQueue sqsQName
_ <- Aws.simpleAws cfg sqscfg dQReq
{- | Let's make sure the queue was actually deleted and that the same number of queues exist at when
| the program ends as when it started.
-}
exceptT T.putStrLn T.putStrLn . retryT 4 $ do
qUrls <- liftIO $ do
putStrLn $ "Listing all queueus to check to see if " ++ show (Sqs.qName sqsQName) ++ " is gone"
Sqs.ListQueuesResponse qUrls_ <- Aws.simpleAws cfg sqscfg $ Sqs.ListQueues Nothing
mapM_ T.putStrLn qUrls_
return qUrls_
if qUrl `elem` qUrls
then throwE $ " *\n *\n * Warning, '" <> sshow qName <> "' was not deleted\n"
<> " * This is probably just a race condition."
else return $ " The queue '" <> sshow qName <> "' was correctly deleted"
retryT :: MonadIO m => Int -> ExceptT T.Text m a -> ExceptT T.Text m a
retryT i f = go 1
where
go x
| x >= i = fmapLT (\e -> "error after " <> sshow x <> " retries: " <> e) f
| otherwise = f `catchE` \_ -> do
liftIO $ threadDelay (1000000 * min 60 (2^(x-1)))
go (succ x)
sshow :: (Show a, IsString b) => a -> b
sshow = fromString . show
|
