Merge branch 'feature/nixify-and-saltine'

.gitignore

@@ -1,7 +1,10 @@
 data/
 bin/
+/result
 /config.dhall
 /Dockerfile
 /docker-stack.yml
 .stack-work/
+*.swp
+dist*
 *~

Purr.cabal

@@ -1,12 +1,8 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
---
--- see: https://github.com/sol/hpack
-
 name:           Purr
 version:        0.3.0
-description:    https://git.eversole.co/James/Purr
+description:    https://git.eversole.co/Purr
 author:         James Eversole
 maintainer:     james@eversole.co
 copyright:      2022 James Eversole
@@ -17,64 +13,11 @@ extra-source-files:
     README
     ChangeLog.md
 
-library
+executable Purr
-  exposed-modules:
-      Core.Configuration
-      Core.HTTP
-      Core.SQLite
-      Core.Templates
-      Core.Types
-      Feature.Generation.HTTP
-      Feature.Generation.Links
-      Feature.Generation.Passwords
-      Feature.Generation.Shared
-      Feature.Generation.Templates
-      Feature.Sharing.HTTP
-      Feature.Sharing.SQLite
-      Feature.Sharing.Templates
-      Lib
-  other-modules:
-      Paths_Purr
-  hs-source-dirs:
-      src
-  default-extensions:
-      ConstraintKinds
-      DeriveGeneric
-      FlexibleContexts
-      FlexibleInstances
-      GeneralizedNewtypeDeriving
-      OverloadedStrings
-      ScopedTypeVariables
-  build-depends:
-      base >=4.7
-    , base64-bytestring >=1.2.0.0
-    , blaze-html >=0.9.1.0
-    , bytestring >=0.10.12.1
-    , containers >=0.6.4.1
-    , crypto-simple >=0.1.0.0
-    , dhall >=1.40 && <1.41.2
-    , file-embed ==0.0.15.0
-    , http-types >=0.12.3
-    , iso8601-time >=0.1.5
-    , mtl >=2.2.2
-    , random >=1.2
-    , scotty ==0.12
-    , shakespeare >=2.0.20
-    , split >=0.2.3.4
-    , sqlite-simple >=0.4.18.0
-    , text >=1.2.5.0
-    , time >=1.9
-    , utf8-string ==1.0.2
-    , wai-extra >=3.1.12.1
-    , wai-middleware-static >=0.5
-  default-language: Haskell2010
-
-executable Purr-musl
   main-is: Main.hs
-  other-modules:
-      Paths_Purr
   hs-source-dirs:
       app
+      , src
   default-extensions:
       ConstraintKinds
       DeriveGeneric
@@ -83,22 +26,21 @@ executable Purr-musl
       GeneralizedNewtypeDeriving
       OverloadedStrings
       ScopedTypeVariables
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -static -optl-static -optl-pthread -fPIC
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
   build-depends:
-      Purr
+    base >=4.7
-    , base >=4.7
     , base64-bytestring >=1.2.0.0
     , blaze-html >=0.9.1.0
     , bytestring >=0.10.12.1
     , containers >=0.6.4.1
-    , crypto-simple >=0.1.0.0
+    , dhall >=1.40
-    , dhall >=1.40 && <1.41.2
     , file-embed ==0.0.15.0
     , http-types >=0.12.3
     , iso8601-time >=0.1.5
     , mtl >=2.2.2
     , random >=1.2
-    , scotty ==0.12
+    , saltine >=0.2.0.0
+    , scotty >=0.12
     , shakespeare >=2.0.20
     , split >=0.2.3.4
     , sqlite-simple >=0.4.18.0
@@ -107,4 +49,19 @@ executable Purr-musl
     , utf8-string ==1.0.2
     , wai-extra >=3.1.12.1
     , wai-middleware-static >=0.5
