Merge branch 'feature/nixify-and-saltine'
This commit is contained in:
commit
b4a5da0ed1
3
.gitignore
vendored
3
.gitignore
vendored
@ -1,7 +1,10 @@
|
|||||||
data/
|
data/
|
||||||
bin/
|
bin/
|
||||||
|
/result
|
||||||
/config.dhall
|
/config.dhall
|
||||||
/Dockerfile
|
/Dockerfile
|
||||||
/docker-stack.yml
|
/docker-stack.yml
|
||||||
.stack-work/
|
.stack-work/
|
||||||
|
*.swp
|
||||||
|
dist*
|
||||||
*~
|
*~
|
||||||
|
119
Purr.cabal
119
Purr.cabal
@ -1,12 +1,8 @@
|
|||||||
cabal-version: 1.12
|
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
|
name: Purr
|
||||||
version: 0.3.0
|
version: 0.3.0
|
||||||
description: https://git.eversole.co/James/Purr
|
description: https://git.eversole.co/Purr
|
||||||
author: James Eversole
|
author: James Eversole
|
||||||
maintainer: james@eversole.co
|
maintainer: james@eversole.co
|
||||||
copyright: 2022 James Eversole
|
copyright: 2022 James Eversole
|
||||||
@ -17,8 +13,43 @@ extra-source-files:
|
|||||||
README
|
README
|
||||||
ChangeLog.md
|
ChangeLog.md
|
||||||
|
|
||||||
library
|
executable Purr
|
||||||
exposed-modules:
|
main-is: Main.hs
|
||||||
|
hs-source-dirs:
|
||||||
|
app
|
||||||
|
, src
|
||||||
|
default-extensions:
|
||||||
|
ConstraintKinds
|
||||||
|
DeriveGeneric
|
||||||
|
FlexibleContexts
|
||||||
|
FlexibleInstances
|
||||||
|
GeneralizedNewtypeDeriving
|
||||||
|
OverloadedStrings
|
||||||
|
ScopedTypeVariables
|
||||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
|
||||||
|
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
|
||||||
|
, 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
|
||||||
|
, saltine >=0.2.0.0
|
||||||
|
, 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
|
||||||
|
other-modules:
|
||||||
Core.Configuration
|
Core.Configuration
|
||||||
Core.HTTP
|
Core.HTTP
|
||||||
Core.SQLite
|
Core.SQLite
|
||||||
@ -33,78 +64,4 @@ library
|
|||||||
Feature.Sharing.SQLite
|
Feature.Sharing.SQLite
|
||||||
Feature.Sharing.Templates
|
Feature.Sharing.Templates
|
||||||
Lib
|
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
|
|
||||||
default-extensions:
|
|
||||||
ConstraintKinds
|
|
||||||
DeriveGeneric
|
|
||||||
FlexibleContexts
|
|
||||||
FlexibleInstances
|
|
||||||
GeneralizedNewtypeDeriving
|
|
||||||
OverloadedStrings
|
|
||||||
ScopedTypeVariables
|
|
||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -static -optl-static -optl-pthread -fPIC
|
|
||||||
build-depends:
|
|
||||||
Purr
|
|
||||||
, 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
|
default-language: Haskell2010
|
||||||
|
51
README
51
README
@ -1,8 +1,17 @@
|
|||||||
purr
|
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
|
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
|
TECH STACK
|
||||||
|
|
||||||
@ -10,23 +19,35 @@ TECH STACK
|
|||||||
- HTMX frontend
|
- HTMX frontend
|
||||||
- SQLite database
|
- 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
|
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
|
DEVELOPMENT & SUPPORT
|
||||||
|
|
||||||
|
13
build-docker
13
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
|
|
60
flake.lock
generated
Normal file
60
flake.lock
generated
Normal 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
61
flake.nix
Normal 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
12
package.yaml
@ -33,14 +33,14 @@ dependencies:
|
|||||||
- blaze-html >= 0.9.1.0
|
- blaze-html >= 0.9.1.0
|
||||||
- bytestring >= 0.10.12.1
|
- bytestring >= 0.10.12.1
|
||||||
- containers >= 0.6.4.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
|
- file-embed == 0.0.15.0
|
||||||
- http-types >= 0.12.3
|
- http-types >= 0.12.3
|
||||||
- iso8601-time >= 0.1.5
|
- iso8601-time >= 0.1.5
|
||||||
- mtl >= 2.2.2
|
- mtl >= 2.2.2
|
||||||
- random >= 1.2
|
- random >= 1.2
|
||||||
- scotty == 0.12
|
- saltine >= 0.2.0.0
|
||||||
|
- scotty >= 0.12
|
||||||
- shakespeare >= 2.0.20
|
- shakespeare >= 2.0.20
|
||||||
- sqlite-simple >= 0.4.18.0
|
- sqlite-simple >= 0.4.18.0
|
||||||
- split >= 0.2.3.4
|
- split >= 0.2.3.4
|
||||||
@ -61,9 +61,9 @@ executables:
|
|||||||
- -threaded
|
- -threaded
|
||||||
- -rtsopts
|
- -rtsopts
|
||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
- -static
|
#- -static
|
||||||
- -optl-static
|
#- -optl-static
|
||||||
- -optl-pthread
|
#- -optl-pthread
|
||||||
- -fPIC
|
- -fPIC
|
||||||
dependencies:
|
dependencies:
|
||||||
- Purr
|
- Purr
|
||||||
|
@ -3,6 +3,7 @@ module Core.SQLite where
|
|||||||
import Core.Types
|
import Core.Types
|
||||||
|
|
||||||
import Control.Monad.Reader (ask, lift, liftIO)
|
import Control.Monad.Reader (ask, lift, liftIO)
|
||||||
|
import Data.ByteString as B
|
||||||
import Database.SQLite.Simple
|
import Database.SQLite.Simple
|
||||||
import Database.SQLite.Simple.FromRow
|
import Database.SQLite.Simple.FromRow
|
||||||
|
|
||||||
@ -15,6 +16,7 @@ main db = do
|
|||||||
"CREATE TABLE IF NOT EXISTS pws\
|
"CREATE TABLE IF NOT EXISTS pws\
|
||||||
\ (link TEXT PRIMARY KEY,\
|
\ (link TEXT PRIMARY KEY,\
|
||||||
\ secret TEXT,\
|
\ secret TEXT,\
|
||||||
|
\ nonce TEXT,\
|
||||||
\ date DATETIME DEFAULT CURRENT_TIMESTAMP,\
|
\ date DATETIME DEFAULT CURRENT_TIMESTAMP,\
|
||||||
\ life INT,\
|
\ life INT,\
|
||||||
\ views INT,\
|
\ views INT,\
|
||||||
@ -24,8 +26,8 @@ main db = do
|
|||||||
dbPath :: PurrAction String
|
dbPath :: PurrAction String
|
||||||
dbPath = lift ask >>= (\a -> return $ dbFile a)
|
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 :: PurrAction Int
|
||||||
confLinkLength = lift ask >>= (\a -> return $ linkLength a)
|
confLinkLength = lift ask >>= (\a -> return $ linkLength a)
|
||||||
|
@ -2,7 +2,7 @@ module Core.Types where
|
|||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as LT
|
import qualified Data.Text.Lazy as LT
|
||||||
|
import Data.ByteString as B
|
||||||
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
|
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
|
||||||
import Data.Text
|
import Data.Text
|
||||||
import Database.SQLite.Simple (ToRow)
|
import Database.SQLite.Simple (ToRow)
|
||||||
@ -34,7 +34,6 @@ data DhallConfig = DhallConfig
|
|||||||
, applicationHost :: String
|
, applicationHost :: String
|
||||||
, applicationPort :: Int
|
, applicationPort :: Int
|
||||||
, dbFile :: String
|
, dbFile :: String
|
||||||
, dbKey :: String
|
|
||||||
, linkLength :: Int
|
, linkLength :: Int
|
||||||
, adminEmail :: String
|
, adminEmail :: String
|
||||||
} deriving (Generic, Show)
|
} deriving (Generic, Show)
|
||||||
@ -42,6 +41,7 @@ data DhallConfig = DhallConfig
|
|||||||
data SecretEntry = SecretEntry
|
data SecretEntry = SecretEntry
|
||||||
{ link :: T.Text
|
{ link :: T.Text
|
||||||
, secret :: T.Text
|
, secret :: T.Text
|
||||||
|
, nonce :: B.ByteString
|
||||||
, date :: Integer
|
, date :: Integer
|
||||||
, life :: Integer
|
, life :: Integer
|
||||||
, views :: Integer
|
, views :: Integer
|
||||||
|
@ -5,14 +5,16 @@ import Core.Types
|
|||||||
import Feature.Generation.Passwords (Password)
|
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)
|
import Data.Maybe (listToMaybe, fromMaybe, Maybe(Just))
|
||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||||
import Database.SQLite.Simple
|
import Database.SQLite.Simple
|
||||||
|
|
||||||
|
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.Base64 as B64
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as BSC8
|
||||||
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as ET
|
import qualified Data.Text.Encoding as ET
|
||||||
import qualified Data.Text.Lazy as LT
|
import qualified Data.Text.Lazy as LT
|
||||||
@ -20,7 +22,7 @@ import qualified Data.Text.Lazy as LT
|
|||||||
findByLink :: String -> PurrAction (Maybe T.Text)
|
findByLink :: String -> PurrAction (Maybe T.Text)
|
||||||
findByLink link = do
|
findByLink link = do
|
||||||
db <- dbPath
|
db <- dbPath
|
||||||
key <- encKey
|
key <- liftIO encKey
|
||||||
conn <- liftIO $ open db
|
conn <- liftIO $ open db
|
||||||
res <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
|
res <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
|
||||||
liftIO $ close conn
|
liftIO $ close conn
|
||||||
@ -29,27 +31,26 @@ findByLink link = do
|
|||||||
insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
|
insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
|
||||||
insertNewSecret sec life link maxViews = do
|
insertNewSecret sec life link maxViews = do
|
||||||
db <- dbPath
|
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
|
conn <- liftIO $ open db
|
||||||
time <- liftIO $ epochTime
|
time <- liftIO $ epochTime
|
||||||
liftIO $ execute conn
|
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
|
liftIO $ close conn
|
||||||
|
|
||||||
readEncryptedSecret :: String -> [SecretEntry] -> PurrAction (Maybe T.Text)
|
readEncryptedSecret :: B.ByteString -> [SecretEntry] -> PurrAction (Maybe T.Text)
|
||||||
readEncryptedSecret key sec = do
|
readEncryptedSecret key sec = do
|
||||||
db <- dbPath
|
db <- dbPath
|
||||||
|
let secNonce = nonce $ safeHead failedSecret sec
|
||||||
liftIO $ incViews sec db
|
liftIO $ incViews sec db
|
||||||
delete <- liftIO $ deleteExpiredSecret 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)
|
if (delete)
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else return (ET.decodeLatin1 <$> decKey)
|
else return (ET.decodeLatin1 <$> decSec)
|
||||||
where
|
where
|
||||||
incViews :: [SecretEntry] -> String -> IO ()
|
incViews :: [SecretEntry] -> String -> IO ()
|
||||||
incViews [] _ = return ()
|
incViews [] _ = return ()
|
||||||
@ -83,11 +84,26 @@ encodeSecret b = ET.decodeUtf8 $ B64.encode b
|
|||||||
decodeSecret :: SecretEntry -> B.ByteString
|
decodeSecret :: SecretEntry -> B.ByteString
|
||||||
decodeSecret s = B64.decodeLenient $ ET.encodeUtf8 (secret s)
|
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 :: IO Integer
|
||||||
epochTime = fmap round getPOSIXTime
|
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
|
||||||
|
@ -6,12 +6,14 @@ import qualified Core.SQLite as DB
|
|||||||
import Core.Types
|
import Core.Types
|
||||||
|
|
||||||
import Control.Monad.Reader (lift, liftIO, runReaderT)
|
import Control.Monad.Reader (lift, liftIO, runReaderT)
|
||||||
|
import Crypto.Saltine (sodiumInit)
|
||||||
import GHC.Natural (popCountNatural)
|
import GHC.Natural (popCountNatural)
|
||||||
import Prelude hiding (id)
|
import Prelude hiding (id)
|
||||||
import Web.Scotty.Trans (scottyT)
|
import Web.Scotty.Trans (scottyT)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
sodiumInit
|
||||||
dhallConf <- liftIO Configuration.main
|
dhallConf <- liftIO Configuration.main
|
||||||
DB.main (dbFile dhallConf)
|
DB.main (dbFile dhallConf)
|
||||||
scottyT (applicationPort dhallConf) (flip runApp dhallConf) HTTP.app where
|
scottyT (applicationPort dhallConf) (flip runApp dhallConf) HTTP.app where
|
||||||
|
27
stack.yaml
27
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
|
|
@ -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
|
|
Loading…
x
Reference in New Issue
Block a user