content: {-# 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
  
  