.envrc

@@ -1 +1 @@
-use flake
+use nix

README.md

@@ -2,14 +2,10 @@
 
 Personal, bare bones [readwise] alternative. 
 
-<http://quotes.dbalan.in>
-
 Have 
-- Parsers
-  - [-] Read from kindle
-  - [x] Read from readwise
-  - [x] Read from KOReader
-- [x] Minimal API
+- [ ] Parsers
+  - Read from kindle
+- [ ] Minimal API
   - Expose random-quote API
-- [x] Minimal UI
+- [ ] Minimal UI
   - Expose a webpage with random and whole quotes

app/Main.hs

@@ -11,31 +11,55 @@ import Servant
 import Control.Monad.IO.Class
 import Servant.HTML.Blaze
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-import Data.ByteString.Lazy (fromStrict)
+import Data.Text.Encoding (decodeUtf8)
+import Crypto.Argon2
+import Data.Text.Short (fromText, ShortText)
+import Data.ByteString (ByteString)
 
 import Api.Types
 import qualified Parsers.KOReader as KO
-import qualified Parsers.Readwise as RW
 import Config
 import Options.Applicative
-import Database
+
+data User = User
+  { username :: T.Text
+  , password :: ByteString
+  } deriving (Show, Eq)
 
 type API = Get '[HTML] Quote
          :<|> "quotes" :> Get '[JSON] [Quote]
          :<|> "quote" :> "random" :> Get '[JSON] Quote
          :<|> "today" :> Get '[HTML] Quote
