Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit ec9559e

Browse files
committedNov 30, 2018
Init
0 parents  commit ec9559e

File tree

15 files changed

+3493
-0
lines changed

15 files changed

+3493
-0
lines changed
 

‎.gitignore

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
.stack-work/
2+
aws-lambda-haskell-runtime.cabal
3+
*~
4+
5+
# Created by https://www.gitignore.io/api/haskell
6+
# Edit at https://www.gitignore.io/?templates=haskell
7+
8+
### Haskell ###
9+
dist
10+
dist-*
11+
cabal-dev
12+
*.o
13+
*.hi
14+
*.chi
15+
*.chs.h
16+
*.dyn_o
17+
*.dyn_hi
18+
.hpc
19+
.hsenv
20+
.cabal-sandbox/
21+
cabal.sandbox.config
22+
*.prof
23+
*.aux
24+
*.hp
25+
*.eventlog
26+
.stack-work/
27+
cabal.project.local
28+
cabal.project.local~
29+
.HTF/
30+
.ghc.environment.*
31+
32+
# End of https://www.gitignore.io/api/haskell
33+
.DS_Store

‎.hlint.yaml

Lines changed: 2986 additions & 0 deletions
Large diffs are not rendered by default.

‎.stylish-haskell.yaml

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
steps:
2+
- simple_align:
3+
cases: true
4+
top_level_patterns: true
5+
records: true
6+
7+
# Import cleanup
8+
- imports:
9+
align: none
10+
list_align: after_alias
11+
pad_module_names: false
12+
long_list_align: inline
13+
empty_list_align: inherit
14+
list_padding: 4
15+
separate_lists: true
16+
space_surround: false
17+
18+
- language_pragmas:
19+
style: vertical
20+
remove_redundant: true
21+
22+
# Remove trailing whitespace
23+
- trailing_whitespace: {}
24+
25+
columns: 100
26+
27+
newline: native
28+
29+
language_extensions:
30+
- BangPatterns
31+
- ConstraintKinds
32+
- DataKinds
33+
- DefaultSignatures
34+
- DeriveAnyClass
35+
- DeriveDataTypeable
36+
- DeriveGeneric
37+
- DerivingStrategies
38+
- FlexibleContexts
39+
- FlexibleInstances
40+
- FunctionalDependencies
41+
- GADTs
42+
- GeneralizedNewtypeDeriving
43+
- InstanceSigs
44+
- KindSignatures
45+
- LambdaCase
46+
- MultiParamTypeClasses
47+
- MultiWayIf
48+
- NamedFieldPuns
49+
- NoImplicitPrelude
50+
- OverloadedStrings
51+
- QuasiQuotes
52+
- RecordWildCards
53+
- ScopedTypeVariables
54+
- StandaloneDeriving
55+
- TemplateHaskell
56+
- TupleSections
57+
- TypeApplications
58+
- TypeFamilies
59+
- ViewPatterns

‎ChangeLog.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
# Changelog for aws-lambda-haskell-runtime
2+
3+
## Unreleased changes

‎LICENSE

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright Author name here (c) 2018
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of Author name here nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎README.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
# aws-lambda-haskell-runtime

‎Setup.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

‎package.yaml

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
name: aws-lambda-haskell-runtime
2+
version: 0.1.0
3+
github: "theam/aws-lambda-haskell-runtime"
4+
license: Apache-2.0
5+
author: Nikita Tchayka
6+
maintainer: hackers@theagilemonkeys.com
7+
copyright: 2018 The Agile Monkeys SL
8+
9+
extra-source-files:
10+
- README.md
11+
- ChangeLog.md
12+
13+
synopsis: Haskell runtime for AWS Lambda
14+
category: AWS
15+
description: Please see the README on GitHub at <https://github.com/githubuser/aws-lambda-haskell-runtime#readme>
16+
17+
dependencies:
18+
- base >= 4.7 && < 5
19+
- aeson
20+
- loch-th
21+
- relude
22+
- time
23+
24+
library:
25+
source-dirs: src
26+
27+
tests:
28+
aws-lambda-haskell-runtime-test:
29+
main: Spec.hs
30+
source-dirs: test
31+
ghc-options:
32+
- -threaded
33+
- -rtsopts
34+
- -with-rtsopts=-N
35+
dependencies:
36+
- aws-lambda-haskell-runtime
37+
- hspec
38+
39+
default-extensions:
40+
- TemplateHaskell
41+
- OverloadedStrings
42+
- RecordWildCards
43+
- ScopedTypeVariables
44+
- NoImplicitPrelude
45+
46+
ghc-options:
47+
- -Wall
48+
- -Werror

