commit 9efdc01828af6d56755ea381cb2708f3f8b288b6
parent b4bbf6e5a796d6dfc44ac0a052ec4949d2394927
Author: James Eversole <james@eversole.co>
Date: Tue, 2 May 2023 21:26:40 -0500
Pure nix flake; replace crypto-simple with Saltine; update README and TODO
Diffstat:
8 files changed, 144 insertions(+), 139 deletions(-)
diff --git a/Purr.cabal b/Purr.cabal
@@ -0,0 +1,106 @@
+cabal-version: 1.12
+
+name: purr
+version: 0.3.0
+description: https://git.eversole.co/purr
+author: James Eversole
+maintainer: james@eversole.co
+copyright: 2022 James Eversole
+license: ISC
+license-file: LICENSE
+build-type: Simple
+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
+ , 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
+ 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 -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
+ , 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
+ default-language: Haskell2010
diff --git a/README b/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
diff --git a/TODO b/TODO
@@ -1,2 +1 @@
-- Replace crypto-simple dependency
-- Make the Docker images much smaller again
+- Make the Docker images much smaller
diff --git a/flake.nix b/flake.nix
@@ -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};
diff --git a/package.yaml b/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
diff --git a/purr.cabal b/purr.cabal
@@ -1,106 +0,0 @@
-cabal-version: 1.12
-
-name: purr
-version: 0.3.0
-description: https://git.eversole.co/purr
-author: James Eversole
-maintainer: james@eversole.co
-copyright: 2022 James Eversole
-license: ISC
-license-file: LICENSE
-build-type: Simple
-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
- , 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 -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
- , 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
diff --git a/src/Feature/Sharing/SQLite.hs b/src/Feature/Sharing/SQLite.hs
@@ -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
diff --git a/src/Lib.hs b/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
