Re-add EdDSA support via libsodium

.gitignore

@@ -9,3 +9,5 @@ cabal-dev
 .cabal-sandbox
 cabal.sandbox.config
 /tmp
+/gen
+

Setup.hs

@@ -0,0 +1,124 @@
+#!/usr/bin/env runhaskell
+
+import           Data.Char (isDigit, toLower)
+import           Data.Function (on)
+import           Data.List (intercalate, sortBy)
+import           Data.Monoid ((<>))
+import           Data.Version (showVersion)
+
+import           Distribution.InstalledPackageInfo
+import           Distribution.PackageDescription
+import           Distribution.Simple
+import           Distribution.Simple.Setup (BuildFlags(..), ReplFlags(..), TestFlags(..), fromFlag)
+import           Distribution.Simple.LocalBuildInfo
+import           Distribution.Simple.PackageIndex
+import           Distribution.Simple.BuildPaths (autogenModulesDir)
+import           Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, rawSystemStdout)
+import           Distribution.Verbosity
+
+import           System.Directory (createDirectoryIfMissing, getCurrentDirectory, setCurrentDirectory)
+import           System.FilePath ((</>))
+import           System.Process (callProcess)
+
+main :: IO ()
+main =
+  let hooks = simpleUserHooks
+   in defaultMainWithHooks hooks {
+     preConf = \args flags -> do
+       createDirectoryIfMissingVerbose silent True "gen"
+       (preConf hooks) args flags
+   , sDistHook  = \pd mlbi uh flags -> do
+       genBuildInfo silent pd
+       (sDistHook hooks) pd mlbi uh flags
+   , buildHook = \pd lbi uh flags -> do
+       genBuildInfo (fromFlag $ buildVerbosity flags) pd
+       genDependencyInfo (fromFlag $ buildVerbosity flags) pd lbi
+       buildLibSodium
+       (buildHook hooks) pd lbi uh flags
+   , replHook = \pd lbi uh flags args -> do
+       genBuildInfo (fromFlag $ replVerbosity flags) pd
+       genDependencyInfo (fromFlag $ replVerbosity flags) pd lbi
+       (replHook hooks) pd lbi uh flags args
+   , testHook = \args pd lbi uh flags -> do
+       genBuildInfo (fromFlag $ testVerbosity flags) pd
+       genDependencyInfo (fromFlag $ testVerbosity flags) pd lbi
+       (testHook hooks) args pd lbi uh flags
+   }
+
+buildLibSodium :: IO ()
+buildLibSodium = do
+  cwd <- getCurrentDirectory
+  let
+    sodiumDir = cwd </> "gen" </> "libsodium"
+  createDirectoryIfMissing True sodiumDir
+  setCurrentDirectory $ cwd </> "lib" </> "libsodium"
+  callProcess "autoreconf" ["-if"]
+  callProcess "./configure" ["--prefix=" <> sodiumDir]
+  callProcess "make" ["-j"]
+  callProcess "make" ["install"]
+  setCurrentDirectory cwd
+
+genBuildInfo :: Verbosity -> PackageDescription -> IO ()
+genBuildInfo verbosity pkg = do
+  createDirectoryIfMissingVerbose verbosity True "gen"
+  let (PackageName pname) = pkgName . package $ pkg
+      version = pkgVersion . package $ pkg
+      name = "BuildInfo_" ++ (map (\c -> if c == '-' then '_' else c) pname)
+      targetHs = "gen/" ++ name ++ ".hs"
+      targetText = "gen/version.txt"
+  t <- timestamp verbosity
+  gv <- gitVersion verbosity
+  let v = showVersion version
+  let buildVersion = intercalate "-" [v, t, gv]
+  rewriteFile targetHs $ unlines [
+      "module " ++ name ++ " where"
+    , "import Prelude"
+    , "data RuntimeBuildInfo = RuntimeBuildInfo { buildVersion :: String, timestamp :: String, gitVersion :: String }"
+    , "buildInfo :: RuntimeBuildInfo"
+    , "buildInfo = RuntimeBuildInfo \"" ++ v ++ "\" \"" ++ t ++ "\" \"" ++ gv ++ "\""
+    , "buildInfoVersion :: String"
+    , "buildInfoVersion = \"" ++ buildVersion ++ "\""
+    ]
+  rewriteFile targetText buildVersion
+
+genDependencyInfo :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
+genDependencyInfo verbosity pkg info = do
+  let
+    (PackageName pname) = pkgName . package $ pkg
+    name = "DependencyInfo_" ++ (map (\c -> if c == '-' then '_' else c) pname)
+    targetHs = autogenModulesDir info ++ "/" ++ name ++ ".hs"
+    render p =
+      let
+        n = unPackageName $ pkgName p
+        v = intercalate "." . fmap show . versionBranch $ pkgVersion p
+      in
+       n ++ "-" ++ v
+    deps = fmap (render . sourcePackageId) . allPackages $ installedPkgs info
+    sdeps = sortBy (compare `on` fmap toLower) deps
+    strs = flip fmap sdeps $ \d -> "\"" ++ d ++ "\""
+
+  createDirectoryIfMissingVerbose verbosity True (autogenModulesDir info)
+
+  rewriteFile targetHs $ unlines [
+      "module " ++ name ++ " where"
+    , "import Prelude"
+    , "dependencyInfo :: [String]"
+    , "dependencyInfo = [\n    " ++ intercalate "\n  , " strs ++ "\n  ]"
+    ]
+
+gitVersion :: Verbosity -> IO String
+gitVersion verbosity = do
+  ver <- rawSystemStdout verbosity "git" ["log", "--pretty=format:%h", "-n", "1"]
+  notModified <- ((>) 1 . length) `fmap` rawSystemStdout verbosity "git" ["status", "--porcelain"]
+  return $ ver ++ if notModified then "" else "-M"
+
+timestamp :: Verbosity -> IO String
+timestamp verbosity =
+  rawSystemStdout verbosity "date" ["+%Y%m%d%H%M%S"] >>= \s ->
+    case splitAt 14 s of
+      (d, n : []) ->
+        if (length d == 14 && filter isDigit d == d)
+          then return d
+          else fail $ "date has failed to produce the correct format [" <> s <> "]."
+      _ ->
+        fail $ "date has failed to produce a date long enough [" <> s <> "]."