‎src/AWS/Lambda/Context.hs

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
module AWS.Lambda.Context where
2+
3+
import Relude hiding ( identity )
4+
5+
import Data.Time.Clock.POSIX
6+
7+
import AWS.Lambda.Env
8+
9+
10+
-- TODO: Declare this in its own module
11+
data ClientContext
12+
13+
-- TODO: Declare this in its own module
14+
data CognitoIdentity
15+
16+
17+
data Context = Context
18+
{ memoryLimitInMb :: Int
19+
, functionName :: String
20+
, functionVersion :: String
21+
, invokedFunctionArn :: String
22+
, awsRequestId :: String
23+
, xrayTraceId :: String
24+
, logStreamName :: String
25+
, logGroupName :: String
26+
, clientContext :: Maybe ClientContext
27+
, identity :: Maybe CognitoIdentity
28+
, deadline :: Word
29+
}
30+
31+
makeContext :: FunctionSettings -> Context
32+
makeContext FunctionSettings {..} = Context
33+
{ xrayTraceId = ""
34+
, memoryLimitInMb = memorySize
35+
, functionName = functionName
36+
, functionVersion = version
37+
, logStreamName = logStream
38+
, logGroupName = logGroup
39+
, invokedFunctionArn = ""
40+
, awsRequestId = ""
41+
, clientContext = Nothing
42+
, identity = Nothing
43+
, deadline = 0
44+
}
45+
46+
getTimeRemainingMillis :: Context -> IO Int
47+
getTimeRemainingMillis Context {..} = do
48+
millis <- getPOSIXTime
49+
return (fromIntegral deadline - round millis)

‎src/AWS/Lambda/Env.hs

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
module AWS.Lambda.Env where
2+
3+
import Relude
4+
import System.Environment
5+
6+
import qualified AWS.Lambda.Error as Error
7+
8+
data FunctionSettings = FunctionSettings
9+
{ functionName :: String
10+
, memorySize :: Int
11+
, version :: String
12+
, logStream :: String
13+
, logGroup :: String
14+
}
15+
16+
data ProviderCapability = ProviderCapability
17+
{ getFunctionSettings :: IO (Either Error.RuntimeError FunctionSettings)
18+
, getRuntimeApiEndpoint :: IO (Either Error.RuntimeError String)
19+
}
20+
21+
envConfig :: ProviderCapability
22+
envConfig = ProviderCapability
23+
{ getFunctionSettings = do
24+
functionName <- lookupEnv "AWS_LAMBDA_FUNCTION_NAME"
25+
version <- lookupEnv "AWS_LAMBDA_FUNCTION_VERSION"
26+
logStream <- lookupEnv "AWS_LAMBDA_LOG_STREAM_NAME"
27+
logGroup <- lookupEnv "AWS_LAMBDA_LOG_GROUP_NAME"
28+
memoryStr <- lookupEnv "AWS_LAMBDA_FUNCTION_MEMORY_SIZE"
29+
let parsedMemory = memoryStr >>= readMaybe
30+
case parsedMemory of
31+
Nothing -> do
32+
err <-
33+
Error.newRuntimeError
34+
$ "Could not parse memory value: "
35+
<> (memoryStr ?: "<NOTHING>")
36+
<> "\nMemory value from environment is not an 'Int'"
37+
return $ Left err
38+
39+
Just (mem :: Int) -> return $ Right $ FunctionSettings
40+
{ functionName = fromMaybe "" functionName
41+
, version = fromMaybe "" version
42+
, logStream = fromMaybe "" logStream
43+
, logGroup = fromMaybe "" logGroup
44+
, memorySize = mem
45+
}
46+
, getRuntimeApiEndpoint = do
47+
endpoint <- lookupEnv "AWS_LAMBDA_RUNTIME_API"
48+
case endpoint of
49+
Nothing -> do
50+
err <- Error.newRuntimeError "Could not read endpoint, was it set?"
51+
return $ Left err
52+
Just ep -> return $ Right ep
53+
}

