Skip to content

Commit 24b3b92

Browse files
paluhpaluh
committed
Add some basic session and selda test suits
1 parent 1ebc561 commit 24b3b92

File tree

7 files changed

+260
-10
lines changed

7 files changed

+260
-10
lines changed

‎package.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,8 @@
2020
},
2121
"homepage": "https://github.com/paluh/audiocarrier#readme",
2222
"dependencies": {
23-
"decimal.js": "^10.2.0",
24-
"pg": "^8.0.2",
23+
"decimal.js": "^10.2.1",
24+
"pg": "^8.4.1",
2525
"uuid": "^3.4.0",
2626
"uuid-validate": "0.0.3"
2727
}

‎packages.dhall

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,7 @@ let postgresql-client =
150150
, repo =
151151
"https://github.com/rightfold/purescript-postgresql-client.git"
152152
, version =
153-
"v3.0.0"
153+
"master"
154154
}
155155

156156
let selda =
@@ -172,7 +172,7 @@ let selda =
172172
, repo =
173173
"https://github.com/Kamirus/purescript-selda.git"
174174
, version =
175-
"master"
175+
"scope-as-backend"
176176
}
177177

178178
let prettyprinter =
@@ -318,13 +318,14 @@ let undefined-is-not-a-problem = ../purescript-undefined-is-not-a-problem/spago.
318318
-- }
319319

