Skip to content
This repository was archived by the owner on Feb 6, 2024. It is now read-only.

Commit 223568c

Browse files
committed
handler: add tests
1 parent 2c70352 commit 223568c

File tree

9 files changed

+207
-38
lines changed

9 files changed

+207
-38
lines changed

infra/default.nix

Lines changed: 59 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,66 @@
11
with { pkgs = import ./nix {}; };
22

3-
# TODO:
4-
# - plug DynamoDBLocal in tests
5-
# -> https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/DynamoDBLocal.html
6-
73
rec
84
{ function =
9-
pkgs.wai-lambda.wai-lambda-js-build-lambda "${handler}/bin/deckdeckgo-handler";
5+
pkgs.wai-lambda.wai-lambda-js-build-lambda "${handler}/bin/handler";
106

117
handler = pkgs.haskellPackagesStatic.deckdeckgo-handler;
8+
9+
dynamoJar = pkgs.runCommand "dynamodb-jar" { buildInputs = [ pkgs.gnutar ]; }
10+
''
11+
mkdir -p $out
12+
cd $out
13+
tar -xvf ${pkgs.sources.dynamodb}
14+
'';
15+
16+
test = pkgs.runCommand "tests" { buildInputs = [ pkgs.jre pkgs.curl pkgs.netcat pkgs.strace ]; }
17+
''
18+
19+
java -Djava.library.path=${dynamoJar}/DynamoDBLocal_lib -jar ${dynamoJar}/DynamoDBLocal.jar -sharedDb -port 8000 &
20+
21+
while ! nc -z 127.0.0.1 8000; do
22+
echo waiting for DynamoDB
23+
sleep 1
24+
done
25+
sleep 2
26+
27+
28+
ls ${pkgs.otherport}/lib
29+
30+
strace -f -e trace=network -s 10000 curl dynamodb.us-east-1.coo
31+
32+
exit 1
33+
34+
NIX_REDIRECTS=/etc/hosts=${hostsFile} \
35+
OLD_PORT=80 NEW_PORT=8000 \
36+
LD_PRELOAD="${pkgs.libredirect}/lib/libredirect.so ${pkgs.otherport}/lib/otherport.so" \
37+
AWS_DEFAULT_REGION=us-east-1 \
38+
AWS_ACCESS_KEY_ID=dummy \
39+
AWS_SECRET_ACCESS_KEY=dummy \
40+
strace curl dynamodb.us-east-1.amazonaws.com
41+
42+
NIX_REDIRECTS=/etc/hosts=${hostsFile} \
43+
OLD_PORT=80 NEW_PORT=8000 \
44+
LD_PRELOAD="${pkgs.libredirect}/lib/libredirect.so ${pkgs.otherport}/lib/otherport.so" \
45+
AWS_DEFAULT_REGION=us-east-1 \
46+
AWS_ACCESS_KEY_ID=dummy \
47+
AWS_SECRET_ACCESS_KEY=dummy \
48+
${handler}/bin/server &
49+
50+
while ! nc -z 127.0.0.1 8080; do
51+
echo waiting for warp
52+
sleep 1
53+
done
54+
55+
echo "Running tests"
56+
${handler}/bin/test
57+
58+
sleep 1
59+
60+
'';
61+
62+
hostsFile = pkgs.writeText "hosts"
63+
''
64+
127.0.0.1 dynamodb.us-east-1.amazonaws.com
65+
'';
1266
}

infra/handler/app/Handler.hs

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
import UnliftIO
2+
import qualified Network.AWS as Aws
3+
import qualified DeckGo.Handler
4+
import qualified Network.Wai.Handler.Lambda as Lambda
5+
import qualified Network.Wai.Middleware.Cors as Cors
6+
7+
main :: IO ()
8+
main = do
9+
hSetBuffering stdin LineBuffering
10+
hSetBuffering stdout LineBuffering
11+
12+
liftIO $ putStrLn "Booting..."
13+
env <- Aws.newEnv Aws.Discover
14+
15+
liftIO $ putStrLn "Booted!"
16+
Lambda.run $ Cors.simpleCors $ DeckGo.Handler.application env

