[nix] expose a nixos module

> Mostly because its less awkward to operate.

.envrc

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

README.md

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

app/Main.hs

@@ -11,55 +11,31 @@ import Servant
 import Control.Monad.IO.Class
 import Servant.HTML.Blaze
 import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8)
-import Crypto.Argon2
-import Data.Text.Short (fromText, ShortText)
-import Data.ByteString (ByteString)
+import Data.Text.Encoding (encodeUtf8)
+import Data.ByteString.Lazy (fromStrict)
 
 import Api.Types
 import qualified Parsers.KOReader as KO
+import qualified Parsers.Readwise as RW
 import Config
 import Options.Applicative
-
-data User = User
-  { username :: T.Text
-  , password :: ByteString
-  } deriving (Show, Eq)
+import Database
 
 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 :<|> (\_ -> addKoReader dbf)
+server dbf = randomQuote dbf
+      :<|> listQuotes dbf
+      :<|> randomQuote dbf
+      :<|> randomQuote dbf
 
 -- | API begins here
 randomQuote :: FilePath -> Handler Quote
@@ -76,17 +52,18 @@ listQuotes db = liftIO $ withConnection db $ \conn -> query_ conn [sql|SELECT *
 
 addKoReader :: FilePath -> KO.KoHighlight -> Handler NoContent
 addKoReader db hl = do
-  liftIO $ withConnection db $ \c ->
-    executeMany c qry qts
+  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
   pure NoContent
-  where
-    qry = [sql|INSERT INTO quotes VALUES (?,?,?,?,?,?);|]
-    qts = KO.parse hl
 
 runApp :: AppConfig -> IO ()
-runApp c = run (appPort c) (serveWithContext api ctx $ server (appDbFile c))
-  where
-    ctx = checkBasicAuth (appUser c) (fromText $ appPassHash c):. EmptyContext
+runApp c = run (appPort c) (serve api $ server (appDbFile c))
 
 main :: IO ()
 main = do

flake.lock

@@ -0,0 +1,60 @@
+{
+  "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

@@ -0,0 +1,90 @@
+# 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

@@ -0,0 +1,21 @@
+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

@@ -0,0 +1,61 @@
+{-# 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

@@ -0,0 +1,25 @@
+{-# 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

@@ -0,0 +1,51 @@
+{-# 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,7 +61,9 @@ 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:
 
@@ -69,7 +71,7 @@ library
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:    base ^>=4.16.3.0,
+    build-depends:    base,
                       text,
                       aeson,
                       deriving-aeson,
@@ -79,6 +81,8 @@ library
                       blaze-markup,
                       blaze-html,
                       optparse-applicative,
+                      cassava,
+                      vector,
     -- Directories containing source files.
     hs-source-dirs:   lib
 
@@ -100,10 +104,10 @@ executable quotes-api
 
     -- Other library packages from which modules are imported.
     build-depends:
-        base ^>=4.16.3.0,
-        sqlite-simple ^>=0.4.18.0,
-        text ^>=1.2.5.0,
-        servant-server ^>=0.19.1,
+        base,
+        sqlite-simple,
+        text,
+        servant-server,
         wai,
         warp,
         aeson,
@@ -111,15 +115,52 @@ 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
@@ -144,5 +185,5 @@ test-suite quotes-api-test
 
     -- Test dependencies.
     build-depends:
-        base ^>=4.16.3.0,
+        base,
         quotes-api

shell.nix

@@ -1,16 +0,0 @@
-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
-      ]);
-}
-