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=http://localhost
+export ELASTICSEARCH_PORT=9200

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
+
+

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,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;

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

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"]

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,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)

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}
+        <h1>Edit News</h1>
+        {renderForm news}
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "News" NewsAction
+                , breadcrumbText "Edit News"
+                ]
+
+renderForm :: News -> Html
+renderForm news = formFor news [hsx|
+    {(textField #title)}
+    {(textareaField #body)}
+    {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,24 @@
+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|
+    {(textField #title)}
+    {(textareaField #body)}
+    {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"
+                            ]