ambiata-tinfoil.cabal

@@ -7,7 +7,7 @@ copyright:             (c) 2015 Ambiata.
 synopsis:              Paranoid crypto primitives
 category:              System
 cabal-version:         >= 1.8
-build-type:            Simple
+build-type:            Custom
 description:           Primitives for cryptographic random number generation,
                        key deriviation, credential storage and verification,
                        et cetera.
@@ -56,11 +56,14 @@ library
                        Tinfoil.MAC
                        Tinfoil.Random
                        Tinfoil.Random.Internal
+                       Tinfoil.Signing.Ed25519
+                       Tinfoil.Signing.Ed25519.Internal
                        Tinfoil.Token
 
   c-sources:
                        -- tinfoil's own c bits
                        cbits/tinfoil/memory.c
+                       cbits/tinfoil/sodium/constants.c
 
                        -- scrypt (https://github.com/Tarsnap/scrypt)
                      , cbits/scrypt/insecure_memzero.c
@@ -71,11 +74,17 @@ library
                      , cbits/scrypt/crypto_scrypt_smix.c
                      , cbits/scrypt/crypto_scrypt_smix_sse2.c
                      , cbits/scrypt/crypto_scrypt.c
+
   cc-options:          -msse2
+
   include-dirs:        cbits/scrypt
                      , cbits/tinfoil
+                     , gen/libsodium/include
+
   includes:            crypto_scrypt.h
                      , tinfoil.h
+                     , sodium.h
+
   install-includes:    crypto_scrypt.h
                      , tinfoil.h
 
@@ -84,7 +93,7 @@ test-suite test
 
   main-is:             test.hs
 
-  ghc-options:         -Wall -threaded -O2
+  ghc-options:         -Wall -threaded -O2 -pgml ./bin/salted-gcc
 
   hs-source-dirs:
                        test
@@ -107,7 +116,7 @@ test-suite test-io
 
   main-is:             test-io.hs
 
-  ghc-options:         -Wall -threaded -O2
+  ghc-options:         -Wall -threaded -O2 -pgml ./bin/salted-gcc
 
   hs-source-dirs:
                        test
@@ -154,7 +163,7 @@ benchmark bench
 
   main-is:             bench.hs
 
-  ghc-options:         -Wall -threaded -O2
+  ghc-options:         -Wall -threaded -O2 -pgml ./bin/salted-gcc
 
   hs-source-dirs:
                        test

bin/salted-gcc

@@ -0,0 +1,5 @@
+#! /bin/sh -eux
+
+echo "$@" | grep -q --version \
+    && gcc $@ \
+    || gcc $@ "$(pwd)/gen/libsodium/lib/libsodium.a"

cbits/tinfoil/sodium/constants.c

@@ -0,0 +1,16 @@
+#include <sodium.h>
+
+#include "constants.h"
+
+size_t tinfoil_sodium_pubkey_len() {
+	return crypto_sign_PUBLICKEYBYTES;
+}
+
+size_t tinfoil_sodium_seckey_len() {
+	return crypto_sign_SECRETKEYBYTES;
+}
+
+size_t tinfoil_sodium_sig_len() {
+	return crypto_sign_BYTES;
+}
+

cbits/tinfoil/sodium/constants.h

@@ -0,0 +1,14 @@
+#ifndef H_TINFOIL_SODIUM_CONSTANTS
+#define H_TINFOIL_SODIUM_CONSTANTS
+
+#include <stdlib.h>
+
+#include <sodium.h>
+
+size_t tinfoil_sodium_pubkey_len();
+
+size_t tinfoil_sodium_seckey_len();
+
+size_t tinfoil_sodium_sig_len();
+
+#endif

cbits/tinfoil/tinfoil.h

@@ -2,5 +2,6 @@
 #define H_TINFOIL
 
 #include "memory.h"
+#include "sodium/constants.h"
 
 #endif

test/Test/IO/Tinfoil/Signing/Ed25519.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module Test.IO.Tinfoil.Signing.Ed25519 where
+
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+import           Disorder.Core.IO (testIO)
+import           Disorder.Core.Property (failWith)
+import           Disorder.Core.UniquePair (UniquePair(..))
+
+import           P
+
+import           System.IO
+
+import           Test.QuickCheck
+import           Test.QuickCheck.Instances ()
+
+import           Tinfoil.Data
+import           Tinfoil.Signing.Ed25519
+
+prop_signMessage :: UniquePair ByteString -> Property
+prop_signMessage (UniquePair msg1 msg2) =
+  let msg3 = msg1 <> BS.singleton 0x00
+      msg4 = BS.singleton 0x00 <> msg1 in testIO $ do
+  (pk1, sk1) <- genKeyPair
+  (pk2, _sk2) <- genKeyPair
+  case signMessage sk1 msg1 of
+    Nothing' ->
+      pure . failWith $ "Unexpected failure signing: " <> T.pack (show msg1)
+    Just' sig ->
+      let good = verifyMessage pk1 sig msg1
+          bads = [ verifyMessage pk2 sig msg1
+                 , verifyMessage pk1 sig msg2
+                 , verifyMessage pk1 sig msg3
+                 , verifyMessage pk1 sig msg4
+                 ] in
+      pure $ (good, all (== NotVerified) bads) === (Verified, True)
+
+return []
+tests :: IO Bool
+tests = $forAllProperties $ quickCheckWithResult (stdArgs { maxSuccess = 1000 } )

test/Test/IO/Tinfoil/Signing/Ed25519/Internal.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module Test.IO.Tinfoil.Signing.Ed25519.Internal where
+
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+import           Disorder.Core.IO (testIO)
+import           Disorder.Core.Property (failWith)
+
+import           P
+
+import           System.IO
+
+import           Test.QuickCheck
+import           Test.QuickCheck.Instances ()
+
+import           Tinfoil.Data
+import           Tinfoil.Signing.Ed25519.Internal
+
+prop_genKeyPair_len :: Property
+prop_genKeyPair_len = testIO $ do
+  (PKey_Ed25519 pk, SKey_Ed25519 sk) <- genKeyPair
+  pure $ (BS.length pk, BS.length sk) === (pubKeyLen, secKeyLen)
+
+prop_genKeyPair :: Property
+prop_genKeyPair = testIO $ do
+  (pk1, sk1) <- genKeyPair
+  (pk2, sk2) <- genKeyPair
+  pure $ (pk1 == pk2, sk1 == sk2) === (False, False)
+
+-- Check the signed-message construction works how we think it does.
+prop_signMessage' :: ByteString -> Property
+prop_signMessage' msg = testIO $ do
+  (_pk, sk) <- genKeyPair
+  case signMessage' sk msg of
+    Nothing' ->
+      pure . failWith $ "Unexpected failure signing: " <> T.pack (show msg)
+    Just' sm ->
+      let msg' = BS.drop maxSigLen sm in
+      pure $ msg === msg'
+
+return []
+tests :: IO Bool
+tests = $forAllProperties $ quickCheckWithResult (stdArgs { maxSuccess = 1000 } )

test/Test/Tinfoil/Signing/Ed25519/Internal.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module Test.Tinfoil.Signing.Ed25519.Internal where
+
+import           P
+
+import           System.IO
+
+import           Tinfoil.Signing.Ed25519.Internal
+
+import           Test.QuickCheck
+import           Test.QuickCheck.Instances ()
+
+-- Check these don't change on us.
+prop_ed25519_lengths =
+  once $ (pubKeyLen, secKeyLen, maxSigLen) === (32, 64, 64)
+
+return []
+tests :: IO Bool
+tests = $forAllProperties $ quickCheckWithResult (stdArgs { maxSuccess = 1000 } )