James/purr
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'feature/nixify-and-saltine'

Browse Source
This commit is contained in:
James Eversole 2024-02-16 18:30:37 -06:00
commit b4a5da0ed1
14 changed files with 239 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

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

89
Purr.cabal
View File

@ -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
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
executable Purr
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 && <1.41.2
, dhall >=1.40
, 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

51
README
View File

@ -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.
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:
Use Nix with flakes enabled.
1. Copy "examples/config.dhall" to ./config.dhall - configure this file appropriately.
- Use `openssl rand -hex 10` to generate an encryption key for "dbKey"
2. Copy "examples/Dockerfile" to ./Dockerfile
3. If using default database file location, run: `mkdir ./data; touch ./data/Purr.sqlite`
4. Run `chmod +x build-docker`
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`
Build binary and run natively:
nix build && ./result/bin/Purr-musl
Build and add Docker image to local registry:
nix build .#purr-docker && docker load < result
DEVELOPMENT & SUPPORT

0
TODO Normal file
View File

13
build-docker
View File

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

60
flake.lock generated Normal file
View File

@ -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
}

61
flake.nix Normal file
View File

@ -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 = ''
'';
};
};
});
}

12
package.yaml
View File

@ -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 && < 1.41.2
- dhall >= 1.40
- 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
- -optl-static
- -optl-pthread
#- -static
#- -optl-static
#- -optl-pthread
- -fPIC
dependencies:
- Purr

6
src/Core/SQLite.hs
View File

@ -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 = lift ask >>= (\a -> return $ dbKey a)
encKey :: IO ByteString
encKey = B.readFile "./data/key"
confLinkLength :: PurrAction Int
confLinkLength = lift ask >>= (\a -> return $ linkLength a)

4
src/Core/Types.hs
View File

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

68
src/Feature/Sharing/SQLite.hs
View File

@ -4,23 +4,25 @@ import Core.SQLite
import Core.Types
import Feature.Generation.Passwords (Password)
import Control.Monad.Reader (ask, lift, liftIO)
import Crypto.Simple.CBC (decrypt, encrypt)
import Data.List.Split (splitOn)
import Data.Maybe (listToMaybe)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Control.Monad.Reader (ask, lift, liftIO)
import Data.List.Split (splitOn)
import Data.Maybe (listToMaybe, fromMaybe, Maybe(Just))
import Data.Time.Clock.POSIX (getPOSIXTime)
import Database.SQLite.Simple
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as ET
import qualified Data.Text.Lazy as LT
import qualified Crypto.Saltine.Core.SecretBox as Box
import qualified Crypto.Saltine.Class as CL
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BSC8
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
encSec <- liftIO $ encryptSecret key sec
key <- liftIO encKey
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 (?, ?, ?, ?, ?, ?)"
(SecretEntry link (encodeSecret encSec) time life 0 maxViews)
"INSERT INTO pws (link, secret, nonce, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?, ?)"
(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
$ decryptSecret key
<$> decodeSecret
<$> listToMaybe sec )
let decSec = decryptSecret key secNonce $ decodeSecret $ safeHead failedSecret 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 k s = encrypt (B.pack k) (ET.encodeUtf8 s)
encryptSecret :: B.ByteString -> T.Text -> Box.Nonce -> B.ByteString
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 k b = decrypt (B.pack k) b
decryptSecret :: B.ByteString -> B.ByteString -> B.ByteString -> Maybe B.ByteString
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

2
src/Lib.hs
View File

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

27
stack.yaml
View File

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

20
stack.yaml.lock
View File

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