infra/handler/app/Server.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
import qualified Network.AWS as Aws
2+
import qualified DeckGo.Handler
3+
import qualified Network.Wai.Handler.Warp as Warp
4+
5+
main :: IO ()
6+
main = do
7+
env <- Aws.newEnv Aws.Discover
8+
Warp.run 8080 $ DeckGo.Handler.application env

infra/handler/app/Test.hs

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
import Network.HTTP.Client (newManager, defaultManagerSettings)
2+
import Servant.API
3+
import Servant.Client
4+
import DeckGo.Handler
5+
6+
main :: IO ()
7+
main = do
8+
manager' <- newManager defaultManagerSettings
9+
res <- runClientM decksGet' (mkClientEnv manager' (BaseUrl Http "localhost" 8080 ""))
10+
case res of
11+
Left err -> putStrLn $ "Error: " ++ show err
12+
Right books -> putStrLn $ "Got " <> show (length books)
13+
14+
-- 'client' allows you to produce operations to query an API from a client.
15+
decksGet' :: ClientM [WithId DeckId Deck]
16+
((decksGet' :<|> _ :<|> _) :<|> _ ) = client api

infra/handler/package.yaml

Lines changed: 24 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,11 +15,33 @@ dependencies:
1515
- text
1616
- unliftio
1717
- unordered-containers
18+
- wai
1819
- wai-cors
1920
- wai-lambda
2021

2122
ghc-options:
2223
- -Wall
2324

24-
executable:
25-
main: Main.hs
25+
library:
26+
source-dirs: src
27+
28+
executables:
29+
30+
# The AWS Lambda handler
31+
handler:
32+
main: app/Handler.hs
33+
dependencies:
34+
- deckdeckgo-handler
35+
36+
server:
37+
main: app/Server.hs
38+
dependencies:
39+
- deckdeckgo-handler
40+
- warp
41+
42+
test:
43+
main: app/Test.hs
44+
dependencies:
45+
- deckdeckgo-handler
46+
- http-client
47+
- servant-client

infra/handler/Main.hs renamed to infra/handler/src/DeckGo/Handler.hs

Lines changed: 35 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
{-# LANGUAGE RecordWildCards #-}
99
{-# LANGUAGE TypeOperators #-}
1010

11+
module DeckGo.Handler where
12+
1113
import Control.Monad
1214
import Control.Lens hiding ((.=))
1315
import Data.Proxy
@@ -20,8 +22,7 @@ import Data.Aeson ((.=), (.:), (.!=), (.:?))
2022
import qualified Data.Aeson as Aeson
2123
import qualified Network.AWS as Aws
2224
import qualified Network.AWS.DynamoDB as DynamoDB
23-
import qualified Network.Wai.Handler.Lambda as Lambda
24-
import qualified Network.Wai.Middleware.Cors as Cors
25+
import qualified Network.Wai as Wai
2526
import qualified Servant as Servant
2627
import qualified System.Random as Random
2728

@@ -32,14 +33,14 @@ import qualified System.Random as Random
3233
data WithId id a = WithId id a
3334

3435
newtype DeckId = DeckId { unDeckId :: T.Text }
35-
deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData)
36+
deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData, ToHttpApiData)
3637

3738
data Deck = Deck
3839
{ deckSlides :: [SlideId]
3940
}
4041

4142
newtype SlideId = SlideId { unSlideId :: T.Text }
42-
deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData)
43+
deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData, ToHttpApiData)
4344

