Pure nix flake; replace crypto-simple with Saltine; update README and TODO
This commit is contained in:
parent
b4bbf6e5a7
commit
9efdc01828
@ -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
6
README
@ -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
3
TODO
@ -1,2 +1 @@
|
||||
- Replace crypto-simple dependency
|
||||
- Make the Docker images much smaller again
|
||||
- Make the Docker images much smaller
|
||||
|
@ -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};
|
||||
|
12
package.yaml
12
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 && < 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
|
||||
|
@ -5,12 +5,13 @@ 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.Maybe (listToMaybe, fromMaybe)
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Database.SQLite.Simple
|
||||
|
||||
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
|
||||
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user