+  other-modules:
+    Core.Configuration
+    Core.HTTP
+    Core.SQLite
+    Core.Templates
+    Core.Types
+    Feature.Generation.HTTP
+    Feature.Generation.Links
+    Feature.Generation.Passwords
+    Feature.Generation.Shared
+    Feature.Generation.Templates
+    Feature.Sharing.HTTP
+    Feature.Sharing.SQLite
+    Feature.Sharing.Templates
+    Lib
   default-language: Haskell2010

README

@@ -1,8 +1,17 @@
 purr
 -----
 
+STATUS: BROKEN
+DETAILS: Currently unable to decrypt/unencode secrets written to the database. 
+This broke when converting to Nix because it was learned that the previous 
+crypto-simple library was out of date and needed to be replaced. Use commit
+b4bbf6e5a796d6dfc44ac0a052ec4949d2394927 if you want to build a 
+working project.
+
+
 https://purr.eversole.co 
-a work-in-progress web application offering customizable password generation and time-limited sharing of secrets.
+a work-in-progress web application offering customizable password generation 
+and time-limited sharing of secrets.
 
 TECH STACK
 
@@ -10,23 +19,35 @@ TECH STACK
 - HTMX frontend
 - SQLite database
 
+GOALS
+
+- Generate sufficiently memorable but secure passwords for use with accounts 
+that don't offer better authentication methods.
+
+- Share text secrets with others without disclosing the secret in the 
+message itself. 
+
+- Be really cute compared to the competition.
+
+- Provide a minimal and clean interface for generating and sharing passwords.
+
+- Maintain a clean and organized codebase that can be extended to include more
+utilities than originally anticipated.
+
+WHY TRUST YOU?
+
+You shouldn't. This is free and open-source software which you can run on your 
+own hardware.
+
 DEPLOYMENT
 
-purr is intended to run in a docker container. 
+Use Nix with flakes enabled.
-This repo's Stack project is configured to use a musl-based docker container for builds. 
-Assuming your working directory is inside of this repository:
 
-1. Copy "examples/config.dhall" to ./config.dhall - configure this file appropriately.
+Build binary and run natively:
-  - Use `openssl rand -hex 10` to generate an encryption key for "dbKey"
+nix build && ./result/bin/Purr-musl
-2. Copy "examples/Dockerfile" to ./Dockerfile
+
-3. If using default database file location, run: `mkdir ./data; touch ./data/Purr.sqlite`
+Build and add Docker image to local registry:
-4. Run `chmod +x build-docker`
+nix build .#purr-docker && docker load < result
-5. Run `./build-docker $IMAGE_NAME` to complete the initial Stack build and create the container
-6. Orchestrate the container as desired
-  - docker run -d -v "$(pwd -P)/data/Purr.sqlite:/app/data/Purr.sqlite" \
-    -v "$(pwd -P)/config.dhall:/app/config.dhall" \
-    -p 5195:3000 purr
- |- An example docker-stack.yml is provided: `docker stack deploy -c docker-stack.yml purr`
 
 DEVELOPMENT & SUPPORT
 

build-docker

@@ -1,13 +0,0 @@
-#!/bin/bash
-set -e
-# Date: 12/27/2022
-# Author: James Eversole
-# ISC License
-# This script completes a stack build and then builds a docker image
-# containing Purr. The image name is the first argument to the script.
-
-IMAGE_NAME=${1:-"purr"}
-
-stack setup
-stack build --copy-bins
-docker build . -t $IMAGE_NAME

flake.lock

