some maintenance, code reorg, improve custom CF resources implementation

examples/cognito-apigw-lambda/src/Main.hs

@@ -8,6 +8,7 @@ import           Data.Aeson                            (Value (String))
 import           Data.Default                          (def)
 import qualified Data.HashMap.Strict                   as SHM
 import qualified Data.Text                             as T
+import           Protolude
 import           Web.JWT                               (claims, decode)
 
 import           Qi                                    (withConfig)
@@ -20,16 +21,16 @@ import           Qi.Program.Config.Interface           (ConfigProgram, api,
                                                         apiResource,
                                                         customResource)
 import           Qi.Program.Lambda.Interface           (ApiLambdaProgram, say)
-import           Qi.Util                               (argumentsError, success)
 import           Qi.Util.Cognito                       (cognitoPoolProviderLambda)
 
+
 main :: IO ()
 main = withConfig config
   where
     config :: ConfigProgram ()
     config = do
       cognito <- customResource "cognitoPoolProvider"
-              (cognitoPoolProviderLambda "MyIdentityPool" "MyUserPool" "MyClient") def
+              cognitoPoolProviderLambda def
 
 
       void $ api "world" >>= \world -> do
@@ -43,13 +44,12 @@ main = withConfig config
       :: ApiLambdaProgram
     greetLambda event = do
       withJwt event $ \jwt -> do
-        say $ T.concat ["jwt contents: ", T.pack $ show (decode jwt)]
-        success "lambda had executed successfully"
-
+        say $ T.concat ["jwt contents: ", show (decode jwt)]
+        pure "lambda had executed successfully"
 
 
-
-withJwt event f = case SHM.lookup "Authorization" $ event^.aeParams.rpHeaders of
-  Just x -> f x
+withJwt event f = case SHM.lookup "Authorization" $ event ^. aeParams . rpHeaders of
+  Just jwt -> f jwt
   Nothing ->
-    argumentsError "expected header 'Authorization' was not found"
+    pure "expected header 'Authorization' was not found"
+

examples/cognito-lambda/src/Main.hs

@@ -66,7 +66,7 @@ scanContacts ddbTableId payload = do
   r <- scanDdbRecords ddbTableId
   withSuccess (r^.srsResponseStatus) $
     result
-      (internalError . ("Parsing error: " ++))
+      (internalError . ("Parsing error: " <>))
       (success . (toJSON :: [Contact] -> Value))
       $ forM (r^.srsItems) parseAttrs
 
@@ -92,7 +92,7 @@ getContact ddbTableId payload =
       result
         (internalError . ("Parsing error: " ++))
         (success . (toJSON :: Contact -> Value))
-        $ parseAttrs $ r^.girsItem
+        $ parseAttrs $ r ^. girsItem
 
 
 putContact
@@ -101,7 +101,7 @@ putContact
 putContact ddbTableId payload =
   withDeserializedPayload payload $ \(contact :: Contact) -> do
     r <- putDdbRecord ddbTableId $ toAttrs contact
-    withSuccess (r^.pirsResponseStatus) $
+    withSuccess (r ^. pirsResponseStatus) $
       success "successfully put contact"
 
 deleteContact
@@ -110,7 +110,7 @@ deleteContact
 deleteContact ddbTableId payload =
   withId payload $ \cid -> do
       r <- deleteDdbRecord ddbTableId $ idKeys cid
-      withSuccess (r^.dirsResponseStatus) $
+      withSuccess (r ^. dirsResponseStatus) $
         success "successfully deleted contact"
 
 

examples/cw-events/src/Main.hs

@@ -13,7 +13,6 @@ import           Qi                          (withConfig)
 import           Qi.Config.AWS.CW            (CwEventsRuleProfile (ScheduledEventProfile))
 import           Qi.Program.Config.Interface (ConfigProgram, cwEventLambda)
 import           Qi.Program.Lambda.Interface (CwLambdaProgram, say)
-import           Qi.Util                     (success)
 
 
 main :: IO ()