320320
let additions =
321-
{ selda = selda
321+
{ selda = ../selda/spago.dhall as Location
322322
-- , polyform = polyform
323323
-- , polyform-batteries = polyform-batteries
324324
, homogeneous = homogeneous
325325
, literal = literal
326326
, oneof = oneof
327327
, polyform = ../polyform/spago.dhall as Location
328+
, polyform-batteries-env = ../polyform-batteries-env/spago.dhall as Location
328329
, polyform-batteries = ../polyform-batteries/spago.dhall as Location
329330
, postgresql-client = postgresql-client
330331
, prettyprinter = prettyprinter

‎spago.dhall

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ You can edit this file as you like.
1515
, "optparse"
1616
, "polyform"
1717
, "polyform-batteries"
18+
, "polyform-batteries-env"
1819
, "postgresql-client"
1920
, "profunctor-lenses"
2021
, "psci-support"
@@ -29,6 +30,7 @@ You can edit this file as you like.
2930
, "smolder"
3031
, "spec"
3132
, "strings"
33+
, "string-parsers"
3234
, "typelevel-eval"
3335
, "undefined-is-not-a-problem"
3436
, "uuid"

‎test/Main.purs

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -9,11 +9,20 @@ import Test.Spec.Runner (runSpec)
99
import Test.WebRow.Applets (spec) as Applets
1010
import Test.WebRow.HTTP (spec) as HTTP
1111
import Test.WebRow.I18N (spec) as I18N
12+
import Test.WebRow.Selda (spec) as Selda
13+
import Test.WebRow.Selda.Config (load) as Test.Selda.Config
1214
import Test.WebRow.Session (spec) as Session
1315

1416
main :: Effect Unit
15-
main = launchAff_ $ runSpec [consoleReporter] do
16-
I18N.spec
17-
Applets.spec
18-
HTTP.spec
19-
Session.spec
17+
main = launchAff_ $ do
18+
19+
-- | I have to extract common Aff action here
20+
-- | so I don't repeat it on every test entry
21+
pool ← Test.Selda.Config.load
22+
runSpec [consoleReporter] do
23+
I18N.spec
24+
Applets.spec
25+
HTTP.spec
26+
Session.spec
27+
28+
Selda.spec pool

‎test/WebRow/Selda.purs

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
module Test.WebRow.Selda where
2+
3+
import Prelude
4+
5+
import Data.Maybe (Maybe(..))
6+
import Database.PostgreSQL (Pool) as PG
7+
import Effect.Aff (Aff)
8+
import Effect.Exception (throw)
9+
import Run (runBaseAff')
10+
import Run (liftEffect) as Run
11+
import Run.Except (catchAt, throwAt)
12+
import Selda (Table(..), aggregate, count, selectFrom)
13+
import Test.Spec (SpecT, describe, it)
14+
import Type.Prelude (SProxy(..))
15+
import Unsafe.Coerce (unsafeCoerce)
16+
import WebRow.Selda (_pgError, insert1_, pgExecute, query, query1, withTransaction)
17+
import WebRow.Selda (run) as Selda
18+
import WebRow.Testing.Assertions (shouldEqual)
19+
20+
type PeopleRow = ( age ∷ Maybe Int, id ∷ Int, name ∷ String )
21+
type Person = { | PeopleRow }
22+
23+
people ∷ Table PeopleRow
24+
people = Table { name: "people" }
25+
26+
_testErr = SProxy ∷ SProxy "testErr"
27+
28+
spec :: forall m. Monad m => PG.Pool -> SpecT Aff Unit m Unit
29+
spec pool = do
30+
let
31+
initDb = """
32+
DROP TABLE IF EXISTS people;
33+
CREATE TABLE people (
34+
id INTEGER PRIMARY KEY,
35+
name TEXT NOT NULL,
36+
age INTEGER
37+
);
38+
39+
DO $$
40+
BEGIN
41+
IF NOT EXISTS (SELECT 1 FROM pg_type WHERE typname = 'account_type') THEN
42+
CREATE TYPE ACCOUNT_TYPE as ENUM (
43+
'business',
44+
'personal'
45+
);
46+
END IF;
47+
END$$;
48+
49+
DROP TABLE IF EXISTS bank_accounts;
50+
CREATE TABLE bank_accounts (
51+
id INTEGER PRIMARY KEY,
52+
"personId" INTEGER NOT NULL,
53+
balance INTEGER NOT NULL,
54+
"accountType" ACCOUNT_TYPE NOT NULL
55+
);
56+
"""
57+
58+
describe "WebRow.Selda" do
59+
it "executes statements correctly" do
60+
runBaseAff'
61+
<<< catchAt _pgError (const $ pure unit)
62+
<<< Selda.run pool $ do
63+
pgExecute initDb
64+
p ← query $ selectFrom people pure
65+
p `shouldEqual` []
66+
67+
-- liftEffect $ log $ "NUMBER: " <> show number
68+
pure unit
69+
70+
it "commits after transaction" do
71+
runBaseAff'
72+
<<< catchAt _pgError (unsafeCoerce >>> throw >>> Run.liftEffect)
73+
<<< catchAt _testErr (const $ pure unit)
74+
<<< Selda.run pool $ do
75+
pgExecute initDb
76+
void $ withTransaction $ do
77+
insert1_ people { id: 1, name: "paluh", age: Nothing }
78+
pure unit
79+
80+
runBaseAff'
81+
<<< catchAt _pgError (unsafeCoerce >>> throw >>> Run.liftEffect)
82+
<<< catchAt _testErr (const $ pure unit)
83+
<<< Selda.run pool $ do
84+
{ n } <- query1 $ aggregate $ selectFrom people \r → pure { n: count r.id }
85+
n `shouldEqual` 1
86+
87+
it "rollbacks on error" do
88+
runBaseAff'
89+
<<< catchAt _pgError (\err → pure unit)
90+
-- <<< catchAt _pgError (\err → Run.liftEffect do
91+
-- log "WTF"
92+
-- traceM err
93+
-- throw $ unsafeCoerce err)
94+
<<< catchAt _testErr (const $ pure unit)
95+
<<< Selda.run pool $ do
96+
pgExecute initDb
97+
void $ withTransaction $ do
98+
void $ insert1_ people { id: 1, name: "foo", age: Nothing }
99+
100+
void $ withTransaction $ do
101+
void $ insert1_ people { id: 2, name: "bar", age: Nothing }
102+
throwAt _testErr "throw before COMMIT"
103+
pure unit
104+
105+
runBaseAff'
106+
<<< catchAt _pgError (unsafeCoerce >>> throw >>> Run.liftEffect)
107+
<<< catchAt _testErr (const $ pure unit)
108+
<<< Selda.run pool $ do
109+
{ n } <- query1 $ aggregate $ selectFrom people \r → pure { n: count r.id }
110+
n `shouldEqual` 1
111+

‎test/WebRow/Selda/Config.purs

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
module Test.WebRow.Selda.Config where
2+
3+
import Prelude
4+
5+
import Control.Monad.Error.Class (throwError)
6+
import Data.Either (Either(..))
7+
import Data.Map (fromFoldable) as Map
8+
import Data.Newtype (un)
9+
import Data.Validation.Semigroup (V(..))
10+
import Database.PostgreSQL (Pool, newPool)
11+
import Database.PostgreSQL (PoolConfiguration) as PG
12+
import Dotenv (loadFile) as DotEnv
13+
import Effect.Aff (Aff)
14+
import Effect.Class (class MonadEffect, liftEffect)
15+
import Effect.Exception (error)
16+
import Foreign.Object (toUnfoldable) as Object
17+
import Node.Process (getEnv)
18+
import Polyform.Batteries.Env (Env, Validator) as Env
19+
import Polyform.Batteries.Env (MissingValue)
20+
import Polyform.Batteries.Env.Validators (optional, required) as Env
21+
import Polyform.Batteries.Int (IntExpected)
22+
import Polyform.Batteries.Int (validator) as Int
23+
import Polyform.Validator (liftFnM, runValidator)
24+
import Type.Row (type (+))
25+
26+
poolConfiguration
27+
∷ ∀ err m
28+
. Monad m
29+
⇒ Env.Validator m (IntExpected + MissingValue + err) Env.Env PG.PoolConfiguration
30+
poolConfiguration = { database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ }
31+
<$> Env.required "PG_DB" identity
32+
<*> Env.optional "PG_HOST" identity
33+
<*> Env.optional "PG_IDLE_TIMEOUT_MILLISECONDS" Int.validator
34+
<*> Env.optional "PG_MAX" Int.validator
35+
<*> Env.optional "PG_PASSWORD" identity
36+
<*> Env.optional "PG_PORT" Int.validator
37+
<*> Env.optional "PG_USER" identity
38+
39+
pool ∷ ∀ err m. MonadEffect m ⇒ Env.Validator m (IntExpected + MissingValue + err) Env.Env Pool
40+
pool = poolConfiguration >>> liftFnM (newPool >>> liftEffect)
41+
42+
load :: Aff Pool
43+
load = do
44+
void $ DotEnv.loadFile
45+
env ← liftEffect $ getEnv <#> (Object.toUnfoldable ∷ _ → Array _) >>> Map.fromFoldable
46+
runValidator pool env >>= un V >>> case _ of
47+
Left err → do
48+
throwError $ error "Configuration error. Please verify your environment and .env file."
49+
Right p → pure p

‎test/WebRow/Session.purs

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
module Test.WebRow.Session where
2+
3+
import Prelude
4+
import Effect.Class (liftEffect) as Effect.Class
5+
import Effect.Exception (throw)
6+
import Effect.Ref (new) as Ref
7+
import Polyform.Batteries.Json.Duals (int) as Dual
8+
import Run (Run, liftEffect, runBaseEffect)
9+
import Run (on, run, send) as Run
10+
import Run.Except (catchAt)
11+
import Test.Spec (Spec, describe, it)
12+
import Type.Row (type (+))
13+
import WebRow.Contrib.Run (EffRow)
14+
import WebRow.Crypto (Secret(..))
15+
import WebRow.HTTP (CookieStore(..), HTTPExcept, SetHeader)
16+
import WebRow.HTTP.Cookies (runOnStore)
17+
import WebRow.HTTP.Response (_httpExcept, _setHeader)
18+
import WebRow.Session (fetch, save) as Session
19+
import WebRow.Session (runInCookieValue, runInMemoryStore)
20+
import WebRow.Testing.Assertions (shouldEqual)
21+
22+
spec :: Spec Unit
23+
spec = do
24+
let
25+
runHTTPExcept ∷ ∀ e. Run (EffRow + HTTPExcept + e) ~> Run (EffRow + e)
26+
runHTTPExcept action = catchAt _httpExcept (const $ liftEffect $ throw $ "TEST") action
27+
28+
runSetHeader ∷ ∀ e. Run (EffRow + SetHeader + e) Unit → Run (EffRow + e) Unit
29+
runSetHeader = do
30+
Run.run
31+
$ Run.on
32+
_setHeader
33+
(const $ pure $ pure unit)
34+
Run.send
35+
describe "WebRow.Session" do
36+
describe "in cookie value" do
37+
it "performs sudbsquent updates correctly" do
38+
let
39+
cookieStore =
40+
CookieStore
41+
{ requestCookies: mempty
42+
, secret: Secret "test"
43+
, responseCookies: mempty
44+
}
45+
46+
x =
47+
runBaseEffect
48+
$ runSetHeader
49+
$ runHTTPExcept
50+
$ runOnStore cookieStore
51+
$ runInCookieValue (Dual.int) (pure 0) do
52+
value1 ← Session.fetch
53+
Session.save (value1 + 1)
54+
value2 ← Session.fetch
55+
(value1 + 1) `shouldEqual` value2
56+
Effect.Class.liftEffect x
57+
describe "in memory store" do
58+
it "performs sudbsquent updates correctly" do
59+
store ← Effect.Class.liftEffect $ Ref.new mempty
60+
let
61+
cookieStore =
62+
CookieStore
63+
{ requestCookies: mempty
64+
, secret: Secret "test"
65+
, responseCookies: mempty
66+
}
67+
68+
x =
69+
runBaseEffect
70+
$ runSetHeader
71+
$ runHTTPExcept
72+
$ runOnStore cookieStore
73+
$ runInMemoryStore store 0 do
74+
value1 ← Session.fetch
75+
Session.save (value1 + 1)
76+
value2 ← Session.fetch
77+
(value1 + 1) `shouldEqual` value2
78+
Effect.Class.liftEffect x

0 commit comments

Comments
 (0)