4445
data Slide = Slide
4546
{ slideContent :: T.Text
@@ -51,19 +52,47 @@ instance Aeson.FromJSON Deck where
5152
parseJSON = Aeson.withObject "decK" $ \obj ->
5253
Deck <$> obj .: "deck_slides"
5354

55+
instance Aeson.ToJSON Deck where
56+
toJSON deck = Aeson.object
57+
[ "deck_slides" .= deckSlides deck
58+
]
59+
5460
instance Aeson.FromJSON Slide where
5561
parseJSON = Aeson.withObject "slide" $ \obj ->
5662
Slide <$>
5763
obj .: "slide_content" <*>
5864
obj .: "slide_template" <*>
5965
obj .:? "slide_attributes" .!= HMS.empty
6066

67+
instance Aeson.ToJSON Slide where
68+
toJSON slide = Aeson.object
69+
[ "slide_template" .= slideTemplate slide
70+
, "slide_attributes" .= slideAttributes slide
71+
, "slide_content" .= slideContent slide
72+
]
73+
74+
instance Aeson.FromJSON (WithId DeckId Deck) where
75+
parseJSON = Aeson.withObject "WithId DeckId Deck" $ \o ->
76+
WithId <$>
77+
(DeckId <$> o .: "deck_id") <*>
78+
(Deck <$> o .: "deck_slides")
79+
6180
instance Aeson.ToJSON (WithId DeckId Deck) where
6281
toJSON (WithId deckId deck) = Aeson.object
6382
[ "deck_id" .= deckId
6483
, "deck_slides" .= deckSlides deck
6584
]
6685

86+
instance Aeson.FromJSON (WithId SlideId Slide) where
87+
parseJSON = Aeson.withObject "WithId SlideId Slide" $ \o ->
88+
WithId <$>
89+
(SlideId <$> o .: "slide_id") <*>
90+
(Slide <$>
91+
o .: "slide_content" <*>
92+
o .: "slide_template" <*>
93+
o .: "slide_attributes"
94+
)
95+
6796
instance Aeson.ToJSON (WithId SlideId Slide) where
6897
toJSON (WithId slideId slide) = Aeson.object
6998
[ "slide_id" .= slideId
@@ -93,16 +122,8 @@ api = Proxy
93122
-- SERVER
94123
------------------------------------------------------------------------------
95124

96-
main :: IO ()
97-
main = do
98-
hSetBuffering stdin LineBuffering
99-
hSetBuffering stdout LineBuffering
100-
101-
liftIO $ putStrLn "Booting..."
102-
env <- Aws.newEnv Aws.Discover
103-
104-
liftIO $ putStrLn "Booted!"
105-
Lambda.run $ Cors.simpleCors $ Servant.serve api (server env)
125+
application :: Aws.Env -> Wai.Application
126+
application env = Servant.serve api (server env)
106127

107128
server :: Aws.Env -> Servant.Server API
108129
server env = serveDecks :<|> serveSlides

infra/nix/default.nix

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,4 +42,8 @@ with rec
4242
pkgs //
4343
{ inherit haskellPackagesStatic haskellPackages sources wai-lambda;
4444
inherit (import sources.niv {}) niv;
45+
otherport = pkgs.stdenv.mkDerivation
46+
{ name = "otherport"; src = sources.otherport;
47+
installPhase = "mkdir -p $out/lib && cp otherport.so $out/lib";
48+
} ;
4549
}

infra/nix/sources.json

Lines changed: 22 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,24 @@
2020
"description": "Nixpkgs/NixOS branches that track the Nixpkgs/NixOS channels",
2121
"rev": "88ae8f7d55efa457c95187011eb410d097108445"
2222
},
23+
"dynamodb": {
24+
"url": "https://s3.eu-central-1.amazonaws.com/dynamodb-local-frankfurt/dynamodb_local_latest.tar.gz",
25+
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
26+
"type": "file",
27+
"sha256": "0hrwxg4igyll40y7l1s0icg55g247fl8cjs4rrcpjf8d7m0bb09j"
28+
},
29+
"otherport": {
30+
"homepage": "",
31+
"url": "https://github.com/FiloSottile/otherport/archive/9d67c3619c457e5f663a789ee7fd29295cac7870.tar.gz",
32+
"owner": "FiloSottile",
33+
"branch": "master",
34+
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
35+
"repo": "otherport",
36+
"type": "tarball",
37+
"sha256": "0553mq6wxhd4zvq73r3b1cp3s52anld099bc4pw9ny4mb20hrhm3",
38+
"description": "LD_PRELOAD hack to redirect connections to other ports",
39+
"rev": "9d67c3619c457e5f663a789ee7fd29295cac7870"
40+
},
2341
"static-haskell-nix": {
2442
"homepage": "",
2543
"url": "https://github.com/nh2/static-haskell-nix/archive/9781df8a48eade302d159ce63a7ab0c30247788c.tar.gz",
@@ -33,13 +51,14 @@
3351
},
3452
"niv": {
3553
"homepage": "https://github.com/nmattia/niv",
36-
"url": "https://github.com/nmattia/niv/archive/7f72d723d00fcc3f177138acbfcf9d581beee9e1.tar.gz",
54+
"url": "https://github.com/nmattia/niv/archive/c2698b0780b783880e0b1a520723948fe3b5c26a.tar.gz",
3755
"owner": "nmattia",
3856
"branch": "master",
3957
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
4058
"repo": "niv",
41-
"sha256": "0177xhz55519xrak1fmv3gilbg8330lmbfkbizkc8zgp58skcmjw",
59+
"type": "tarball",
60+
"sha256": "0v68x0h9si6kjqg5fcjrgsbsf4x18m32a786yvjmrdkrki9qwmcq",
4261
"description": "Easy dependency management for Nix projects",
43-
"rev": "7f72d723d00fcc3f177138acbfcf9d581beee9e1"
62+
"rev": "c2698b0780b783880e0b1a520723948fe3b5c26a"
4463
}
4564
}

