<commit_before>{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- Module      : Khan.Model.Image
-- Copyright   : (c) 2013 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Khan.Model.Image
    ( find
    , findAll
    , findAllCatch
    , create
    ) where

import           Control.Concurrent (threadDelay)
import           Control.Monad
import qualified Data.Text          as Text
import           Khan.Internal
import           Khan.Prelude       hiding (find, min, max)
import           Network.AWS.EC2    hiding (Instance, wait)

find :: [Text] -> [Filter] -> AWS DescribeImagesResponseItemType
find ids fs = findAll ids fs >>=
    hoistError . note "Failed to find any matching Images" . listToMaybe

findAll :: [Text] -> [Filter] -> AWS [DescribeImagesResponseItemType]
findAll ids fs = djImagesSet <$>
    send (DescribeImages [] ids [] fs)

findAllCatch :: [Text]
             -> [Filter]
             -> AWS (Either EC2ErrorResponse [DescribeImagesResponseItemType])
findAllCatch ids fs = either Left (Right . djImagesSet) <$>
    sendCatch (DescribeImages [] ids [] fs)

create :: Text -> Text -> [BlockDeviceMappingItemType] -> AWS Text
create i n bs = do
    log "Creating Image {} from {}" [n, i]
    img <- cjImageId <$> send (CreateImage i n Nothing Nothing bs)
    wait img
    log "Tagging Image {}" [img]
    send_ $ CreateTags [img] [ResourceTagSetItemType "Name" n]
    return img
  where
    wait 0 img = throwAWS "Image creation failed: {}" [img]
    wait n img = do
        log "Waiting {} seconds for Image {} creation..."
            [show delay, Text.unpack img]
        liftIO $ threadDelay delay
        rs <- findAllCatch [img] []
        verifyEC2 "InvalidAMIID.NotFound" rs
        if pending (hush rs)
            then log "Image still pending: {}" [img] >> wait (n - 1) img
            else log "Image marked as available: {}" [img]

    pending (Just (x:_)) = diritImageState x /= "available"
    pending _            = True

    limit = 24           -- 24 * 20 seconds = 8 minutes
    delay = 1000000 * 20 -- 20 seconds
<commit_msg>Adding limit<commit_after>{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- Module      : Khan.Model.Image
-- Copyright   : (c) 2013 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Khan.Model.Image
    ( find
    , findAll
    , findAllCatch
    , create
    ) where

import           Control.Concurrent (threadDelay)
import           Control.Monad
import qualified Data.Text          as Text
import           Khan.Internal
import           Khan.Prelude       hiding (find, min, max)
import           Network.AWS.EC2    hiding (Instance, wait)

find :: [Text] -> [Filter] -> AWS DescribeImagesResponseItemType
find ids fs = findAll ids fs >>=
    hoistError . note "Failed to find any matching Images" . listToMaybe

findAll :: [Text] -> [Filter] -> AWS [DescribeImagesResponseItemType]
findAll ids fs = djImagesSet <$>
    send (DescribeImages [] ids [] fs)

findAllCatch :: [Text]
             -> [Filter]
             -> AWS (Either EC2ErrorResponse [DescribeImagesResponseItemType])
findAllCatch ids fs = either Left (Right . djImagesSet) <$>
    sendCatch (DescribeImages [] ids [] fs)

create :: Text -> Text -> [BlockDeviceMappingItemType] -> AWS Text
create i n bs = do
    log "Creating Image {} from {}" [n, i]
    img <- cjImageId <$> send (CreateImage i n Nothing Nothing bs)
    wait limit img
    log "Tagging Image {}" [img]
    send_ $ CreateTags [img] [ResourceTagSetItemType "Name" n]
    return img
  where
    wait 0 img = throwAWS "Image creation failed: {}" [img]
    wait n img = do
        log "Waiting {} seconds for Image {} creation..."
            [show delay, Text.unpack img]
        liftIO $ threadDelay delay
        rs <- findAllCatch [img] []
        verifyEC2 "InvalidAMIID.NotFound" rs
        if pending (hush rs)
            then log "Image still pending: {}" [img] >> wait (n - 1) img
            else log "Image marked as available: {}" [img]

    pending (Just (x:_)) = diritImageState x /= "available"
    pending _            = True

    limit = 24           -- 24 * 20 seconds = 8 minutes
    delay = 1000000 * 20 -- 20 seconds

{'fraction_non_alphanumeric': 0.11236415829403322, 'fraction_numerical': 0.012712733237646094, 'mean_word_length': 2.2981744421906694, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4297708', 'n_tokens_mistral': 1500, 'n_tokens_neox': 1444, 'n_words': 504}