‎src/AWS/Lambda/Error.hs

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
module AWS.Lambda.Error where
2+
3+
import Relude
4+
import System.Environment
5+
import Debug.Trace.LocationTH
6+
7+
data RuntimeError = RuntimeError
8+
{ runtimeErrorMsg :: String
9+
, runtimeErrorStackTrace :: Maybe String
10+
, runtimeErrorRecoverable :: Bool
11+
, runtimeErrorRequestId :: Maybe String
12+
} deriving (Show)
13+
14+
data HandlerError = HandlerError
15+
{ handlerErrorMsg :: String
16+
, handlerErrorStackTrace :: Maybe String
17+
} deriving (Show)
18+
19+
unrecoverable :: RuntimeError
20+
unrecoverable = RuntimeError
21+
{ runtimeErrorMsg = ""
22+
, runtimeErrorStackTrace = Nothing
23+
, runtimeErrorRecoverable = False
24+
, runtimeErrorRequestId = Nothing
25+
}
26+
27+
newRuntimeError :: String -> IO RuntimeError
28+
newRuntimeError runtimeErrorMsg = do
29+
shouldTrace <- lookupEnv "HASKELL_BACKTRACE"
30+
let runtimeError = RuntimeError
31+
{ runtimeErrorMsg = runtimeErrorMsg
32+
, runtimeErrorStackTrace = Nothing
33+
, runtimeErrorRecoverable = True
34+
, runtimeErrorRequestId = Nothing
35+
}
36+
case shouldTrace of
37+
Just "1" -> do
38+
let tr = $__LOCATION__
39+
return $ runtimeError { runtimeErrorStackTrace = Just tr }
40+
41+
_ -> return runtimeError

‎src/AWS/Lambda/Runtime.hs

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
module AWS.Lambda.Runtime where
2+
3+
import Relude
4+
5+
import Data.Aeson
6+
7+
import qualified AWS.Lambda.Context as Context
8+
import qualified AWS.Lambda.Env as Env
9+
import qualified AWS.Lambda.Error as Error
10+
11+
defaultMaxRetries :: Int
12+
defaultMaxRetries = 3
13+
14+
type Handler e o = e -> Context.Context -> IO (Either Error.HandlerError o)
15+
16+
start :: (FromJSON e, ToJSON o) => Handler e o -> Option runtime -> IO ()
17+
start f = startWithConfig f Env.envConfig
18+
19+
startWithConfig
20+
:: (FromJSON e, ToJSON o)
21+
=> Handler e o
22+
-> Env.ProviderCapability
23+
-> Option runtime
24+
-> IO ()
25+
startWithConfig f Env.ProviderCapability {..} r = do
26+
let showError = error . toText . Error.runtimeErrorMsg
27+
-- endpoint <- either showError id <$> getRuntimeApiEndpoint
28+
functionSettings <- either showError id <$> getFunctionSettings
29+
runtimeClient <- either showError id <$> newRuntimeClient
30+
startWithRuntimeClient f functionSettings runtimeClient
31+
32+
33+
startWithRuntimeClient
34+
:: (FromJSON e, ToJSON o)
35+
=> Handler e o
36+
-> Env.FunctionSettings
37+
-> RuntimeClient
38+
-> IO ()
39+
startWithRuntimeClient = undefined
40+
41+
data Runtime e o = Runtime
42+
{ runtimeClient :: RuntimeClient
43+
, handler :: Handler e o
44+
, maxRetries :: Int
45+
, settings :: Env.FunctionSettings
46+
}
47+
48+
data RuntimeClient
49+
50+
newRuntimeClient :: IO (Either Error.RuntimeError RuntimeClient)
51+
newRuntimeClient = undefined
52+
53+
eventResponse :: RuntimeClient -> String -> w -> Maybe a
54+
eventResponse = undefined
55+
56+
eventError :: RuntimeClient -> String -> Maybe a
57+
eventError = undefined
58+
59+
startRuntime :: Runtime e o -> IO ()
60+
startRuntime = loopRuntime
61+
where
62+
loopRuntime Runtime {..} = do
63+
(event, ctx) <- getNextEvent 0 Nothing
64+
let requestId = Context.awsRequestId ctx
65+
let err :: Error.RuntimeError = undefined
66+
res <- event ctx
67+
case res of
68+
Just (response :: Int) -> do
69+
let responseBytes = encode response
70+
case eventResponse runtimeClient requestId responseBytes of
71+
Just _ ->
72+
putTextLn
73+
$ "Response for"
74+
<> show requestId
75+
<> "accepted by Runtime API"
76+
Nothing -> do
77+
putTextLn
78+
$ "Could not send response for "
79+
<> show requestId
80+
<> " to Runtime API: "
81+
<> show err
82+
unless
83+
(Error.runtimeErrorRecoverable err)
84+
(putTextLn
85+
"Error is not recoverable, sending fail_init signal and panicking."
86+
)
87+
88+
Nothing -> do
89+
putTextLn
90+
$ "Handler returned an error for "
91+
<> show requestId
92+
<> ": "
93+
<> show err
94+
<> ""
95+
96+
case eventError runtimeClient requestId of
97+
Just _ -> putTextLn "Error accepted by Runtime API"
98+
Nothing -> do
99+
putTextLn
100+
$ "Could not send response for "
101+
<> show requestId
102+
<> " to Runtime API: "
103+
<> show err
104+
105+
unless
106+
(Error.runtimeErrorRecoverable err)
107+
(putTextLn
108+
"Error is not recoverable, sending fail_init signal and panicking."
109+
)
110+
111+
getNextEvent :: Int -> Maybe error -> IO (e, Context.Context)
112+
getNextEvent = undefined

