{-|
Module      : AWSLambda.Handler
Stability   : experimental
Portability : POSIX

Entry point for AWS Lambda handlers deployed with @serverless-haskell@ plugin.
-}
{-# LANGUAGE TypeApplications #-}

module AWSLambda.Handler
  ( lambdaMain
  ) where

import Control.Exception (bracket, try)

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Text as Aeson

import qualified Data.ByteString as ByteString

import qualified Data.Text.Lazy.IO as Text

import GHC.IO.Handle
       (BufferMode(..), Handle, hClose, hSetBuffering)

import System.IO (stdout)
import System.Posix.Files (getFdStatus)
import System.Posix.IO (fdToHandle)
import System.Posix.Types (Fd(..))

-- | Process incoming events from @serverless-haskell@ using a provided
-- function.
--
-- The handler receives the input event given to the AWS Lambda function, and
-- its return value is returned from the function.
--
-- This is intended to be used as @main@, for example:
--
-- > import qualified Data.Aeson as Aeson
-- >
-- > import AWSLambda
-- >
-- > main = lambdaMain handler
-- >
-- > handler :: Aeson.Value -> IO [Int]
-- > handler evt = do
-- >   putStrLn "This should go to logs"
-- >   print evt
-- >   pure [1, 2, 3]
--
-- The handler function can receive arbitrary JSON values from custom
-- invocations, or one of the events from the "AWSLambda.Events" module, such as
-- 'AWSLambda.Events.S3Event':
--
-- > import AWSLambda.Events.S3Event
-- >
-- > handler :: S3Event -> IO ()
-- > handler evt = do
-- >   print $ records evt
--
-- If the Lambda function needs to process several types of events, use
-- 'Data.Aeson.Alternative' to combine several handlers:
--
-- > import AWSLambda
-- > import AWSLambda.Events.S3Event
-- > import Data.Aeson
-- > import Data.Aeson.Alternative
-- >
-- > main = lambdaMain $ handlerS3 `alternative` handlerCustom
-- >
-- > handlerS3 :: S3Event -> IO ()
-- > handlerS3 = _
-- >
-- > handlerCustom :: Value -> IO ()
-- > handlerCustom = _
--
-- When run outside the AWS Lambda environment, the input is read as JSON from
-- the command line, and the result of the execution is printed, also as JSON,
-- to the standard output.
lambdaMain ::
     (Aeson.FromJSON event, Aeson.ToJSON res)
  => (event -> IO res) -- ^ Function to process the event
  -> IO ()
lambdaMain :: (event -> IO res) -> IO ()
lambdaMain event -> IO res
act =
  (Handle -> IO ()) -> IO ()
forall r. (Handle -> IO r) -> IO r
withResultChannel ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
resultChannel -> do
    ByteString
input <- IO ByteString
ByteString.getLine
    case ByteString -> Either String event
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict ByteString
input of
      Left String
err -> String -> IO ()
forall a. HasCallStack => String -> a
error String
err
      Right event
event -> do
        res
result <- event -> IO res
act event
event
        Handle -> Text -> IO ()
Text.hPutStrLn Handle
resultChannel (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ res -> Text
forall a. ToJSON a => a -> Text
Aeson.encodeToLazyText res
result
        () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Invoke an action with the handle to write the results to. If called by the
-- JavaScript wrapper, use the channel opened by it, otherwise use standard
-- output. Also set line buffering on standard output for AWS Lambda so the logs
-- are output in a timely manner.
withResultChannel :: (Handle -> IO r) -> IO r
withResultChannel :: (Handle -> IO r) -> IO r
withResultChannel Handle -> IO r
act = do
  Either IOError FileStatus
commStatus <- forall a. Exception IOError => IO a -> IO (Either IOError a)
forall e a. Exception e => IO a -> IO (Either e a)
try @IOError (IO FileStatus -> IO (Either IOError FileStatus))
-> IO FileStatus -> IO (Either IOError FileStatus)
forall a b. (a -> b) -> a -> b
$ Fd -> IO FileStatus
getFdStatus Fd
communicationFd
  case Either IOError FileStatus
commStatus of
    Right FileStatus
_ -> do
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
      IO Handle -> (Handle -> IO ()) -> (Handle -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Fd -> IO Handle
fdToHandle Fd
communicationFd) Handle -> IO ()
hClose Handle -> IO r
act
    Left IOError
_ -> Handle -> IO r
act Handle
stdout

-- | File descriptor opened by the JavaScript wrapper to listen for the results
communicationFd :: Fd
communicationFd :: Fd
communicationFd = CInt -> Fd
Fd CInt
3