@@ -0,0 +1,60 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
+      "locked": {
+        "lastModified": 1681202837,
+        "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "cfacdce06f30d2b68473a46042957675eebb3401",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1683159243,
+        "narHash": "sha256-Fh41KQcZTswb4NyYfSsbNEhDS/Im0/Id6m3k7qZ6/Xw=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "3a227d4f883aa6b39b1772041494f38a9a427595",
+        "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,61 @@
+{
+  description = "purr - a web application for generating and sharing secrets ";
+
+  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};
+        packageName       = "purr";
+        dockerPackageName = "${packageName}-docker";
+
+        haskellPackages = pkgs.haskellPackages;
+
+        enableSharedExecutables = false;
+        enableSharedLibraries = false;
+
+        purr = pkgs.haskell.lib.justStaticExecutables self.packages.${system}.default;
+      in {
+
+        packages.${packageName} =
+          haskellPackages.callCabal2nix packageName self rec {};
+
+        packages.default = self.packages.${system}.${packageName};
+        defaultPackage = self.packages.${system}.default;
+
+        devShells.default = pkgs.mkShell {
+          buildInputs = with pkgs; [
+            ghcid
+            cabal-install
+            ghc
+          ];
+          inputsFrom = builtins.attrValues self.packages.${system};
+        };
+        devShell = self.devShells.${system}.default;
+
+        packages.${dockerPackageName} = pkgs.dockerTools.buildImage {
+          name = "purr";
+
+          copyToRoot = pkgs.buildEnv {
+            name = "image-root";
+            paths = [ purr ];
+            pathsToLink = [ "/bin" ];
+          };
+          tag = "latest";
+          config = {
+            Cmd = [
+              "/bin/Purr"
+            ];
+            ExposedPorts = {
+              "3000/tcp" = {};
+            };
+            extraCommands = ''
+            '';
+          };
+        };
+      });
+}

package.yaml

@@ -33,14 +33,14 @@ dependencies:
 - blaze-html >= 0.9.1.0
 - bytestring >= 0.10.12.1
 - containers >= 0.6.4.1
-- crypto-simple >= 0.1.0.0
+- dhall >= 1.40
-- dhall >= 1.40 && < 1.41.2
 - file-embed == 0.0.15.0
 - http-types >= 0.12.3
 - iso8601-time >= 0.1.5 
 - mtl >= 2.2.2 
 - random >= 1.2
-- scotty == 0.12
+- saltine >= 0.2.0.0
+- scotty >= 0.12
 - shakespeare >= 2.0.20
 - sqlite-simple >= 0.4.18.0
 - split >= 0.2.3.4
@@ -61,9 +61,9 @@ executables:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
-    - -static 
+    #- -static 
-    - -optl-static 
+    #- -optl-static 
-    - -optl-pthread 
+    #- -optl-pthread 
     - -fPIC
     dependencies:
     - Purr

src/Core/SQLite.hs

@@ -3,6 +3,7 @@ module Core.SQLite where
 import           Core.Types
 
 import           Control.Monad.Reader           (ask, lift, liftIO)
+import           Data.ByteString                as B
 import           Database.SQLite.Simple
 import           Database.SQLite.Simple.FromRow
 
@@ -15,6 +16,7 @@ main db = do
     "CREATE TABLE IF NOT EXISTS pws\
     \ (link TEXT PRIMARY KEY,\
     \ secret TEXT,\
+    \ nonce TEXT,\
     \ date DATETIME DEFAULT CURRENT_TIMESTAMP,\
     \ life INT,\
     \ views INT,\
@@ -24,8 +26,8 @@ main db = do
 dbPath :: PurrAction String
 dbPath = lift ask >>= (\a -> return $ dbFile a)
 
-encKey :: PurrAction String
+encKey :: IO ByteString
-encKey = lift ask >>= (\a -> return $ dbKey a)
+encKey = B.readFile "./data/key"
 
 confLinkLength :: PurrAction Int
 confLinkLength = lift ask >>= (\a -> return $ linkLength a)

src/Core/Types.hs

@@ -2,7 +2,7 @@ module Core.Types where
 
 import qualified Data.Text                      as T
 import qualified Data.Text.Lazy                 as LT
-
+import           Data.ByteString as B
 import           Control.Monad.Reader           (MonadIO, MonadReader, ReaderT)
 import           Data.Text
 import           Database.SQLite.Simple         (ToRow)
