Pure nix flake; replace crypto-simple with Saltine; update README and TODO

This commit is contained in:
James Eversole 2023-05-02 21:26:40 -05:00
parent b4bbf6e5a7
commit 9efdc01828
7 changed files with 40 additions and 35 deletions

View File

@ -47,13 +47,13 @@ library
, 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
, 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
@ -87,13 +87,13 @@ executable Purr-musl
, 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
, 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

6
README
View File

@ -27,12 +27,10 @@ DEPLOYMENT
Use Nix with flakes enabled.
Build binary and run natively:
nix build --impure && ./result/bin/Purr-musl
nix build && ./result/bin/Purr-musl
Build and add Docker image to local registry:
nix build .#purrImage --impure && docker load < result
I'll get rid of the "--impure" requirement ASAP.
nix build .#purrImage && docker load < result
DEVELOPMENT & SUPPORT

3
TODO
View File

@ -1,2 +1 @@
- Replace crypto-simple dependency
- Make the Docker images much smaller again
- Make the Docker images much smaller

View File

@ -20,8 +20,6 @@
in {
packages.${packageName} =
haskellPackages.callCabal2nix packageName self rec {
crypto-simple =
pkgs.haskell.lib.dontCheck haskellPackages.crypto-simple;
};
packages.default = self.packages.${system}.${packageName};

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

View File

@ -4,18 +4,19 @@ 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)
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.Internal.SecretBox as IBox
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
findByLink :: String -> PurrAction (Maybe T.Text)
findByLink link = do
@ -30,7 +31,8 @@ insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
insertNewSecret sec life link maxViews = do
db <- dbPath
key <- 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
@ -41,12 +43,10 @@ insertNewSecret sec life link maxViews = do
readEncryptedSecret :: String -> [SecretEntry] -> PurrAction (Maybe T.Text)
readEncryptedSecret key sec = do
db <- dbPath
nonce <- liftIO $ Box.newNonce
liftIO $ incViews sec db
delete <- liftIO $ deleteExpiredSecret sec db
decKey <- liftIO ( sequence
$ decryptSecret key
<$> decodeSecret
<$> listToMaybe sec )
let decKey = decryptSecret key nonce $ decodeSecret $ safeHead failedSecret sec
if (delete)
then return Nothing
else return (ET.decodeLatin1 <$> decKey)
@ -83,11 +83,19 @@ 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 :: String -> T.Text -> Box.Nonce -> B.ByteString
encryptSecret k s n = do
Box.secretbox (IBox.Key $ B.pack k) n (ET.encodeUtf8 s)
decryptSecret :: String -> B.ByteString -> IO B.ByteString
decryptSecret k b = decrypt (B.pack k) b
decryptSecret :: String -> Box.Nonce -> B.ByteString -> Maybe B.ByteString
decryptSecret k n b = Box.secretboxOpen (IBox.Key $ B.pack k) n b
epochTime :: IO Integer
epochTime = fmap round getPOSIXTime
failedSecret :: SecretEntry
failedSecret = SecretEntry "fail" "fail" 0 0 0 0
safeHead :: a -> [a] -> a
safeHead x [] = x
safeHead x l = head l

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