Merge branch 'master' into master

.dockerignore

@@ -0,0 +1,5 @@
+.vscode
+.stack-work
+test
+Dockerfile
+docker-compose*.yaml

.gitignore

@@ -1,9 +1,8 @@
 .stack-work/
 *~
-conduit.dhall
-conduit-test.dhall
 conduit-server.cabal
 stack*.lock
 /.idea/
 /out/
 *.iml
+docker-compose.override.yaml

Dockerfile

@@ -0,0 +1,41 @@
+# builder
+FROM fpco/stack-build-small:lts-19.4 as base
+
+ARG DEBIAN_FRONTEND=noninteractive
+
+RUN apt update
+RUN apt install libpq-dev -y
+
+WORKDIR /app
+
+COPY stack.yaml .
+COPY package.yaml .
+
+RUN stack build --only-dependencies
+
+FROM base as builder
+
+WORKDIR /app
+
+COPY . .
+
+RUN stack --local-bin-path output install
+
+# runtime container
+FROM ubuntu:21.10
+
+RUN apt update
+
+RUN apt install libpq-dev libncurses5 -y
+
+ENV POSTGRES_CONNECT_STRING=host=localhost port=5432 user=postgres password=postgres dbname=conduit connect_timeout=10
+ENV POSTGRES_POOL_SIZE=1
+ENV JWK_STRING=
+
+WORKDIR /root/
+
+COPY --from=builder /app/output ./
+
+EXPOSE 8080
+
+CMD [ "./conduit-server-exe" ]

README.md

