diff --git a/.envrc b/.envrc
index f978af2..1f5963d 100644
--- a/.envrc
+++ b/.envrc
@@ -15,3 +15,5 @@ fi
# Add your env vars here
#
# E.g. export AWS_ACCESS_KEY_ID="XXXXX"
+export ELASTICSEARCH_HOST=http://localhost
+export ELASTICSEARCH_PORT=9200
diff --git a/Application/Helper/Elasticsearch.hs b/Application/Helper/Elasticsearch.hs
new file mode 100644
index 0000000..ebee5ae
--- /dev/null
+++ b/Application/Helper/Elasticsearch.hs
@@ -0,0 +1,80 @@
+module Application.Helper.Elasticsearch where
+
+import IHP.Prelude
+import IHP.ModelSupport
+import Database.Bloodhound
+import Network.HTTP.Client (Manager, Response(..))
+import Control.Lens ((^.))
+import qualified Data.ByteString.Lazy as LBS
+import Data.Aeson (ToJSON, FromJSON, Value, toJSON, parseJSON, withObject, (.:), decode, object, (.=), eitherDecode)
+import IHP.ControllerSupport
+import qualified Data.Text as T
+import Prelude (read)
+
+import Generated.Types
+
+instance ToJSON News where
+ toJSON News {..} =
+ object
+ [ "type" .= ("news" :: Text)
+ , "title" .= title
+ , "body" .= body
+ ]
+
+-- Index a news item in Elasticsearch
+indexNews :: (?context :: ControllerContext) => News -> IO ()
+indexNews news = do
+ let
+ (esServer, esManager) = getAppConfig @(Server, Manager)
+ indexName = IndexName "news"
+ docId = DocId (show news.id)
+ document = toJSON news
+ settings = defaultIndexDocumentSettings
+
+ -- Execute the index request
+ response <- runBH (mkBHEnv esServer esManager) $ indexDocument indexName settings document docId
+ pure ()
+
+-- Delete a news item from Elasticsearch
+deleteIndexNews :: (?context :: ControllerContext) => Id News -> IO ()
+deleteIndexNews newsId = do
+ let
+ (esServer, esManager) = getAppConfig @(Server, Manager)
+ indexName = IndexName "news"
+ docId = DocId (show newsId)
+
+ -- Execute the delete request
+ response <- runBH (mkBHEnv esServer esManager) $ deleteDocument indexName docId
+ pure ()
+
+-- Search for news items in Elasticsearch
+searchNews :: (?context :: ControllerContext) => Text -> IO [Id News]
+searchNews queryText = do
+ -- Execute the search request
+ response <- runBH (mkBHEnv esServer esManager) $ searchByIndex indexName (mkSearch (Just query) Nothing)
+ -- Parse the response
+ result <- parseEsResponse response
+ case result of
+ Left esError -> do
+ -- Handle the error (log it, return empty list, or throw an exception)
+ liftIO $ putStrLn $ "Error occurred: " ++ show esError
+ return []
+ Right (searchResult :: SearchResult Value) -> do
+ -- Extract the News IDs from the search result
+
+ let newsIds :: [Id News] = map (textToId . unDocId . hitDocId) $ hits $ searchHits searchResult
+ liftIO $ putStrLn $ "newsIds: " ++ show newsIds
+ return newsIds
+
+ -- Parse result and extract the News ids. The News IDs is the Doc
+ pure []
+ where
+ (esServer, esManager) = getAppConfig @(Server, Manager)
+ indexName = IndexName "news"
+ -- @todo: Search all fields
+ query = QueryMultiMatchQuery $ mkMultiMatchQuery [(FieldName "title"), (FieldName "body")] (QueryString queryText)
+
+ unDocId :: DocId -> Text
+ unDocId (DocId t) = t
+
+
diff --git a/Application/Schema.sql b/Application/Schema.sql
index fa96c87..1b15722 100644
--- a/Application/Schema.sql
+++ b/Application/Schema.sql
@@ -5,7 +5,6 @@ BEGIN
END;
$$ language plpgsql;
-- Your database schema. Use the Schema Designer at http://localhost:8001/ to add some tables.
-
CREATE TABLE users (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
email TEXT NOT NULL,
@@ -13,7 +12,6 @@ CREATE TABLE users (
locked_at TIMESTAMP WITH TIME ZONE DEFAULT NULL,
failed_login_attempts INT DEFAULT 0 NOT NULL
);
-
CREATE TABLE landing_pages (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
@@ -40,6 +38,11 @@ CREATE TABLE paragraph_ctas (
);
CREATE INDEX paragraph_quotes_landing_page_id_index ON paragraph_quotes (landing_page_id);
CREATE INDEX paragraph_ctas_landing_page_id_index ON paragraph_ctas (landing_page_id);
+CREATE TABLE news (
+ id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+ title TEXT NOT NULL,
+ body TEXT NOT NULL
+);
ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION;
ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_ref_landing_page_id FOREIGN KEY (ref_landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION;
ALTER TABLE paragraph_quotes ADD CONSTRAINT paragraph_quotes_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION;
diff --git a/Config/Config.hs b/Config/Config.hs
index 1255ed4..e081906 100644
--- a/Config/Config.hs
+++ b/Config/Config.hs
@@ -5,12 +5,15 @@ import IHP.Environment
import IHP.FileStorage.Config
import IHP.FrameworkConfig ( ConfigBuilder, option )
import Web.View.CustomCSSFramework
+import IHP.EnvVar
import "cryptonite" Crypto.PubKey.RSA as RSA
import Control.Exception (catch)
import qualified Data.ByteString as BS
import Web.JWT
import qualified IHP.Log as Log
import IHP.Log.Types
+import Database.Bloodhound (Server(..))
+import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
data RsaKeys = RsaKeys { publicKey :: RSA.PublicKey, privateKey :: RSA.PrivateKey }
@@ -31,6 +34,16 @@ config = do
(Just privateKey, Just publicKey) -> option $ RsaKeys publicKey privateKey
_ -> error "Failed to read RSA keys, please execute from the root of your project: ssh-keygen -t rsa -b 4096 -m PEM -f ./Config/jwtRS256.key && openssl rsa -in ./Config/jwtRS256.key -pubout -outform PEM -out ./Config/jwtRS256.key.pub"
+ -- Elasticsearch configuration
+ esHost <- env @Text "ELASTICSEARCH_HOST"
+ esPort <- env @Int "ELASTICSEARCH_PORT"
+ let esServer = Server $ esHost ++ ":" ++ show esPort
+
+ -- Create a manager (you might want to do this in a more appropriate place)
+ esManager <- liftIO $ newManager defaultManagerSettings
+
+ option $ (esServer, esManager)
+
-- Less verbose logs.
logger <- liftIO $ newLogger def
{ level = Error
diff --git a/Web/Controller/News.hs b/Web/Controller/News.hs
new file mode 100644
index 0000000..0be7e3e
--- /dev/null
+++ b/Web/Controller/News.hs
@@ -0,0 +1,64 @@
+module Web.Controller.News where
+
+import Web.Controller.Prelude
+import Web.Controller.Prelude
+import Web.View.News.Index
+import Web.View.News.New
+import Web.View.News.Edit
+import Web.View.News.Show
+import Application.Helper.Elasticsearch
+
+instance Controller NewsController where
+ action NewsAction = do
+ news <- query @News |> fetch
+ searchNews "another"
+ render IndexView { .. }
+
+ action NewNewsAction = do
+ let news = newRecord
+ render NewView { .. }
+
+ action ShowNewsAction { .. } = do
+ news <- fetch newsId
+ render ShowView { .. }
+
+ action EditNewsAction { .. } = do
+ news <- fetch newsId
+ render EditView { .. }
+
+ action UpdateNewsAction { .. } = do
+ news <- fetch newsId
+ news
+ |> buildNews
+ |> ifValid \case
+ Left news -> render EditView { .. }
+ Right news -> do
+ news <- news |> updateRecord
+ indexNews news -- Index updated news in Elasticsearch
+ setSuccessMessage "News updated"
+ redirectTo NewsAction
+
+ action CreateNewsAction = do
+ let news = newRecord @News
+ news
+ |> buildNews
+ |> ifValid \case
+ Left news -> render NewView { .. }
+ Right news -> do
+ news <- news |> createRecord
+ indexNews news -- Index new news in Elasticsearch
+ setSuccessMessage "News created"
+ redirectTo NewsAction
+
+ action DeleteNewsAction { newsId } = do
+ news <- fetch newsId
+ deleteRecord news
+ deleteIndexNews newsId
+ setSuccessMessage "News deleted"
+ redirectTo NewsAction
+
+ action SearchNewsAction = do
+ undefined
+
+buildNews news = news
+ |> fill @["title", "body"]
\ No newline at end of file
diff --git a/Web/FrontController.hs b/Web/FrontController.hs
index 41ec05f..05afd4b 100644
--- a/Web/FrontController.hs
+++ b/Web/FrontController.hs
@@ -6,6 +6,7 @@ import Web.View.Layout (defaultLayout)
-- Controller Imports
+import Web.Controller.News
import Web.Controller.StyleGuide
import Web.Controller.Users
import Web.Controller.ImageStyle
@@ -20,6 +21,7 @@ instance FrontController WebApplication where
controllers =
[ startPage LandingPagesAction
-- Generator Marker
+ , parseRoute @NewsController
, parseRoute @StyleGuideController
, parseRoute @UsersController
, parseRoute @ImageStyleController
diff --git a/Web/Routes.hs b/Web/Routes.hs
index 0bd133d..e8936a0 100644
--- a/Web/Routes.hs
+++ b/Web/Routes.hs
@@ -23,3 +23,6 @@ instance AutoRoute UsersController
instance AutoRoute StyleGuideController
+
+instance AutoRoute NewsController
+
diff --git a/Web/Types.hs b/Web/Types.hs
index 5878b64..860ff3c 100644
--- a/Web/Types.hs
+++ b/Web/Types.hs
@@ -93,3 +93,14 @@ data UsersController
data StyleGuideController
= StyleGuideAction
deriving (Eq, Show, Data)
+
+data NewsController
+ = NewsAction
+ | NewNewsAction
+ | ShowNewsAction { newsId :: !(Id News) }
+ | CreateNewsAction
+ | EditNewsAction { newsId :: !(Id News) }
+ | UpdateNewsAction { newsId :: !(Id News) }
+ | DeleteNewsAction { newsId :: !(Id News) }
+ | SearchNewsAction
+ deriving (Eq, Show, Data)
diff --git a/Web/View/News/Edit.hs b/Web/View/News/Edit.hs
new file mode 100644
index 0000000..60dd735
--- /dev/null
+++ b/Web/View/News/Edit.hs
@@ -0,0 +1,24 @@
+module Web.View.News.Edit where
+import Web.View.Prelude
+
+data EditView = EditView { news :: News }
+
+instance View EditView where
+ html EditView { .. } = [hsx|
+ {breadcrumb}
+ Edit News
+ {renderForm news}
+ |]
+ where
+ breadcrumb = renderBreadcrumb
+ [ breadcrumbLink "News" NewsAction
+ , breadcrumbText "Edit News"
+ ]
+
+renderForm :: News -> Html
+renderForm news = formFor news [hsx|
+ {(textField #title)}
+ {(textareaField #body)}
+ {submitButton}
+
+|]
\ No newline at end of file
diff --git a/Web/View/News/Index.hs b/Web/View/News/Index.hs
new file mode 100644
index 0000000..db45d38
--- /dev/null
+++ b/Web/View/News/Index.hs
@@ -0,0 +1,39 @@
+module Web.View.News.Index where
+import Web.View.Prelude
+
+data IndexView = IndexView { news :: [News] }
+
+instance View IndexView where
+ html IndexView { .. } = [hsx|
+ {breadcrumb}
+
+
+
+
+
+
+ | News |
+ |
+ |
+ |
+
+
+ {forEach news renderNews}
+
+
+
+ | {news} |
+ Show |
+ Edit |
+ Delete |
+
+|]
\ No newline at end of file
diff --git a/Web/View/News/New.hs b/Web/View/News/New.hs
new file mode 100644
index 0000000..3cb1e98
--- /dev/null
+++ b/Web/View/News/New.hs
@@ -0,0 +1,24 @@
+module Web.View.News.New where
+import Web.View.Prelude
+
+data NewView = NewView { news :: News }
+
+instance View NewView where
+ html NewView { .. } = [hsx|
+ {breadcrumb}
+ New News
+ {renderForm news}
+ |]
+ where
+ breadcrumb = renderBreadcrumb
+ [ breadcrumbLink "News" NewsAction
+ , breadcrumbText "New News"
+ ]
+
+renderForm :: News -> Html
+renderForm news = formFor news [hsx|
+ {(textField #title)}
+ {(textareaField #body)}
+ {submitButton}
+
+|]
\ No newline at end of file
diff --git a/Web/View/News/Show.hs b/Web/View/News/Show.hs
new file mode 100644
index 0000000..3b44537
--- /dev/null
+++ b/Web/View/News/Show.hs
@@ -0,0 +1,17 @@
+module Web.View.News.Show where
+import Web.View.Prelude
+
+data ShowView = ShowView { news :: News }
+
+instance View ShowView where
+ html ShowView { .. } = [hsx|
+ {breadcrumb}
+ Show News
+ {news}
+
+ |]
+ where
+ breadcrumb = renderBreadcrumb
+ [ breadcrumbLink "News" NewsAction
+ , breadcrumbText "Show News"
+ ]
\ No newline at end of file
diff --git a/flake.lock b/flake.lock
index b0c6f47..5ec4627 100644
--- a/flake.lock
+++ b/flake.lock
@@ -421,11 +421,11 @@
"systems": "systems_6"
},
"locked": {
- "lastModified": 1719169242,
- "narHash": "sha256-gaF8AWDdKnJXErjfxJ3CUPFzo4ReWdb1V2CxKv8nxJA=",
+ "lastModified": 1721598516,
+ "narHash": "sha256-QC4cjxra227+9cQMDEqmuSs7q8mSubAAIn1cIMD+7jc=",
"owner": "digitallyinduced",
"repo": "ihp",
- "rev": "31ae4c859b0001ef581a15a9b546939b326e0ee3",
+ "rev": "c4b899367ad4fa788eafc48693e3c55d0094c467",
"type": "github"
},
"original": {
@@ -997,6 +997,7 @@
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
+ "rev": "54b4bb956f9891b872904abdb632cea85a033ff2",
"type": "github"
}
},
diff --git a/flake.nix b/flake.nix
index 322726a..6ce6acb 100644
--- a/flake.nix
+++ b/flake.nix
@@ -13,9 +13,16 @@
systems = import systems;
imports = [ ihp.flakeModules.default ];
- perSystem = { pkgs, ... }: {
+ perSystem = { pkgs, system, ... }: {
+ # Allow unfree packages
+ _module.args.pkgs = import inputs.nixpkgs {
+ inherit system;
+ config.allowUnfree = true;
+ };
+
ihp = {
enable = true;
+
projectPath = ./.;
packages = with pkgs; [
# Native dependencies, e.g. imagemagick
@@ -43,7 +50,10 @@
text
hlint
jwt
+ # Markdown
mmark
+ # Elasticsearch
+ bloodhound
hspec
];
};
@@ -54,10 +64,18 @@
tailwind.exec = "tailwindcss -c tailwind/tailwind.config.js -i ./tailwind/app.css -o static/app.css --watch=always";
};
+ # Enable Elasticsearch service
+ services.elasticsearch = {
+ enable = true;
+ package = pkgs.elasticsearch7;
+ };
+
# This is needed so when running tests in GitHub actions, we can execute `devenv up &` without an error.
- process.implementation = "overmind";
+ # Conditionally set process.implementation based on the presence of GITHUB_ACTIONS
+ process = pkgs.lib.mkIf (builtins.getEnv "GITHUB_ACTIONS" != "") {
+ implementation = "overmind";
+ };
};
};
-
};
}
\ No newline at end of file