‎src/Lib.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
module Lib
2+
( someFunc
3+
)
4+
where
5+
6+
import Relude
7+
8+
someFunc :: IO ()
9+
someFunc = putTextLn "someFunc"

‎stack.yaml

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
# This file was automatically generated by 'stack init'
2+
#
3+
# Some commonly used options have been documented as comments in this file.
4+
# For advanced use and comprehensive documentation of the format, please see:
5+
# https://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+
# A snapshot resolver dictates the compiler version and the set of packages
9+
# to be used for project dependencies. For example:
10+
#
11+
# resolver: lts-3.5
12+
# resolver: nightly-2015-09-21
13+
# resolver: ghc-7.10.2
14+
#
15+
# The location of a snapshot can be provided as a file or url. Stack assumes
16+
# a snapshot provided as a file might change, whereas a url resource does not.
17+
#
18+
# resolver: ./custom-snapshot.yaml
19+
# resolver: https://example.com/snapshots/2018-01-01.yaml
20+
resolver: lts-12.13
21+
22+
# User packages to be built.
23+
# Various formats can be used as shown in the example below.
24+
#
25+
# packages:
26+
# - some-directory
27+
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28+
# - location:
29+
# git: https://github.com/commercialhaskell/stack.git
30+
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
31+
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
32+
# subdirs:
33+
# - auto-update
34+
# - wai
35+
packages:
36+
- .
37+
# Dependency packages to be pulled from upstream that are not in the resolver
38+
# using the same syntax as the packages field.
39+
# (e.g., acme-missiles-0.3)
40+
extra-deps:
41+
- fmt-0.6.1.1
42+
# Override default flag values for local packages and extra-deps
43+
# flags: {}
44+
45+
# Extra package databases containing global packages
46+
# extra-package-dbs: []
47+
48+
# Control whether we use the GHC we find on the path
49+
# system-ghc: true
50+
#
51+
# Require a specific version of stack, using version ranges
52+
# require-stack-version: -any # Default
53+
# require-stack-version: ">=1.9"
54+
#
55+
# Override the architecture used by stack, especially useful on Windows
56+
# arch: i386
57+
# arch: x86_64
58+
#
59+
# Extra directories used by stack for building
60+
# extra-include-dirs: [/path/to/dir]
61+
# extra-lib-dirs: [/path/to/dir]
62+
#
63+
# Allow a newer minor version of GHC than the snapshot specifies
64+
# compiler-check: newer-minor

‎test/Spec.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
import Relude
2+
main :: IO ()
3+
main = putTextLn "Test suite not yet implemented"

0 commit comments

Comments
 (0)
Please sign in to comment.