@@ -5,11 +5,10 @@ A Haskell implementation of **[realworld.io](https://realworld.io)**
 ## Tech stack
 
 - **RIO** is an alternative Prelude
-- **Rel8** for interacting with PostgreSQL databases
 - **Servant** for web api implementation
-- **Dhall** for configuration
 - **cryptonite** for Cryptography
 - **PostgreSQL** for persistence
+- **Rel8** for interacting with PostgreSQL databases
 
 ## Get start
 
@@ -17,15 +16,23 @@ A Haskell implementation of **[realworld.io](https://realworld.io)**
 git clone https://github.com/nodew/haskell-realworld-example.git
 cd haskell-realworld-example
 
-cat conduit.dhall.tpl > conduit.dhall
+# Run with docker
+docker-compose -f ./docker-compose.yml -f up
 
+# Otherwise, manually build
 stack build
+
+# Setup postgres connection string
+POSTGRES_CONNECT_STRING="host=localhost port=5432 user=postgres password=postgres dbname=conduit connect_timeout=10"
+# Setup default key for JWT
+JWK_STRING=xxxxxxxxxxxxxxxx
+
 stack exec conduit-server-exe
 ```
 
 ## TODO
 
-- [ ] Add integration tests
-- [ ] Add DB migrator
-- [ ] Build full static Haskell binaries with docker
-- [ ] Support docker compose
+- [x] Add integration tests
+- [x] Add DB migrator
+- [ ] Build full static Haskell binaries with docker or nix
+- [x] Support docker compose

app/Main.hs

@@ -1,12 +1,11 @@
 module Main where
 
 import RIO
-import Dhall
 
 import Conduit
 import Conduit.Config
 
 main :: IO ()
 main = do
-    config <- input auto "./conduit.dhall"
+    config <- loadConfigFromEnv
     runConduit config

conduit.dhall.tpl

@@ -1,11 +0,0 @@
-{ port = 8080
-, jwtSecret = "b66e721f-85a5-482d-9e34-1eb3c748c418"
-, db =
-    { port = 5432
-    , poolSize = 4
-    , host = "localhost"
-    , user = "postgres"
-    , passwd = "password"
-    , database = "conduit"
-    }
-}

docker-compose.override.yml

@@ -0,0 +1,12 @@
+version: '3.7'
+
+services:
+  conduit-server:
+    environment:
+      - POSTGRES_CONNECT_STRING=host=db port=5432 user=postgres password=postgres dbname=conduit connect_timeout=10
+      - POSTGRES_POOL_SIZE=4
+      - JWK_STRING=b3d3038c4f8c44589de316439d3d227c
+
+  db:
+    ports:
+      - "8432:5432"

docker-compose.yml

@@ -0,0 +1,53 @@
+version: '3.7'
+
+services:
+  conduit-www:
+    build:
+      context: ./nginx
+      args:
+        - UPSTREAM=http://conduit-server:8080/api
+    depends_on:
+      - conduit-server
+    ports:
+      - "8000:80"
+    restart: on-failure
+    networks:
+      - intranet
+
+  conduit-server:
+    build: .
+    depends_on:
+      - db
+    ports:
+      - "8080:8080"
+    environment:
+      - POSTGRES_CONNECT_STRING=host=db port=5432 user=postgres password=postgres dbname=conduit connect_timeout=10
+      - POSTGRES_POOL_SIZE=4
+      - JWK_STRING=b3d3038c4f8c44589de316439d3d227c
+    restart: on-failure
+    networks:
+      - intranet
+
+  db:
+    image: postgres:14.1
+    ports:
+      - "5432:5432"
+    environment:
+      - POSTGRES_USER=postgres
+      - POSTGRES_PASSWORD=postgres
+      - POSTGRES_DB=conduit
+      - PGDATA=/var/lib/postgresql/data/pgdata
+    volumes:
+      - type: volume
+        source: pgdata
+        target: /var/lib/postgresql/data/pgdata
+        read_only: false
+    networks:
+      - intranet
+
+volumes:
+  pgdata:
+
+networks:
+  intranet:
+

nginx/Dockerfile

@@ -0,0 +1,26 @@
+FROM node:lts-slim as builder
+
+ARG DEBIAN_FRONTEND=noninteractive
+
+RUN apt update
+
+RUN apt install git -y
+
+WORKDIR /app
+
+RUN git clone --depth=1 https://github.com/khaledosman/react-redux-realworld-example-app.git .
+RUN sed -i "s#https://conduit.productionready.io/api#/api#" ./src/agent.js
+
+RUN yarn install
+
+RUN yarn build
+
+FROM nginx:1.21.6-alpine
+
+ARG UPSTREAM="http://localhost:8080"
+
+COPY --from=builder /app/build /srv
+COPY nginx.conf /etc/nginx/conf.d/default.conf
+RUN sed -i "s#<upstream>#$UPSTREAM#" /etc/nginx/conf.d/default.conf
+
+EXPOSE 80

nginx/nginx.conf

@@ -0,0 +1,14 @@
+server{
+	listen 80;
+	server_name _;
+
+	location / {
+		root /srv;
+		index index.html;
+		try_files $uri $uri/ /index.html;
+	}
+
+	location /api {
+		proxy_pass <upstream>;
+	}
+}

package.yaml

@@ -20,37 +20,36 @@ extra-source-files:
 description:         Please see the README on GitHub at <https://github.com/nodew/haskell-realworld-example#readme>
 
 dependencies:
-- base >= 4.7 && < 5
-- rio
-- rel8
-- text
-- bytestring
-- base64-bytestring
-- uuid
-- random
-- data-default
 - aeson
-- lens
-- jose
+- base >= 4.7 && < 5
+- base64-bytestring
+- bytestring
 - cryptonite
-- memory
-- mtl
-- transformers
-- dhall
-- servant-server
-- servant-auth
-- servant-auth-server
-- wai
-- wai-logger
-- wai-extra
-- warp
-- hasql
-- hasql-transaction
-- hasql-migration
-- hasql-pool
-- time
+- data-default
 - extra
 - file-embed
+- hasql
+- hasql-migration
+- hasql-pool
+- hasql-transaction
+- jose
+- lens
+- memory
+- mtl
+- random
+- rel8
+- rio
+- servant-auth
+- servant-auth-server
+- servant-server
+- text
+- time
+- transformers
+- uuid
+- wai
+- wai-extra
+- wai-logger
+- warp
 
 default-extensions:
 - NoImplicitPrelude

src/Conduit.hs

@@ -47,8 +47,8 @@ mkApp env =
 
 runConduit :: Config -> IO ()
 runConduit cfg = do
-    let jwtKey = fromOctets . encodeUtf8 . cfgJwtSecret $ cfg
-    pool <- loadPool $ cfgDb cfg
+    let jwtKey = fromOctets . encodeUtf8 . cfgJwk $ cfg
+    pool <- loadPool (cfgConnectString cfg) (cfgPoolSize cfg)
     result <- autoMigrate pool
     whenJust result $ \e -> do
         error $ show e
@@ -58,11 +58,11 @@ runConduit cfg = do
                 }
     runApplication (cfgPort cfg) env
 
-runApplication :: Word16 -> AppEnv -> IO ()
+runApplication :: Int -> AppEnv -> IO ()
 runApplication port env = do
     warpLogger <- jsonRequestLogger
     let warpSettings = Warp.defaultSettings
-                     & Warp.setPort (fromIntegral port)
+                     & Warp.setPort port
                      & Warp.setTimeout 60
     Warp.runSettings warpSettings $ warpLogger $ mkApp env
 

src/Conduit/Api/Tag.hs

@@ -16,7 +16,10 @@ import Conduit.Db
 import Conduit.App
 
 newtype TagsResponse = TagsResponse
-    { tags :: [Text] } deriving (Generic, ToJSON)
+    { tags :: [Text] } deriving (Generic)
+
+instance ToJSON TagsResponse where
+    toJSON (TagsResponse a) = object ["tags" .= a]
 
 type TagApi = "tags" :> Get '[JSON] TagsResponse
 

src/Conduit/Config.hs

@@ -1,46 +1,40 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
 
 module Conduit.Config where
 
 import RIO
-import Dhall
-import Hasql.Connection
-import qualified Data.Text as T
 import Data.Char (toLower)
+import System.Environment ( getEnv )
+import Conduit.Util (exitWithErrorMessage)
 
 data Config = Config
-    { cfgPort :: Word16
-    , cfgJwtSecret :: Text
-    , cfgDb :: DbConfig
+    { cfgPort :: Int
+    , cfgJwk :: Text
+    , cfgConnectString :: ByteString
+    , cfgPoolSize :: Int
     } deriving (Generic, Show)
 
-instance FromDhall Config where
-    autoWith _ = genericAutoWith $ mkDhallInterpretOptions 3
+loadConfigFromEnv :: IO Config
+loadConfigFromEnv = do
+    port <- getEnv' "8080" "APP_PORT"
+    jwk <- getEnv' "" "JWK_STRING"
+    connectString <- getEnv' "" "POSTGRES_CONNECT_STRING"
+    poolSize <- getEnv' "1" "POSTGRES_POOL_SIZE"
 
-data DbConfig = DbConfig
-    { dbPort     :: Word16
-    , dbHost     :: Text
-    , dbUser     :: Text
-    , dbPasswd   :: Text
-    , dbDatabase :: Text
-    , dbPoolSize :: Word16
-    } deriving (Generic, Show)
+    if null jwk then
+        exitWithErrorMessage "Environment variable JWK_STRING is missing"
+    else if null connectString then
+        exitWithErrorMessage "Environment variable POSTGRES_CONNECT_STRING is missing"
+    else
+        return $ Config
+            (readInt 8080 port)
+            (fromString jwk)
+            (fromString connectString)
+            (readInt 1 poolSize)
 
-instance FromDhall DbConfig where
-    autoWith _ = genericAutoWith $ mkDhallInterpretOptions 2
+readInt :: Int -> String -> Int
+readInt optional value = fromMaybe optional $ readMaybe value
 
-mkDhallInterpretOptions :: Int -> InterpretOptions
-mkDhallInterpretOptions prefixLength = defaultInterpretOptions { fieldModifier = headToLower . T.drop prefixLength }
-    where
-        headToLower x = T.pack [toLower $ T.head x] `T.append` T.tail x
-
-mapDbConfigToSettings :: DbConfig -> Settings
-mapDbConfigToSettings cfg =
-    settings host port user password database
-    where
-        host = encodeUtf8 $ dbHost cfg
-        port = dbPort cfg
-        user = encodeUtf8 $ dbUser cfg
-        password = encodeUtf8 $ dbPasswd cfg
-        database = encodeUtf8 $ dbDatabase cfg
+getEnv' :: String -> String -> IO String
+getEnv' optional key =
+    catch (getEnv key) (const $ pure optional :: IOException -> IO String)

src/Conduit/Db/Transaction.hs

@@ -15,11 +15,8 @@ import Conduit.Config
 import Conduit.App
 import Conduit.Environment
 
-loadPool :: DbConfig -> IO Pool
-loadPool cfg = acquire (poolSize, 1, postgresSettings)
-    where
-        postgresSettings = mapDbConfigToSettings cfg
-        poolSize = fromIntegral $ dbPoolSize cfg
+loadPool :: ByteString -> Int -> IO Pool
+loadPool connectString poolSize = acquire (poolSize, 1, connectString)
 
 runTransactionWithConnection :: MonadIO m => Connection -> Transaction b -> m b
 runTransactionWithConnection conn transaction = do

src/Conduit/Util.hs

@@ -10,6 +10,7 @@ import Data.UUID
 import System.Random
 import Data.ByteArray (Bytes, convert)
 import Data.Text.Encoding (decodeUtf8)
+import System.IO ( hPutStrLn )
 
 toJsonOptions :: Int -> Options
 toJsonOptions prefixLength =
@@ -32,3 +33,9 @@ fromTextToBytes = convert . encodeUtf8
 
 fromBytesToText :: Bytes -> Text
 fromBytesToText = decodeUtf8 . convert
+
+exitWithErrorMessageAndCode :: String -> ExitCode -> IO a
+exitWithErrorMessageAndCode str e = hPutStrLn stderr str >> exitWith e
+
+exitWithErrorMessage :: String -> IO a
+exitWithErrorMessage msg = exitWithErrorMessageAndCode msg (ExitFailure 2)

stack-8.10.6.yaml

@@ -1,4 +1,4 @@
-resolver: nightly-2021-10-29
+resolver: lts-18.8
 
 packages:
 - .
@@ -6,8 +6,12 @@ packages:
 allow-newer: true
 
 extra-deps:
-- rel8-1.2.0.0
+- rel8-1.2.1.0
 - hasql-1.4.5.1
 - hasql-migration-0.3.0
 - servant-auth-0.4.0.0
 - servant-auth-server-0.4.6.0
+- Cabal-3.4.1.0
+- directory-1.3.7.0
+- process-1.6.13.2
+- time-1.11.1.2

stack-9.2.2.yaml

@@ -0,0 +1,6 @@
+resolver: nightly-2022-04-18
+
+packages:
+- .
+
+allow-newer: true

stack.yaml

@@ -1,13 +1,6 @@
-resolver: lts-18.15
+resolver: lts-19.4
 
 packages:
 - .
 
 allow-newer: true
-
-extra-deps:
-- rel8-1.2.0.0
-- hasql-1.4.5.1
-- hasql-migration-0.3.0
-- servant-auth-0.4.0.0
-- servant-auth-server-0.4.6.0

test/Test/Conduit/TestHelper.hs

@@ -16,7 +16,6 @@ import qualified Data.ByteString as B
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import Dhall
 import Hasql.Transaction
 import Network.HTTP.Types
 import Network.Wai
@@ -27,12 +26,13 @@ import Test.Hspec
 import Test.Hspec.Wai
 import qualified Test.Hspec.Wai as THW
 import System.IO (putStrLn)
+import Conduit.Config
 
 loadTestEnv :: IO AppEnv
 loadTestEnv = do
-    cfg <- input auto "./conduit-test.dhall"
-    let jwtKey = fromOctets . encodeUtf8 . cfgJwtSecret $ cfg
-    pool <- loadPool $ cfgDb cfg
+    cfg <- loadConfigFromEnv
+    let jwtKey = fromOctets . encodeUtf8 . cfgJwk $ cfg
+    pool <- loadPool (cfgConnectString cfg) (cfgPoolSize cfg)
     result <- autoMigrate pool
     whenJust result $ \e -> do
         error $ show e