infra/nix/sources.nix

Lines changed: 23 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,35 @@
1+
# This file has been generated by Niv.
2+
13
# A record, from name to path, of the third-party packages
2-
with
4+
with rec
35
{
4-
versions = builtins.fromJSON (builtins.readFile ./sources.json);
6+
pkgs = import <nixpkgs> {};
57

6-
# fetchTarball version that is compatible between all the versions of Nix
7-
fetchTarball =
8-
{ url, sha256 }:
9-
if builtins.lessThan builtins.nixVersion "1.12" then
10-
builtins.fetchTarball { inherit url; }
11-
else
12-
builtins.fetchTarball { inherit url sha256; };
13-
};
8+
sources = builtins.fromJSON (builtins.readFile ./sources.json);
149

10+
mapAttrs = builtins.mapAttrs or
11+
(f: set: with builtins;
12+
listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)));
13+
14+
getFetcher = spec:
15+
let fetcherName =
16+
if builtins.hasAttr "type" spec
17+
then builtins.getAttr "type" spec
18+
else "tarball";
19+
in builtins.getAttr fetcherName {
20+
"tarball" = pkgs.fetchzip;
21+
"file" = pkgs.fetchurl;
22+
};
23+
};
1524
# NOTE: spec must _not_ have an "outPath" attribute
16-
builtins.mapAttrs (_: spec:
25+
mapAttrs (_: spec:
1726
if builtins.hasAttr "outPath" spec
1827
then abort
19-
"The values in versions.json should not have an 'outPath' attribute"
28+
"The values in sources.json should not have an 'outPath' attribute"
2029
else
2130
if builtins.hasAttr "url" spec && builtins.hasAttr "sha256" spec
2231
then
2332
spec //
24-
{ outPath = fetchTarball { inherit (spec) url sha256; } ; }
33+
{ outPath = getFetcher spec { inherit (spec) url sha256; } ; }
2534
else spec
26-
) versions
35+
) sources

0 commit comments

Comments
 (0)