Add SSR implementation w/ help of bulmex

backend/app/schema.hs

@@ -3,8 +3,8 @@
 module Main where
 
 import           Database.PostgreSQL.Simple     (connectPostgreSQL)
-import           DB                             (checkedAwesomeDB)
-import           DB.Cli                         (PgConnectionString (..),
+import           Awe.Back.DB                             (checkedAwesomeDB)
+import           Awe.Back.DB.Cli                         (PgConnectionString (..),
                                                  postgresOptions,
                                                  unConnectionString)
 

backend/app/webservice.hs

@@ -1,61 +1,70 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
+
 module Main where
 
-import           Common.Xsrf
-import qualified Data.Text.Encoding         as Text
+import           Awe.Back.DB.Cli
+import           Awe.Back.Web
 import           Data.Time
 import           Database.PostgreSQL.Simple (connectPostgreSQL)
-import           DB.Cli
-import           Lib
+import           Network.URI
 import           Options.Applicative
+import           Reflex.Bulmex.Html
 import           Servant.Auth.Server
 
-newtype BackendSettings = BackendSettings {
-    serveFolder :: FilePath
-    }
+newtype BackendSettings = BackendSettings
+  { serveFolder :: FilePath
+  }
+
 defaultStaticFolder :: FilePath
-defaultStaticFolder
-  = "dist-ghcjs/build/x86_64-linux/ghcjs-8.4.0.1/frontend-1.0.0.0/x/webservice/build/webservice/webservice.jsexe"
+defaultStaticFolder =
+  "dist-ghcjs/build/x86_64-linux/ghcjs-8.4.0.1/frontend-1.0.0.0/x/webservice/build/webservice/webservice.jsexe"
 
 main :: IO ()
 main = do
-  (connString, BackendSettings{..}) <- readSettings
+  (connString, BackendSettings {..}) <- readSettings
   conn <- connectPostgreSQL $ unConnectionString connString
   jwtKey <- generateKey
-  let settings = ApiSettings
-        { cookieSettings = cookieConf
-        , jwtSettings    = defaultJWTSettings jwtKey
-        , connection     = conn
-        }
+  let settings =
+        ApiSettings
+          { cookieSettings = cookieConf
+          , jwtSettings = defaultJWTSettings jwtKey
+          , connection = conn
+          , headSettings =
+              HeadSettings
+                { _head_js =
+                    [defScript{
+                        _script_uri = maybe
+                          (error "could not parse uri all.js") id
+                          $ (parseURIReference "all.js")
+                        }]
+                , _head_css = []
+                , _head_title = "awesomeproj"
+                }
+          }
   webAppEntry settings serveFolder
-    where
+  where
     cookieConf =
       defaultCookieSettings
         { cookieIsSecure = NotSecure -- allow setting of cookies over http, the reason for this is that we should stop providing http support, *or*, give all features on http.
         , cookieMaxAge = Just $ secondsToDiffTime $ 60 * 60 * 24 * 365
-        , cookieXsrfSetting = Just $
-            def { xsrfCookieName = Text.encodeUtf8 cookieName
-                , xsrfHeaderName = Text.encodeUtf8 headerName
-                }
-
+        , cookieXsrfSetting = Nothing
         }
 
 readSettings :: IO (PgConnectionString, BackendSettings)
-readSettings = customExecParser (prefs showHelpOnError) $ info
-    (   helper
-    <*> ((,) <$> postgresOptions <*> backendOptions)
-    )
-    ( fullDesc <> Options.Applicative.header "Migrations" <> progDesc
-      "Running the webservice"
-    )
+readSettings =
+  customExecParser (prefs showHelpOnError) $
+  info
+    (helper <*> ((,) <$> postgresOptions <*> backendOptions))
+    (fullDesc <> Options.Applicative.header "Migrations" <>
+     progDesc "Running the webservice")
+
 backendOptions :: Parser BackendSettings
-backendOptions = BackendSettings <$> strOption
-    (  short 's'
-    <> long "static-folder"
-    <> metavar "STATIC_FOLDER_DIR"
-    <> value defaultStaticFolder
-    <> help "The Postgres database connection string"
-    <> showDefault
-    )
+backendOptions =
+  BackendSettings <$>
+  strOption
+    (short 's' <> long "static-folder" <> metavar "STATIC_FOLDER_DIR" <>
+     value defaultStaticFolder <>
+     help "The Postgres database connection string" <>
+     showDefault)

backend/backend.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: c9bb84b6e0fba921f586dcc9367235a10eed4748748d7e861f71a5f99ae31297
+-- hash: ccebb3de438d210e60bf1f6eafb9b7e95bcae54314ec7baea25e96e7f2d16f4c
 
 cabal-version:  >= 1.10
 name:           backend
@@ -34,22 +34,28 @@ library
     , beam-core
     , beam-migrate
     , beam-postgres
+    , bulmex
     , bytestring
     , common
     , cookie
+    , frontend
+    , network-uri
     , optparse-applicative ==0.14.3.0
     , postgresql-simple
+    , reflex-dom-core
     , servant-auth-server
+    , servant-fiat-content
     , servant-server
     , text
     , time
     , wai
     , wai-extra
     , warp
   exposed-modules:
-      DB
-      DB.Cli
-      Lib
+      Awe.Back.DB
+      Awe.Back.DB.Cli
+      Awe.Back.Render
+      Awe.Back.Web
   other-modules:
       Paths_backend
   default-language: Haskell2010
@@ -68,12 +74,17 @@ executable schema
     , beam-core
     , beam-migrate
     , beam-postgres
+    , bulmex
     , bytestring
     , common
     , cookie
+    , frontend
+    , network-uri
     , optparse-applicative ==0.14.3.0
     , postgresql-simple
+    , reflex-dom-core
     , servant-auth-server
+    , servant-fiat-content
     , servant-server
     , text
     , time
@@ -96,12 +107,17 @@ executable webservice
     , beam-core
     , beam-migrate
     , beam-postgres
+    , bulmex
     , bytestring
     , common
     , cookie
+    , frontend
+    , network-uri
     , optparse-applicative ==0.14.3.0
     , postgresql-simple
+    , reflex-dom-core
     , servant-auth-server
+    , servant-fiat-content
     , servant-server
     , text
     , time
@@ -125,12 +141,17 @@ test-suite awesome-project-name-test
     , beam-core
     , beam-migrate
     , beam-postgres
+    , bulmex
     , bytestring
     , common
     , cookie
+    , frontend
+    , network-uri
     , optparse-applicative ==0.14.3.0
     , postgresql-simple
+    , reflex-dom-core
     , servant-auth-server
+    , servant-fiat-content
     , servant-server
     , text
     , time

backend/package.yaml

@@ -39,6 +39,11 @@ dependencies:
 - servant-auth-server
 - cookie
 - time
+- frontend
+- servant-fiat-content
+- bulmex
+- reflex-dom-core
+- network-uri
 
 library:
   source-dirs: src

backend/src/DB.hs → backend/src/Awe/Back/DB.hs

@@ -8,12 +8,12 @@
 {-# LANGUAGE TypeFamilies          #-}
 
 -- | db structure and source of truth
-module DB where
+module Awe.Back.DB where
 import qualified Data.Text                       as Text
 import           Database.Beam
 import           Database.Beam.Backend.SQL.Types (SqlSerial)
 import           Database.Beam.Migrate
-import           Database.Beam.Postgres          (PgCommandSyntax, Postgres)
+import           Database.Beam.Postgres          (Postgres)
 
 
 data UserT f = User
@@ -65,4 +65,4 @@ awesomeDB :: DatabaseSettings Postgres AwesomeDb
 awesomeDB = unCheckDatabase checkedAwesomeDB
 
 checkedAwesomeDB :: CheckedDatabaseSettings Postgres AwesomeDb
-checkedAwesomeDB = defaultMigratableDbSettings @PgCommandSyntax
+checkedAwesomeDB = defaultMigratableDbSettings @Postgres

backend/src/DB/Cli.hs → backend/src/Awe/Back/DB/Cli.hs

@@ -2,7 +2,7 @@
 
 
 -- | Deal with db
-module DB.Cli where
+module Awe.Back.DB.Cli where
 
 import qualified Data.ByteString     as BS
 import           Data.Monoid         ((<>))

backend/src/Awe/Back/Render.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds     #-}
+{-# LANGUAGE TypeOperators #-}
+
+{-# OPTIONS_GHC -Wno-missing-monadfail-instances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+
+module Awe.Back.Render
+    ( renderHtmlEndpoint
+    ) where
+
+import           Awe.Common
+import           Awe.Front.Main
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.ByteString           as BS
+import           Reflex.Bulmex.Html        (HeadSettings, htmlWidget)
+import           Reflex.Dom.Builder.Static
+import           Servant
+import           Servant.Auth.Server
+
+renderHtmlEndpoint :: HeadSettings -> AuthResult User -> Handler BS.ByteString
+renderHtmlEndpoint settings authRes = do
+  liftIO $ do
+    putStrLn "authres is"
+    print authRes
+  fmap snd $ liftIO $ renderStatic $
+    htmlWidget settings $ main $ IniState $ toMaybe authRes
+
+toMaybe :: AuthResult User -> Maybe User
+toMaybe (Authenticated auth) = Just auth
+toMaybe _                    = Nothing

backend/src/Lib.hs → backend/src/Awe/Back/Web.hs

@@ -5,28 +5,31 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 
-module Lib
+module Awe.Back.Web
     ( webAppEntry, ApiSettings(..)
     ) where
 
-import           Common
+import           Awe.Common
 import           Control.Monad.IO.Class                   (liftIO)
 import           Network.Wai                              (Application)
-import qualified Network.Wai                              as Wai
 import           Network.Wai.Handler.Warp                 (run)
-import qualified Network.Wai.Middleware.Gzip              as Wai
+import           Reflex.Bulmex.Html                       (HeadSettings)
 import           Servant
 
+import qualified Awe.Back.DB                              as DB
 import           Database.Beam.Backend.SQL.BeamExtensions (runInsertReturningList)
 import           Database.PostgreSQL.Simple               (Connection)
-import qualified DB                                       as DB
 
+import           Awe.Back.Render
+import qualified Data.ByteString                          as BS
 import           Data.Text                                (pack, unpack)
 import qualified Database.Beam                            as Beam
 import qualified Database.Beam.Postgres                   as PgBeam
 import           Servant.Auth.Server
+import           Servant.HTML.Fiat
 
 type Webservice = ServiceAPI
+      :<|> Auth '[Cookie, JWT] User :> (Get '[HTML] BS.ByteString)
       :<|> Raw -- JS entry point
 
 webservice :: Proxy Webservice
@@ -44,13 +47,13 @@ messages conn message = do
   fromDb <- liftIO $
     PgBeam.runBeamPostgres conn $ do
       let user = from message
-      [foundUser] <- runInsertReturningList (DB._ausers DB.awesomeDB) $
+      [foundUser] <- runInsertReturningList $ Beam.insert (DB._ausers DB.awesomeDB) $
           Beam.insertExpressions [DB.User
             Beam.default_
             (Beam.val_ (pack $ name $ user ))
             (Beam.val_ (pack $ email $ user ))
         ]
-      _ <- runInsertReturningList (DB._messages DB.awesomeDB) $
+      _ <- runInsertReturningList  $ Beam.insert (DB._messages DB.awesomeDB) $
           Beam.insertExpressions
             [DB.Message
               Beam.default_
@@ -85,7 +88,9 @@ authenticatedServer _ _ = throwAll err401 -- unauthorized
 
 server :: ApiSettings -> FilePath -> Server Webservice
 server settings staticFolder =
-  (login settings :<|> authenticatedServer settings) :<|> serveDirectoryFileServer staticFolder
+  (login settings :<|> authenticatedServer settings)
+  :<|> renderHtmlEndpoint (headSettings settings)
+  :<|> serveDirectoryFileServer staticFolder
 
 app :: ApiSettings -> FilePath -> Application
 app settings staticFolder =
@@ -94,15 +99,13 @@ app settings staticFolder =
     context = cookieSettings settings :. jwtSettings settings :. EmptyContext
 
 webAppEntry :: ApiSettings -> FilePath -> IO ()
-webAppEntry settings staticFolder = run 6868 $ compress $ app settings staticFolder
-
-compress :: Wai.Middleware
-compress = Wai.gzip Wai.def { Wai.gzipFiles = Wai.GzipCompress }
+webAppEntry settings staticFolder = run 6868 $ app settings staticFolder
 
 data ApiSettings = ApiSettings
   { cookieSettings :: CookieSettings
   , jwtSettings    :: JWTSettings
   , connection     :: Connection
+  , headSettings   :: HeadSettings
   }
 
 -- doesn't make sense client side

common/common.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 9be3d5f45323cbd5330acd0d115f899bb18e3277e33f8f64c58ed5a89af6d334
+-- hash: 6b48da330913c712c7c9e5863a2bcdc56c43203abf94ac0b04dcb805fa2ee16f
 
 cabal-version:  >= 1.10
 name:           common
@@ -37,8 +37,8 @@ library
     , servant-auth
     , text
   exposed-modules:
-      Common
-      Common.Xsrf
+      Awe.Common
+      Awe.Common.Xsrf
   other-modules:
       Paths_common
   default-language: Haskell2010

common/src/Common.hs → common/src/Awe/Common.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Common where
+module Awe.Common where
 
 import           Data.Aeson   (FromJSON, ToJSON)
 import           Data.Proxy