diff --git a/infernal.cabal b/infernal.cabal --- a/infernal.cabal +++ b/infernal.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: fe4ff780bb0fb36d6c0cbda85811c8885ccf1ac40f4fae4f0cb83a7be7cfc641 +-- hash: 3e72ee8a176a23ff4e8b2e60f739ffe4798421d4f70cbd236dc7c34e7e953d2d name: infernal -version: 0.4.0 +version: 0.5.0 synopsis: The Infernal Machine - An AWS Lambda Custom Runtime for Haskell description: Please see the README on GitHub at category: AWS @@ -28,9 +28,6 @@ exposed-modules: Infernal Infernal.Events.APIGateway - Infernal.Internal.App - Infernal.Internal.Logging - Infernal.Internal.RIO Infernal.Wai other-modules: Paths_infernal @@ -44,19 +41,17 @@ , binary >=0.8 , bytestring >=0.10 , case-insensitive >=1.2 - , co-log >=0.4 - , co-log-core >=0.2 - , containers >=0.6 , exceptions >=0.10 , hashable >=1.3 , http-client >=0.6 , http-types >=0.12 + , little-logger >=0.1 + , little-rio >=0.1 , microlens >=0.4 , microlens-mtl >=0.2 , microlens-th >=0.4 , mtl >=2.2 , text >=1.2 - , unliftio >=0.2 , unliftio-core >=0.1 , unordered-containers >=0.2 , wai >=3.2 diff --git a/src/Infernal.hs b/src/Infernal.hs --- a/src/Infernal.hs +++ b/src/Infernal.hs @@ -27,7 +27,7 @@ import Control.Monad (forever, void) import Control.Monad.Catch (MonadCatch (..), MonadThrow (..)) import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.IO.Unlift (UnliftIO (..), askUnliftIO) +import Control.Monad.IO.Unlift (UnliftIO (..)) import Control.Monad.Reader (MonadReader) import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecode, encode, pairs, (.=)) import qualified Data.ByteString.Lazy as LBS @@ -39,19 +39,19 @@ import qualified Data.Text as Text import Data.Text.Encoding (decodeUtf8, encodeUtf8) import GHC.Generics (Generic) -import Infernal.Internal.App (App, newApp) -import Infernal.Internal.Logging (HasSimpleLog (..), SimpleLogAction, WithSimpleLog, logDebug, logError, logException) -import Infernal.Internal.RIO (RIO, runRIO) import Lens.Micro (Lens') import Lens.Micro.Mtl (view) import Lens.Micro.TH (makeLenses) +import LittleLogger (HasSimpleLog (..), LogApp, SimpleLogAction, WithSimpleLog, logDebug, logError, logException, + newLogApp) +import LittleRIO (RIO, runRIO, unliftRIO) import qualified Network.HTTP.Client as HC import qualified Network.HTTP.Types as HT import Prelude +import System.Environment (getEnv) import System.Exit (ExitCode) import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout) import Text.Read (readMaybe) -import UnliftIO.Environment (getEnv) -- | The UUID associated with a Lambda request. newtype LambdaRequestId = LambdaRequestId @@ -229,8 +229,8 @@ logException err unliftInto unio (uncaughtErrCb err) -getEnvText :: (MonadThrow m, MonadIO m) => Text -> m Text -getEnvText = fmap Text.pack . getEnv . Text.unpack +getEnvText :: MonadIO m => Text -> m Text +getEnvText = liftIO . fmap Text.pack . getEnv . Text.unpack readLambdaVars :: (MonadThrow m, MonadIO m) => m LambdaVars readLambdaVars = do @@ -354,10 +354,6 @@ httpManagerSettings :: HC.ManagerSettings httpManagerSettings = HC.defaultManagerSettings { HC.managerResponseTimeout = HC.responseTimeoutNone } --- TODO This should go in heart-core, along with catch functions -unliftRIO :: MonadIO m => env -> m (UnliftIO (RIO env)) -unliftRIO env = liftIO (runRIO env askUnliftIO) - badRequestError :: Text -> LambdaError badRequestError reason = LambdaError "BadRequestError" ("Bad request: " <> reason) @@ -398,10 +394,10 @@ -- | A simple entrypoint that delegates to 'runLambda'. Use this as the body of your @main@ function if you want to get a Lambda function up and running quickly. -- All you need to do is provide a 'RunCallback' that handles JSON-encoded requests and returns JSON-encoded responses (or throws 'LambdaError' exceptions). -- Your callback has access to a simple logger (try 'logDebug', for example) whose output will be collected by Lambda and published to CloudWatch. -runSimpleLambda :: RunCallback (RIO App) -> IO () +runSimpleLambda :: RunCallback (RIO LogApp) -> IO () runSimpleLambda cb = do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering - let app = newApp + let app = newLogApp unio <- unliftRIO app runRIO app (runLambda unio defaultInitErrorCallback (const (pure (defaultCallbackConfig cb)))) diff --git a/src/Infernal/Internal/App.hs b/src/Infernal/Internal/App.hs deleted file mode 100644 --- a/src/Infernal/Internal/App.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-| A basic app wrapper. -} -module Infernal.Internal.App - ( App (..) - , newApp - ) where - -import Infernal.Internal.Logging (HasSimpleLog (..), SimpleLogAction, defaultSimpleLogAction) -import Lens.Micro.TH (makeLenses) - -newtype App = App - { _appLogAction :: SimpleLogAction - } - -$(makeLenses ''App) - -instance HasSimpleLog App where - simpleLogL = appLogAction - -newApp :: App -newApp = App defaultSimpleLogAction diff --git a/src/Infernal/Internal/Logging.hs b/src/Infernal/Internal/Logging.hs deleted file mode 100644 --- a/src/Infernal/Internal/Logging.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-| Basic logging based on co-log. -} -module Infernal.Internal.Logging - ( SimpleLogAction - , HasSimpleLog (..) - , WithSimpleLog - , defaultSimpleLogAction - , logMsg - , log - , logDebug - , logInfo - , logWarning - , logError - , logException - ) where - -import Colog.Actions (richMessageAction) -import Colog.Core.Action (LogAction (..)) -import Colog.Core.Severity (Severity (..)) -import Colog.Message (Message, Msg (..)) -import Control.Exception (Exception, displayException) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Reader (MonadReader (..)) -import Data.Text (Text) -import qualified Data.Text as Text -import GHC.Stack (HasCallStack, callStack, withFrozenCallStack) -import Lens.Micro (Lens') -import Lens.Micro.Mtl (view) -import Prelude hiding (log) - -type SimpleLogAction = LogAction IO Message - -class HasSimpleLog env where - simpleLogL :: Lens' env SimpleLogAction - -type WithSimpleLog env m = (MonadIO m, MonadReader env m, HasSimpleLog env, HasCallStack) - -defaultSimpleLogAction :: SimpleLogAction -defaultSimpleLogAction = richMessageAction - -logMsg :: WithSimpleLog env m => Message -> m () -logMsg msg = do - LogAction act <- view simpleLogL - liftIO (act msg) - -log :: WithSimpleLog env m => Severity -> Text -> m () -log sev txt = withFrozenCallStack (logMsg Msg { msgStack = callStack, msgSeverity = sev, msgText = txt }) - -logDebug :: WithSimpleLog env m => Text -> m () -logDebug = withFrozenCallStack (log Debug) - -logInfo :: WithSimpleLog env m => Text -> m () -logInfo = withFrozenCallStack (log Info) - -logWarning :: WithSimpleLog env m => Text -> m () -logWarning = withFrozenCallStack (log Warning) - -logError :: WithSimpleLog env m => Text -> m () -logError = withFrozenCallStack (log Error) - -logException :: forall e m env . (WithSimpleLog env m, Exception e) => e -> m () -logException = withFrozenCallStack (logError . Text.pack . displayException) diff --git a/src/Infernal/Internal/RIO.hs b/src/Infernal/Internal/RIO.hs deleted file mode 100644 --- a/src/Infernal/Internal/RIO.hs +++ /dev/null @@ -1,24 +0,0 @@ --- {-# LANGUAGE FlexibleInstances #-} --- {-# LANGUAGE FunctionalDependencies #-} --- {-# LANGUAGE UndecidableInstances #-} - -{- | -Most definitions follow the RIO lib: https://hackage.haskell.org/package/rio-0.1.14.0/docs/RIO.html -See LICENSE info in the README. --} -module Infernal.Internal.RIO - ( RIO - , runRIO - ) where - -import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.IO.Unlift (MonadUnliftIO) -import Control.Monad.Reader (MonadReader, ReaderT (..)) -import Prelude - -newtype RIO env a = RIO { unRIO :: ReaderT env IO a } - deriving (Functor, Applicative, Monad, MonadReader env, MonadIO, MonadThrow, MonadFail, MonadCatch, MonadMask, MonadUnliftIO) - -runRIO :: MonadIO m => env -> RIO env a -> m a -runRIO r m = liftIO (runReaderT (unRIO m) r) diff --git a/src/Infernal/Wai.hs b/src/Infernal/Wai.hs --- a/src/Infernal/Wai.hs +++ b/src/Infernal/Wai.hs @@ -21,7 +21,7 @@ import Data.Text.Encoding (decodeUtf8) import Infernal (RunCallback, decodeRequest, encodeResponse, runSimpleLambda) import Infernal.Events.APIGateway (APIGatewayProxyRequest (..), APIGatewayProxyResponse (..)) -import Infernal.Internal.Logging (WithSimpleLog, logDebug) +import LittleLogger (WithSimpleLog, logDebug) import Network.Wai (Application, Response, StreamingBody, defaultRequest, responseToStream) import Network.Wai.Internal (Request (..), ResponseReceived (..)) import Prelude