Add Search with elasticsearch and facets

.envrc

@@ -15,3 +15,5 @@ fi
 # Add your env vars here
 #
 # E.g. export AWS_ACCESS_KEY_ID="XXXXX"
+export ELASTICSEARCH_HOST=localhost
+export ELASTICSEARCH_PORT=9200

Application/Helper/Elasticsearch.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Application.Helper.Elasticsearch where
+
+import IHP.Prelude
+import IHP.ModelSupport
+import Database.Bloodhound
+import Network.HTTP.Client
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Aeson
+import IHP.ControllerPrelude
+
+import Generated.Types
+
+-- Make News an instance of ToJSON to allow serialization
+instance ToJSON News where
+    toJSON news = object
+        [ "id" .= (show news.id)
+        , "title" .= news.title
+        , "body" .= news.body
+        -- Add other fields as necessary
+        ]
+
+-- Initialize Elasticsearch connection
+initES :: (?context :: ControllerContext) => IO BHEnv
+initES = do
+    let server = ?context.frameworkConfig.esServer
+    manager <- newManager defaultManagerSettings
+    return $ mkBHEnv server manager
+
+-- Index a news item in Elasticsearch
+indexNews :: (?modelContext :: ModelContext, ?context :: ControllerContext) => News -> IO (Either BHError IndexResponse)
+indexNews news = do
+    bhenv <- initES
+    let indexName = IndexName "news_index"
+        docId = DocId $ T.pack $ "news_" <> show news.id
+    runBH bhenv $ indexDocument indexName (MappingName "document") (toJSON news) docId
+
+-- Search for news
+searchNews :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO [SearchResult Value]
+searchNews query = do
+    bhenv <- initES
+    let indexName = IndexName "news_index"
+        searchQuery = MultiMatchQuery ["title", "body"] (TE.encodeUtf8 query)
+        search = mkSearch (Just searchQuery) Nothing
+    result <- runBH bhenv $ searchByIndex indexName search
+    case result of
+        Left err -> do
+            putStrLn $ "Error: " ++ show err
+            return []
+        Right searchResult -> return $ hits $ searchHits searchResult
+
+-- Helper function to use in your controllers
+searchNewsHandler :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO [News]
+searchNewsHandler query = do
+    results <- searchNews query
+    return $ mapMaybe (decode . encode . sourceAsJSON) results

Application/Schema.sql

@@ -5,15 +5,13 @@ 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,
     password_hash TEXT NOT NULL,
     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,9 @@ 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
+);
 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;

Config/Config.hs

@@ -5,12 +5,14 @@ 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(..))
 
 data RsaKeys = RsaKeys { publicKey :: RSA.PublicKey, privateKey :: RSA.PrivateKey }
 
@@ -31,6 +33,15 @@ 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
+
+    liftIO $ putStrLn $ "Elasticsearch Server: " <> show esServer
+
+    option esServer
+
     -- Less verbose logs.
     logger <- liftIO $ newLogger def
       { level = Error

Web/Controller/News.hs

@@ -0,0 +1,55 @@
+module Web.Controller.News where
+
+import Web.Controller.Prelude
+import Web.View.News.Index
+import Web.View.News.New
+import Web.View.News.Edit
+import Web.View.News.Show
+
+instance Controller NewsController where
+    action NewsAction = do
+        news <- query @News |> fetch
+        render IndexView { .. }
+
+    action NewNewsAction = do
+        let news = newRecord
+        render NewView { .. }
+
+    action ShowNewsAction { newsId } = do
+        news <- fetch newsId
+        render ShowView { .. }
+
+    action EditNewsAction { newsId } = do
+        news <- fetch newsId
+        render EditView { .. }
+
+    action UpdateNewsAction { newsId } = do
+        news <- fetch newsId
+        news
+            |> buildNews
+            |> ifValid \case
+                Left news -> render EditView { .. }
+                Right news -> do
+                    news <- news |> updateRecord
+                    setSuccessMessage "News updated"
+                    redirectTo EditNewsAction { .. }
+
+    action CreateNewsAction = do
+        let news = newRecord @News
+        news
+            |> buildNews
+            |> ifValid \case
+                Left news -> render NewView { .. } 
+                Right news -> do
+                    news <- news |> createRecord
+                    setSuccessMessage "News created"
+                    redirectTo NewsAction
+
+    action DeleteNewsAction { newsId } = do
+        news <- fetch newsId
+        deleteRecord news
+        setSuccessMessage "News deleted"
+        redirectTo NewsAction
+
+buildNews news = news
+    |> fill @'[]

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

Web/Routes.hs

@@ -23,3 +23,6 @@ instance AutoRoute UsersController
 
 instance AutoRoute StyleGuideController
 
+
+instance AutoRoute NewsController
+

Web/Types.hs

@@ -93,3 +93,13 @@ 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) }
+    deriving (Eq, Show, Data)

Web/View/News/Edit.hs

@@ -0,0 +1,23 @@
+module Web.View.News.Edit where
+import Web.View.Prelude
+
+data EditView = EditView { news :: News }
+
+instance View EditView where
+    html EditView { .. } = [hsx|
+        {breadcrumb}
+        <h1>Edit News</h1>
+        {renderForm news}
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "News" NewsAction
+                , breadcrumbText "Edit News"
+                ]
+
+renderForm :: News -> Html
+renderForm news = formFor news [hsx|
+
+    {submitButton}
+
+|]

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}
+
+        <h1>Index<a href={pathTo NewNewsAction} class="btn btn-primary ms-4">+ New</a></h1>
+        <div class="table-responsive">
+            <table class="table">
+                <thead>
+                    <tr>
+                        <th>News</th>
+                        <th></th>
+                        <th></th>
+                        <th></th>
+                    </tr>
+                </thead>
+                <tbody>{forEach news renderNews}</tbody>
+            </table>
+
+        </div>
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "News" NewsAction
+                ]
+
+renderNews :: News -> Html
+renderNews news = [hsx|
+    <tr>
+        <td>{news}</td>
+        <td><a href={ShowNewsAction news.id}>Show</a></td>
+        <td><a href={EditNewsAction news.id} class="text-muted">Edit</a></td>
+        <td><a href={DeleteNewsAction news.id} class="js-delete text-muted">Delete</a></td>
+    </tr>
+|]

Web/View/News/New.hs

@@ -0,0 +1,23 @@
+module Web.View.News.New where
+import Web.View.Prelude
+
+data NewView = NewView { news :: News }
+
+instance View NewView where
+    html NewView { .. } = [hsx|
+        {breadcrumb}
+        <h1>New News</h1>
+        {renderForm news}
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "News" NewsAction
+                , breadcrumbText "New News"
+                ]
+
+renderForm :: News -> Html
+renderForm news = formFor news [hsx|
+
+    {submitButton}
+
+|]

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}
+        <h1>Show News</h1>
+        <p>{news}</p>
+
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                            [ breadcrumbLink "News" NewsAction
+                            , breadcrumbText "Show News"
+                            ]

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
                     ];
                 };
 
@@ -53,10 +63,15 @@
                         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";
                 };
             };
-
         };
 }