@@ -34,7 +34,6 @@ data DhallConfig = DhallConfig
   , applicationHost :: String
   , applicationPort :: Int
   , dbFile          :: String
-  , dbKey           :: String
   , linkLength      :: Int
   , adminEmail      :: String
   } deriving (Generic, Show)
@@ -42,6 +41,7 @@ data DhallConfig = DhallConfig
 data SecretEntry = SecretEntry
   { link     :: T.Text
   , secret   :: T.Text
+  , nonce    :: B.ByteString
   , date     :: Integer
   , life     :: Integer
   , views    :: Integer

src/Feature/Sharing/SQLite.hs

@@ -4,23 +4,25 @@ import           Core.SQLite
 import           Core.Types
 import           Feature.Generation.Passwords (Password)
 
-import           Control.Monad.Reader         (ask, lift, liftIO)
+import           Control.Monad.Reader          (ask, lift, liftIO)
-import           Crypto.Simple.CBC            (decrypt, encrypt)
+import           Data.List.Split               (splitOn)
-import           Data.List.Split              (splitOn)
+import           Data.Maybe                    (listToMaybe, fromMaybe, Maybe(Just))
-import           Data.Maybe                   (listToMaybe)
+import           Data.Time.Clock.POSIX         (getPOSIXTime)
-import           Data.Time.Clock.POSIX        (getPOSIXTime)
 import           Database.SQLite.Simple
 
-import qualified Data.ByteString.Base64       as B64
+import qualified Crypto.Saltine.Core.SecretBox     as Box
-import qualified Data.ByteString.Char8        as B
+import qualified Crypto.Saltine.Class              as CL 
-import qualified Data.Text                    as T
+import qualified Data.ByteString.Base64            as B64
-import qualified Data.Text.Encoding           as ET
+import qualified Data.ByteString.Char8             as BSC8
-import qualified Data.Text.Lazy               as LT
+import qualified Data.ByteString                   as B
+import qualified Data.Text                         as T
+import qualified Data.Text.Encoding                as ET
+import qualified Data.Text.Lazy                    as LT
 
 findByLink :: String -> PurrAction (Maybe T.Text)
 findByLink link = do
   db    <- dbPath
-  key   <- encKey
+  key   <- liftIO encKey
   conn  <- liftIO $ open db
   res   <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
   liftIO $ close conn
@@ -29,27 +31,26 @@ findByLink link = do
 insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
 insertNewSecret sec life link maxViews = do
   db     <- dbPath
-  key    <- encKey
+  key    <- liftIO encKey
-  encSec <- liftIO $ encryptSecret key sec
+  nonce  <- liftIO $ Box.newNonce
+  let encSec = encryptSecret key sec nonce
   conn   <- liftIO $ open db
   time   <- liftIO $ epochTime
   liftIO  $ execute conn
-    "INSERT INTO pws (link, secret, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?)"
+    "INSERT INTO pws (link, secret, nonce, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?, ?)"
-      (SecretEntry link (encodeSecret encSec) time life 0 maxViews)
+      (SecretEntry link (encodeSecret encSec) (CL.encode nonce) time life 0 maxViews)
   liftIO  $ close conn
 
-readEncryptedSecret :: String -> [SecretEntry] -> PurrAction (Maybe T.Text)
+readEncryptedSecret :: B.ByteString -> [SecretEntry] -> PurrAction (Maybe T.Text)
 readEncryptedSecret key sec = do
   db     <- dbPath
-  liftIO  $ incViews sec db
+  let secNonce = nonce $ safeHead failedSecret sec
+  liftIO $ incViews sec db
   delete <- liftIO $ deleteExpiredSecret sec db
-  decKey <- liftIO ( sequence
+  let decSec = decryptSecret key secNonce $ decodeSecret $ safeHead failedSecret sec
-                   $ decryptSecret key
-                 <$> decodeSecret
-                 <$> listToMaybe sec )
   if (delete)
     then return Nothing
-    else return (ET.decodeLatin1 <$> decKey)
+    else return (ET.decodeLatin1 <$> decSec)
     where
       incViews :: [SecretEntry] -> String -> IO ()
       incViews []         _ = return ()
@@ -83,11 +84,26 @@ encodeSecret b = ET.decodeUtf8 $ B64.encode b
 decodeSecret :: SecretEntry -> B.ByteString
 decodeSecret s = B64.decodeLenient $ ET.encodeUtf8 (secret s)
 
-encryptSecret :: String -> T.Text -> IO B.ByteString
+encryptSecret :: B.ByteString -> T.Text -> Box.Nonce ->  B.ByteString
-encryptSecret k s = encrypt (B.pack k) (ET.encodeUtf8 s)
+encryptSecret k s n = do 
+  case (CL.decode k) of
+    (Just key) -> Box.secretbox key n (ET.encodeUtf8 s)
+    Nothing -> error "fail"
 
-decryptSecret :: String -> B.ByteString -> IO B.ByteString
+decryptSecret :: B.ByteString -> B.ByteString -> B.ByteString -> Maybe B.ByteString
-decryptSecret k b = decrypt (B.pack k) b
+decryptSecret k n b = do 
+  case (CL.decode k) of 
+    (Just key) -> case (CL.decode n) of
+      (Just nonce) -> Box.secretboxOpen key nonce b
+      Nothing -> error "Failed to decode nonce"
+    Nothing -> error "Failed to decode secret key"
 
 epochTime :: IO Integer
 epochTime = fmap round getPOSIXTime
+
+failedSecret :: SecretEntry
+failedSecret = SecretEntry "fail" "fail" (BSC8.pack "fail") 0 0 0 0
+
+safeHead :: a -> [a] -> a
+safeHead x [] = x
+safeHead x l  = head l

src/Lib.hs

@@ -6,12 +6,14 @@ import qualified Core.SQLite          as DB
 import           Core.Types
 
 import           Control.Monad.Reader (lift, liftIO, runReaderT)
+import           Crypto.Saltine       (sodiumInit)
 import           GHC.Natural          (popCountNatural)
 import           Prelude              hiding (id)
 import           Web.Scotty.Trans     (scottyT)
 
 main :: IO ()
 main = do
+  sodiumInit
   dhallConf <- liftIO Configuration.main
   DB.main (dbFile dhallConf)
   scottyT (applicationPort dhallConf) (flip runApp dhallConf) HTTP.app where

stack.yaml

@@ -1,27 +0,0 @@
-# This file was automatically generated by 'stack init'
-#
-resolver:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/13.yaml
-
-# User packages to be built.
-packages:
-- .
-#
-extra-deps:
-- crypto-simple-0.1.0.0@sha256:5c0e1e04a814d903743d7543245951a91a46817230fdf478fadca57116805fc1,1502
-
-docker:
-  enable: true
-  image: "utdemir/ghc-musl:v24-ghc902"
-
-local-bin-path:
-  ./bin
-#ghc-options:
-
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=2.7"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64

stack.yaml.lock

@@ -1,20 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
-
-packages:
-- completed:
-    hackage: crypto-simple-0.1.0.0@sha256:5c0e1e04a814d903743d7543245951a91a46817230fdf478fadca57116805fc1,1502
-    pantry-tree:
-      size: 472
-      sha256: 66c4ac2c2ddb74d31370026799a44fa78dc3b64d82cec0a1bc87b30e816195a4
-  original:
-    hackage: crypto-simple-0.1.0.0@sha256:5c0e1e04a814d903743d7543245951a91a46817230fdf478fadca57116805fc1,1502
-snapshots:
-- completed:
-    size: 618740
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/13.yaml
-    sha256: ef98d70e4018bf01feb00ccdcd33ab26d056dbb71b38057c78fdd0d1ec671c85
-  original:
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/13.yaml