@@ -31,6 +30,4 @@ main = withConfig config
     eventLambda _ = do
       -- emit log messages that end up in the appropriate cloudwatch group/stream
       say "tick"
-
-      success "lambda had executed successfully"
-
+      pure "all done!"

examples/simple-s3-copy/src/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -6,11 +7,8 @@
 module Main where
 
 import           Control.Lens
-import           Control.Monad               (void)
 import           Data.Default                (def)
-import           Data.Text                   (pack)
 import           Protolude
-
 import           Qi                          (withConfig)
 import           Qi.Config.AWS.Lambda        (LambdaMemorySize (..),
                                               lpMemorySize)
@@ -22,7 +20,6 @@ import           Qi.Program.Config.Interface (ConfigProgram, s3Bucket,
 import           Qi.Program.Lambda.Interface (S3LambdaProgram,
                                               getS3ObjectContent,
                                               putS3ObjectContent, say)
-import           Qi.Util                     (success)
 
 
 main :: IO ()
@@ -57,14 +54,15 @@ main = withConfig config
               outgoingS3Obj = s3oBucketId .~ sinkBucketId $ incomingS3Obj
 
           -- get the content of the newly uploaded file
-          content <- getS3ObjectContent incomingS3Obj
-
-          -- emit log messages that end up in the appropriate cloudwatch group/stream
-          say "hello there!"
+          eitherContent <- getS3ObjectContent incomingS3Obj
 
-          -- write the content into a new file in the "output" bucket
-          putS3ObjectContent outgoingS3Obj content
+          case eitherContent of
+            Right content -> do
+              -- write the content into a new file in the "output" bucket
+              putS3ObjectContent outgoingS3Obj content
 
-          success "lambda had executed successfully"
+              pure "lambda had executed successfully"
 
+            Left err ->
+              pure . toS $ "error: '" <> err <> "'"
 

src/Qi.hs → library/Qi.hs

@@ -27,17 +27,17 @@ withConfig configProgram = do
   (`runReaderT` config appName) $ do
 
     case cmd of
-      CfRenderTemplate           -> renderCfTemplate
-      CfDeploy                   -> deployApp
-      CfCreate                   -> createCfStack
-      CfUpdate                   -> updateCfStack
-      CfDescribe                 -> describeCfStack
-      CfDestroy                  -> destroyCfStack $ pure ()
-      CfCycle                    -> cycleStack
-
-      LbdUpdate                  -> updateLambdas
-      LbdSendEvent lbdName event -> invokeLambda lbdName event
-      LbdLogs lbdName            -> lambdaLogs lbdName
+      CfRenderTemplate     -> renderCfTemplate
+      CfDeploy             -> deployApp
+      CfCreate             -> createCfStack
+      CfUpdate             -> updateCfStack
+      CfDescribe           -> describeCfStack
+      CfDestroy            -> destroyCfStack $ pure ()
+      CfCycle              -> cycleStack
+
+      LbdUpdate            -> updateLambdas
+      LbdSendEvent lbdName -> invokeLambda lbdName
+      LbdLogs lbdName      -> lambdaLogs lbdName
 
   where
     config name = snd . (`runState` def{_namePrefix = name}) . unQiConfig $ interpret configProgram

library/Qi/AWS/Cognito.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Qi.AWS.Cognito where
+
+import           Data.Aeson
+import           Protolude
+
+
+newtype IdPoolId = IdPoolId Text
+  deriving (Eq, Show, Generic)
+  deriving newtype (ToJSON, FromJSON)
+
+newtype AuthRoleId = AuthRoleId Text
+  deriving (Eq, Show, Generic)
+  deriving newtype (ToJSON, FromJSON)
+
+newtype UserPoolId = UserPoolId Text
+  deriving (Eq, Show, Generic)
+  deriving newtype (ToJSON, FromJSON)
+
+newtype UserPoolClientId = UserPoolClientId Text
+  deriving (Eq, Show, Generic)
+  deriving newtype (ToJSON, FromJSON)
+
+

src/Qi/AWS/SQS.hs → library/Qi/AWS/SQS.hs

@@ -5,3 +5,5 @@ import           Protolude
 
 newtype ReceiptHandle = ReceiptHandle Text
   deriving (Eq, Show)
+
+

library/Qi/AWS/Types.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Qi.AWS.Types where
+
+import           Data.Aeson
+import qualified Data.Text      as T
+import           Protolude
+import           Qi.AWS.Cognito
+
+
+newtype LogicalResourceId = LogicalResourceId Text
+  deriving (Eq, Show, Generic)
+  deriving newtype (ToJSON, FromJSON)
+
+
+newtype CompositeResourceId = CompositeResourceId (NonEmpty PhysicalResourceId)
+  deriving (Eq, Show, Generic, Semigroup)
+  deriving newtype (ToJSON, FromJSON)
+
+
+data PhysicalResourceId =
+    ArnResourceId Arn
+  | AuthRoleIdResourceId AuthRoleId
+  | UserPoolIdResourceId UserPoolId
+  | UserPoolClientIdResourceId UserPoolClientId
+  | IdPoolIdResourceId IdPoolId
+  | UnknownResourceIdType Text
+  deriving (Eq, Show, Generic, ToJSON, FromJSON)
+
+
+newtype Arn = Arn Text
+  deriving (Eq, Show, Generic)
+  deriving newtype (ToJSON, FromJSON)
+
+
+
+

src/Qi/CLI/Dispatcher.hs → library/Qi/CLI/Dispatcher.hs

@@ -37,7 +37,7 @@ import           Qi.Config.AWS                     (Config, getAll,
                                                     getPhysicalName, namePrefix)
 import           Qi.Config.AWS.Lambda              (Lambda)
 import           Qi.Config.AWS.S3                  (S3Bucket)
-import qualified Qi.Config.CF                      as CF
+import qualified Qi.Config.CfTemplate              as CfTemplate
 import           Qi.Program.Lambda.Interpreters.IO (LoggerType (..),
                                                     runLambdaProgram)
 import           Qi.Util                           (printPending, printSuccess)
@@ -63,9 +63,8 @@ runAmazonka = liftIO . A.runAmazonka
 
 invokeLambda
   :: Text
-  -> Text
   -> ReaderT Config IO ()
-invokeLambda = Lambda.invoke
+invokeLambda name = Lambda.invoke name =<< liftIO getLine
 
 updateLambdas :: Dispatcher ()
 updateLambdas = withConfig $ \config -> do
@@ -86,7 +85,7 @@ lambdaLogs = const pass -- runAmazonka . Lambda.logs
 
 renderCfTemplate :: Dispatcher ()
 renderCfTemplate =
-   withConfig $ liftIO . LBS.putStr . CF.render
+   withConfig $ liftIO . LBS.putStr . CfTemplate.render
 
 deployApp :: Dispatcher ()
 deployApp =
@@ -101,7 +100,7 @@ deployApp =
 
     runAmazonka $ do
       createBucket appName
-      putObject appName "cf.json" $ CF.render config -- TODO: render this inside docker container: https://github.com/qmuli/qmuli/issues/60
+      putObject appName "cf.json" $ CfTemplate.render config -- TODO: render this inside docker container: https://github.com/qmuli/qmuli/issues/60
       putObject appName "lambda.zip" content
 
   where

src/Qi/Config/AWS.hs → library/Qi/Config/AWS.hs

@@ -64,22 +64,27 @@ getNextId
 getNextId = do
   nid <- use nextId
   nextId += 1
-  return $ fromInt nid
+  pure $ fromInt nid
 
-underscoreNamePrefixWith :: Text -> Config -> Text
+underscoreNamePrefixWith
+  :: Text
+  -> Config
+  -> Text
 underscoreNamePrefixWith = namePrefixWith "_"
 
-dotNamePrefixWith :: Text -> Config -> Text
+dotNamePrefixWith
+  :: Text
+  -> Config
+  -> Text
 dotNamePrefixWith = namePrefixWith "."
 
 namePrefixWith
   :: Text
   -> Text
   -> Config
   -> Text
-namePrefixWith sep name config = T.concat [config^.namePrefix, sep, name]
-
-
+namePrefixWith sep name config =
+  T.concat [config^.namePrefix, sep, name]
 
 
 makeAlphaNumeric

src/Qi/Config/AWS/CF.hs → library/Qi/Config/AWS/CF.hs

@@ -20,6 +20,7 @@ import           Data.Text            (Text)
 import qualified Data.Text            as T
 import           GHC.Generics
 import           Protolude
+import           Qi.AWS.Types
 import           Qi.Config.Identifier
 
 
@@ -32,34 +33,53 @@ instance FromJSON CfRequestType where
     "Delete" -> pure CfDelete
     unknown  -> fail $ "unknown request type: " <> toS unknown
 
+
+{-
+{
+  "RequestType": "Create",
+  "ServiceToken": "arn:aws:lambda:us-east-1:910653408535:function:cognitotestxx_cognitoPoolProvider",
+  "ResponseURL": "https://cloudformation-custom-resource-response-useast1.s3.amazonaws.com/arn%3Aaws%3Acloudformation%3Aus-east-1%3A910653408535%3Astack/cognitotestxx/3b615fb0-7701-11e8-85ef-50fa5f2588d2%7CcognitoPoolProviderLambdaCustom%7C9616e4f8-9153-4bc6-bc02-53252002a8a3?AWSAccessKeyId=AKIAJGHTPRZJWHX6QVGA&Expires=1529778000&Signature=i3hplxObOjPQvet9UGeiCQZJ60A%3D\",
+  "StackId": "arn:aws:cloudformation:us-east-1:910653408535:stack/cognitotestxx/3b615fb0-7701-11e8-85ef-50fa5f2588d2",
+  "RequestId": "9616e4f8-9153-4bc6-bc02-53252002a8a3",
+  "LogicalResourceId": "cognitoPoolProviderLambdaCustom",
+  "ResourceType": "AWS::CloudFormation::CustomResource",
+  "ResourceProperties": {
+    "ServiceToken": "arn:aws:lambda:us-east-1:910653408535:function:cognitotestxx_cognitoPoolProvider"
+  }
+}
+ -}
+
+
+-- TODO: fix this sum data type
 data CfEvent = CfEventCreate {
-    _cfeResponseURL        :: Text
-  , _cfeStackId            :: Text
+    _cfeServiceToken       :: Arn
+  , _cfeResponseURL        :: Text
+  , _cfeStackId            :: Arn
   , _cfeRequestId          :: Text
+  , _cfeLogicalResourceId  :: LogicalResourceId
   , _cfeResourceType       :: Text
-  , _cfeLogicalResourceId  :: Text
   , _cfeResourceProperties :: Object
   }
   | CfEventUpdate {
     _cfeResponseURL           :: Text
-  , _cfeStackId               :: Text
+  , _cfeStackId               :: Arn
   , _cfeRequestId             :: Text
   , _cfeResourceType          :: Text
-  , _cfeLogicalResourceId     :: Text
-  , _cfePhysicalResourceId    :: Text
+  , _cfeLogicalResourceId     :: LogicalResourceId
+  , _cfePhysicalResourceId    :: CompositeResourceId
   , _cfeResourceProperties    :: Object
   , _cfeOldResourceProperties :: Object
   }
   | CfEventDelete {
     _cfeResponseURL        :: Text
-  , _cfeStackId            :: Text
+  , _cfeStackId            :: Arn
   , _cfeRequestId          :: Text
   , _cfeResourceType       :: Text
-  , _cfeLogicalResourceId  :: Text
-  , _cfePhysicalResourceId :: Text
+  , _cfeLogicalResourceId  :: LogicalResourceId
+  , _cfePhysicalResourceId :: CompositeResourceId
   , _cfeResourceProperties :: Object
   }
-  deriving Generic
+  deriving (Eq, Show, Generic)
 
 
 instance FromJSON CfEvent where