-
+         :<|> BasicAuth "update data" User :> ("koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent)
 
 api :: Proxy API
 api = Proxy
 
+checkBasicAuth :: T.Text -> ShortText -> BasicAuthCheck User
+checkBasicAuth user passhash = BasicAuthCheck $ \authData ->
+  let username =  decodeUtf8 (basicAuthUsername authData)
+      password = basicAuthPassword authData
+  in
+    case user == username of
+      False -> return NoSuchUser
+      True -> case verifyEncoded passhash password of
+                 Argon2Ok -> return $ Authorized $ User username password
+                 _ -> return Unauthorized
+
+
+initDb :: FilePath -> IO ()
+initDb dbFile = withConnection dbFile $ \conn ->
+  execute_ conn
+    [sql|CREATE TABLE IF NOT EXISTS quotes ( quote text non null
+                                           , author text
+                                           , title text
+                                           , page text
+                                           , chapter text
+                                           , created_on integer);|]
+
 -- | TODO: readerT
 server :: FilePath -> Server API
-server dbf = randomQuote dbf
-      :<|> listQuotes dbf
-      :<|> randomQuote dbf
-      :<|> randomQuote dbf
+server dbf = randomQuote dbf :<|> listQuotes dbf :<|> randomQuote dbf :<|> randomQuote dbf :<|> (\_ -> addKoReader dbf)
 
 -- | API begins here
 randomQuote :: FilePath -> Handler Quote
@@ -52,18 +76,17 @@ listQuotes db = liftIO $ withConnection db $ \conn -> query_ conn [sql|SELECT *
 
 addKoReader :: FilePath -> KO.KoHighlight -> Handler NoContent
 addKoReader db hl = do
-  liftIO $ insertQts db (KO.parse hl)
-  pure NoContent
-
-addReadwise :: FilePath -> T.Text -> Handler NoContent
-addReadwise db hl = do
-  let
-    qts = RW.parse (fromStrict $ encodeUtf8 hl)
-  liftIO $ print $ show qts
+  liftIO $ withConnection db $ \c ->
+    executeMany c qry qts
   pure NoContent
+  where
+    qry = [sql|INSERT INTO quotes VALUES (?,?,?,?,?,?);|]
+    qts = KO.parse hl
 
 runApp :: AppConfig -> IO ()
-runApp c = run (appPort c) (serve api $ server (appDbFile c))
+runApp c = run (appPort c) (serveWithContext api ctx $ server (appDbFile c))
+  where
+    ctx = checkBasicAuth (appUser c) (fromText $ appPassHash c):. EmptyContext
 
 main :: IO ()
 main = do

flake.lock

@@ -1,60 +0,0 @@
-{
-  "nodes": {
-    "flake-utils": {
-      "inputs": {
-        "systems": "systems"
-      },
-      "locked": {
-        "lastModified": 1694529238,
-        "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
-        "owner": "numtide",
-        "repo": "flake-utils",
-        "rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
-        "type": "github"
-      },
-      "original": {
-        "owner": "numtide",
-        "repo": "flake-utils",
-        "type": "github"
-      }
-    },
-    "nixpkgs": {
-      "locked": {
-        "lastModified": 1699562885,
-        "narHash": "sha256-fb7RDv0ePGzayhGvkBh9NrilU3pCecgfbbTNPHprRfg=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "97b0ae26f7c8a1682b5437a64edcd73ab1798c9b",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
-    "root": {
-      "inputs": {
-        "flake-utils": "flake-utils",
-        "nixpkgs": "nixpkgs"
-      }
-    },
-    "systems": {
-      "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
-        "type": "github"
-      },
-      "original": {
-        "owner": "nix-systems",
-        "repo": "default",
-        "type": "github"
-      }
-    }
-  },
-  "root": "root",
-  "version": 7
-}

flake.nix

@@ -1,90 +0,0 @@
-# SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io/>
-#
-# SPDX-License-Identifier: CC0-1.0
-
-{
-  description = "quotes-api";
-
-  inputs = {
-    nixpkgs.url = "github:NixOS/nixpkgs";
-    flake-utils.url = "github:numtide/flake-utils";
-  };
-
-  outputs = { self, nixpkgs, flake-utils }:
-    flake-utils.lib.eachDefaultSystem (system:
-      let
-        pkgs = nixpkgs.legacyPackages.${system};
-        haskellPackages = pkgs.haskellPackages;
-
-        jailbreakUnbreak = pkg:
-          pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
-
-        # DON'T FORGET TO PUT YOUR PACKAGE NAME HERE, REMOVING `throw`
-        packageName = "quotes-api";
-      in {
-        packages.${packageName} = haskellPackages.callCabal2nix packageName self
-          rec {
-            # Dependency overrides go here
-          };
-
-        packages.default = self.packages.${system}.${packageName};
-        defaultPackage = self.packages.${system}.default;
-
-        nixosModules = {
-          quotes-api = { config, lib, pkgs, ... }:
-
-            with lib;
-            let cfg = config.services.quotes-api;
-            in {
-              options.services.quotes-api = {
-                enable = mkEnableOption "Enables quotes api service";
-
-                port = mkOption rec {
-                  type = types.int;
-                  default = 8123;
-                  example = default;
-                  description = "bind port";
-                };
-
-                dbpath = mkOption rec {
-                  type = types.string;
-                  default = "/tmp/sqlite.db";
-                  example = default;
-                  description = "Path to sqlite database";
-                };
-              };
-
-              config = mkIf cfg.enable {
-                systemd.services."quotes-api" = {
-                  wantedBy = [ "multi-user.target" ];
-
-                  serviceConfig =
-                    let pkg = self.packages.${pkgs.system}.default;
-                    in {
-                      Restart = "on-failure";
-                      ExecStart = "${pkg}/bin/quotes-api --port ${
-                          builtins.toString cfg.port
-                        } --dbpath ${cfg.dbpath}";
-                    };
-                };
-
-              };
-            };
-        };
-
-        nixosModule = self.nixosModules.${system}.quotes-api;
-
-        devShells.default = pkgs.mkShell {
-          buildInputs = with pkgs; [
-            haskellPackages.haskell-language-server # you must build it with your ghc to work
-            ghcid
-            hlint
-            ghc
-            cabal-install
-          ];
-          inputsFrom =
-            map (__getAttr "env") (__attrValues self.packages.${system});
-        };
-        devShell = self.devShells.${system}.default;
-      });
-}

importer/Main.hs

@@ -1,21 +0,0 @@
-import Options.Applicative
-import qualified Data.ByteString.Lazy as BSL
-
-import Config
-import Database
-
-import qualified Parsers.Readwise as RW
-
-runImporter :: FilePath -> FilePath -> IO ()
-runImporter db rw = do
-  x <- BSL.readFile rw
-  let y = RW.parse x
-  case y of
-    Left err -> print err
-    Right qts -> insertQts db qts
-
-main :: IO ()
-main = do
-  conf <- execParser importerParserOpts
-  initDb (ioAppDbFile conf)
-  runImporter (ioAppDbFile conf) (ioReadwiseFile conf)

lib/Config.hs

@@ -1,61 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Config
-  ( parserOpts
-  , AppConfig(..)
-  , importerParserOpts
-  , ImporterConfig(..)
-  ) where
-
-import Options.Applicative
-
-data AppConfig = AppConfig
-  { appPort :: Int
-  , appDbFile :: FilePath
-  } deriving (Show, Eq)
-
-appConfig :: Parser AppConfig
-appConfig = AppConfig
-  <$> option auto
-     ( long "port"
-     <> help "port to listen"
-     <> showDefault
-     <> value 8000
-     <> metavar "INT")
-   <*> strOption
-     ( long "dbpath"
-     <> help "sqlite db file path"
-     <> showDefault
-     <> value "quotes.db"
-     <> metavar "TARGET")
-
-parserOpts :: ParserInfo AppConfig
-parserOpts =  info (appConfig <**> helper)
-      ( fullDesc
-     <> progDesc "Serve Quotes API"
-     <> header "quotes api" )
-
-data ImporterConfig = ImporterConfig
-  { ioAppDbFile :: FilePath
-  , ioReadwiseFile :: FilePath
-  } deriving (Show, Eq)
-
-importerConfig :: Parser ImporterConfig
-importerConfig = ImporterConfig
-  <$> strOption
-     ( long "dbpath"
-     <> help "sqlite db file path"
-     <> showDefault
-     <> value "quotes.db"
-     <> metavar "TARGET")
-    <*> strOption
-     ( long "readwise"
-     <> help "readwise export file path"
-     <> showDefault
-     <> value "readwise.csv"
-     <> metavar "RWCSV")
-
-importerParserOpts :: ParserInfo ImporterConfig
-importerParserOpts = info (importerConfig <**> helper)
-  ( fullDesc
-  <> progDesc "Import data into db"
-  <> header "importer API")

lib/Database.hs

@@ -1,25 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Database where
-
-import Database.SQLite.Simple.QQ
-import Database.SQLite.Simple
-
-import Api.Types
-
-initDb :: FilePath -> IO ()
-initDb dbFile = withConnection dbFile $ \conn ->
-  execute_ conn
-    [sql|CREATE TABLE IF NOT EXISTS quotes ( quote text non null
-                                           , author text
-                                           , title text
-                                           , page text
-                                           , chapter text
-                                           , created_on integer);|]
-
-insertQts :: FilePath -> [Quote] -> IO ()
-insertQts db qts = do
-  withConnection db $ \c ->
-    executeMany c qry qts
-  where
-    qry = [sql|INSERT INTO quotes VALUES (?,?,?,?,?,?);|]

lib/Parsers/Readwise.hs

@@ -1,51 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Parsers.Readwise where
-
-import Data.Csv
-import Data.Text
-import Data.Vector (toList)
-import Data.ByteString.Lazy (ByteString)
-import Api.Types (Quote(..))
-
-data RwHighlight = RwHighlight { rhHightlight :: Text
-                               , rhTitle :: Text
-                               , rhAuthor :: Text
-                               , rhBookID :: Text
-                               , rhNote :: Text
-                               , rhColor :: Text
-                               , rhTags :: Text
-                               , rhLocationType :: Text
-                               , rhLocation :: Text
-                               , rhHighlighedAt :: Text
-                               , rhDocumentTags :: Text
-                               } deriving (Show, Eq)
-
-instance FromNamedRecord RwHighlight where
-  parseNamedRecord m = RwHighlight <$> m .: "Highlight"
-                                    <*> m .: "Book Title"
-                                    <*> m .: "Book Author"
-                                    <*> m .: "Amazon Book ID"
-                                    <*> m .: "Note"
-                                    <*> m .: "Color"
-                                    <*> m .: "Tags"
-                                    <*> m .: "Location Type"
-                                    <*> m .: "Location"
-                                    <*> m .: "Highlighted at"
-                                    <*> m .: "Document tags"
-
-parseDocument :: ByteString -> Either String [RwHighlight]
-parseDocument d = case decodeByName d of
-  Left err -> Left err
-  Right (_, va) -> Right $ toList va
-
-parse :: ByteString -> Either String [Quote]
-parse d = case parseDocument d of
-  Left err -> Left err
-  Right rw -> Right $ fmap (\r -> Quote { qQuote = rhHightlight r
-                                  , qAuthor = rhAuthor r
-                                  , qTitle = rhTitle r
-                                  , qPage = rhLocation r
-                                  , qChapter = Nothing
-                                  , qCreatedOn = Nothing
-                                }) rw

quotes-api.cabal

@@ -61,9 +61,7 @@ library
     -- Modules exported by the library.
     exposed-modules:  Api.Types,
                       Parsers.KOReader,
-                      Parsers.Readwise,
                       Config,
-                      Database,
     -- Modules included in this library but not exported.
     -- other-modules:
 
@@ -71,7 +69,7 @@ library
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:    base,
+    build-depends:    base ^>=4.16.3.0,
                       text,
                       aeson,
                       deriving-aeson,
@@ -81,8 +79,6 @@ library
                       blaze-markup,
                       blaze-html,
                       optparse-applicative,
-                      cassava,
-                      vector,
     -- Directories containing source files.
     hs-source-dirs:   lib
 
@@ -104,10 +100,10 @@ executable quotes-api
 
     -- Other library packages from which modules are imported.
     build-depends:
-        base,
-        sqlite-simple,
-        text,
-        servant-server,
+        base ^>=4.16.3.0,
+        sqlite-simple ^>=0.4.18.0,
+        text ^>=1.2.5.0,
+        servant-server ^>=0.19.1,
         wai,
         warp,
         aeson,
@@ -115,52 +111,15 @@ executable quotes-api
         quotes-api,
         servant-blaze,
         optparse-applicative,
+        argon2,
         text-short,
         bytestring,
-        QuickCheck,
-
     -- Directories containing source files.
     hs-source-dirs:   app
 
     -- Base language which the package is written in.
     default-language: Haskell2010
 
-
-executable quotes-importer
-    -- Import common warning flags.
-    import:           warnings
-
-    -- .hs or .lhs file containing the Main module.
-    main-is:          Main.hs
-
-    -- Modules included in this executable, other than Main.
-    -- other-modules:
-
-    -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
-
-    -- Other library packages from which modules are imported.
-    build-depends:
-        base,
-        sqlite-simple,
-        text,
-        servant-server,
-        wai,
-        warp,
-        aeson,
-        deriving-aeson,
-        quotes-api,
-        servant-blaze,
-        optparse-applicative,
-        text-short,
-        bytestring,
-        QuickCheck,
-    -- Directories containing source files.
-    hs-source-dirs:   importer
-
-    -- Base language which the package is written in.
-    default-language: Haskell2010
-
 test-suite quotes-api-test
     -- Import common warning flags.
     import:           warnings
@@ -185,5 +144,5 @@ test-suite quotes-api-test
 
     -- Test dependencies.
     build-depends:
-        base,
+        base ^>=4.16.3.0,
         quotes-api

shell.nix

@@ -0,0 +1,16 @@
+let
+  pkgs = import <unstable> { }; # pin the channel to ensure reproducibility!
+in
+pkgs.haskellPackages.developPackage {
+  root = ./.;
+  modifier = drv:
+    pkgs.haskell.lib.addBuildTools drv (with pkgs.haskellPackages;
+      [ cabal-install
+        ghcid
+        ghc
+        haskell-language-server
+        zlib
+        cabal-plan
+      ]);
+}
+