packages feed

saltine-quickcheck (empty) → 0.1.0.0

raw patch · 5 files changed

+283/−0 lines, 5 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, bytestring-arbitrary, hex, saltine, saltine-quickcheck, tasty, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Jay Groven++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ saltine-quickcheck.cabal view
@@ -0,0 +1,42 @@+-- Initial saltine-quickcheck.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                saltine-quickcheck+version:             0.1.0.0+synopsis:            Quickcheck implementations for some NaCl data+homepage:            https://github.com/tsuraan/saltine-quickcheck+license:             MIT+license-file:        LICENSE+author:              Jay Groven+maintainer:          tsuraan@gmail.com+category:            Cryptography+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Crypto.Saltine.QuickCheck+  build-depends:       base >=4.7 && <4.8+                     , bytestring+                     , bytestring-arbitrary+                     , hex+                     , QuickCheck+                     , saltine+  hs-source-dirs:      src+  default-language:    Haskell2010+  extra-libraries:     sodium+  ghc-options:         -Wall++test-suite test-all+  type:                exitcode-stdio-1.0+  main-is:             TestAll.hs+  build-depends:       base >=4.6 && < 4.8+                     , bytestring-arbitrary+                     , QuickCheck >= 2.1+                     , saltine+                     , saltine-quickcheck+                     , tasty+                     , tasty-quickcheck+  hs-source-dirs:      tests+  default-language:    Haskell2010+  ghc-options:         -Wall+
+ src/Crypto/Saltine/QuickCheck.hs view
@@ -0,0 +1,135 @@+module Crypto.Saltine.QuickCheck+( DeterministicBoxPair(..)+, DeterministicBoxNonce(..)+, DeterministicSignPair(..)+, DeterministicSecretKey(..)+, DeterministicSecretNonce(..)+, toBoxPair+, toSignPair+) where++import qualified Crypto.Saltine.Core.Box           as Box+import qualified Crypto.Saltine.Core.SecretBox     as Secret+import qualified Crypto.Saltine.Core.Sign          as Sign+import qualified Crypto.Saltine.Internal.ByteSizes as Sizes+import qualified Data.ByteString                   as ByteString++import Crypto.Saltine.Class      ( IsEncoding(..) )+import Crypto.Saltine.Core.Box   ( SecretKey, PublicKey )+import Data.ByteString           ( ByteString )+import Data.ByteString.Arbitrary ( fastRandBs )+import Data.ByteString.Unsafe    ( unsafeUseAsCString )+import Data.Maybe                ( fromJust )+import Data.Hex                  ( hex )+import Foreign.C+import Foreign.Ptr+import System.IO.Unsafe          ( unsafePerformIO )+import Test.QuickCheck           ( Arbitrary(..) )++boxSeedBytes :: Int+boxSeedBytes = fromIntegral c_crypto_box_seedbytes++signSeedBytes :: Int+signSeedBytes = fromIntegral c_crypto_sign_seedbytes++data DeterministicBoxPair = DBP+  { boxSecret :: !Box.SecretKey+  , boxPublic :: !Box.PublicKey }++newtype DeterministicBoxNonce = DBN { fromDBN :: Box.Nonce }++data DeterministicSignPair = DSP+  { signSecret :: !Sign.SecretKey+  , signPublic :: !Sign.PublicKey }++newtype DeterministicSecretKey   = DSK { fromDSK :: Secret.Key }+newtype DeterministicSecretNonce = DSN { fromDSN :: Secret.Nonce }++toBoxPair :: DeterministicBoxPair -> Box.Keypair+toBoxPair (DBP s p) = (s,p)++toSignPair :: DeterministicSignPair -> Sign.Keypair+toSignPair (DSP s p) = (s,p)++seededBoxPair :: ByteString -> DeterministicBoxPair+seededBoxPair = unsafePerformIO . seededBoxPair'++seededBoxPair' :: ByteString -> IO DeterministicBoxPair+seededBoxPair' seed = +  use_seed seed boxSeedBytes Sizes.boxPK Sizes.boxSK c_crypto_box_seed_keypair DBP++seededSignPair :: ByteString -> DeterministicSignPair+seededSignPair = unsafePerformIO . seededSignPair'++seededSignPair' :: ByteString -> IO DeterministicSignPair+seededSignPair' seed =+  use_seed seed signSeedBytes Sizes.signPK Sizes.signSK c_crypto_sign_seed_keypair DSP++use_seed :: (IsEncoding s, IsEncoding p)+         => ByteString+         -> Int+         -> Int+         -> Int+         -> (Ptr CChar -> Ptr CChar -> Ptr CChar -> IO CInt)+         -> (s -> p -> a)+         -> IO a+use_seed seed slen _ _ _ _ | ByteString.length seed /= slen+  = fail $ "Seed must be " ++ show slen ++ " bytes long"+use_seed seed _ pklen sklen c_fn ctor = do+  let pkbuf = ByteString.replicate pklen 0+      skbuf = ByteString.replicate sklen 0+  _ <- unsafeUseAsCString pkbuf (\pkcptr ->+    unsafeUseAsCString skbuf (\skcptr ->+      unsafeUseAsCString seed (\seedcptr ->+        c_fn pkcptr skcptr seedcptr )))+  let Just pk = decode pkbuf+      Just sk = decode skbuf+  return $ ctor sk pk++instance Arbitrary DeterministicBoxPair where+  arbitrary = seededBoxPair `fmap` fastRandBs boxSeedBytes++instance Arbitrary DeterministicBoxNonce where+  arbitrary = (DBN . fromJust . decode) `fmap` fastRandBs Sizes.boxNonce++instance Arbitrary DeterministicSignPair where+  arbitrary = seededSignPair `fmap` fastRandBs boxSeedBytes++instance Arbitrary DeterministicSecretKey where+  arbitrary = (DSK . fromJust . decode) `fmap` fastRandBs Sizes.secretBoxKey++instance Arbitrary DeterministicSecretNonce where+  arbitrary = (DSN . fromJust . decode) `fmap` fastRandBs Sizes.secretBoxNonce++instance Show DeterministicBoxPair where+  show (DBP sec pub) = str' "DBP" sec pub++instance Show DeterministicBoxNonce where+  show (DBN nonce) = "<DBN " ++ (show $ hex $ encode nonce) ++ ">"++instance Show DeterministicSignPair where+  show (DSP sec pub) = str' "DSP" sec pub++instance Show DeterministicSecretKey where+  show (DSK key) = "<DSK " ++ (take 17 $ show $ hex $ encode key) ++ "\">"++instance Show DeterministicSecretNonce where+  show (DSN nonce) = "<DSN " ++ (show $ hex $ encode nonce) ++ ">"++str' :: (IsEncoding s, IsEncoding p) => String -> s -> p -> String+str' heading secret public = +    heading ++ "<" ++ (take 17 $ show $ hex $ encode secret) ++ "\" "+                   ++ (show $ hex $ encode public) ++ ">"++foreign import ccall "crypto_box_seed_keypair"+  c_crypto_box_seed_keypair :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO CInt++foreign import ccall "crypto_box_seedbytes"+  c_crypto_box_seedbytes :: CSize++foreign import ccall "crypto_sign_seed_keypair"+  c_crypto_sign_seed_keypair :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO CInt++foreign import ccall "crypto_sign_seedbytes"+  c_crypto_sign_seedbytes :: CSize+
+ tests/TestAll.hs view
@@ -0,0 +1,84 @@+module Main+( main+) where++import Crypto.Saltine.QuickCheck+import Crypto.Saltine.Core.Box+import Crypto.Saltine.Core.Sign+import Crypto.Saltine.Core.SecretBox++import Data.ByteString.Arbitrary  ( ArbByteString(..) )+import Test.Tasty+import Test.Tasty.QuickCheck      ( testProperty )++main :: IO ()+main = defaultMain $+  testGroup "Saltine.QuickCheck"+  [ testGroup "Positive"+    [ testProperty "Box" test_box_good+    , testProperty "Sign" test_sign_good+    , testProperty "Secret" test_secret_good+    ]+  , testGroup "Negative"+    [ testProperty "Box" test_box_bad+    , testProperty "Sign" test_sign_bad+    , testProperty "Secret" test_secret_bad+    ]+  ]+  where+  test_box_good :: DeterministicBoxPair+                -> DeterministicBoxPair+                -> DeterministicBoxNonce+                -> ArbByteString+                -> Bool+  test_box_good me them nonce (ABS plain) =+    let cipher = box (boxPublic them) (boxSecret me) (fromDBN nonce) plain+        plain' = boxOpen (boxPublic me) (boxSecret them) (fromDBN nonce) cipher+    in Just plain == plain'++  test_sign_good :: DeterministicSignPair -> ArbByteString -> Bool+  test_sign_good me (ABS plain) =+    let signed = sign (signSecret me) plain+        plain' = signOpen (signPublic me) signed+    in Just plain == plain'++  test_secret_good :: DeterministicSecretKey+                   -> DeterministicSecretNonce+                   -> ArbByteString+                   -> Bool+  test_secret_good key nonce (ABS plain) =+    let cipher = secretbox (fromDSK key) (fromDSN nonce) plain+        plain' = secretboxOpen (fromDSK key) (fromDSN nonce) cipher+    in Just plain == plain'++  test_box_bad :: DeterministicBoxPair+               -> DeterministicBoxPair+               -> DeterministicBoxPair+               -> DeterministicBoxNonce+               -> DeterministicBoxNonce+               -> ArbByteString+               -> Bool+  test_box_bad me them spy nonce badnonce (ABS plain) =+    let cipher = box (boxPublic them) (boxSecret me) (fromDBN nonce) plain+        plain' = boxOpen (boxPublic me) (boxSecret spy) (fromDBN nonce) cipher+        plain2 = boxOpen (boxPublic me) (boxSecret them) (fromDBN badnonce) cipher+    in (plain' == Nothing) && (plain2 == Nothing)++  test_sign_bad :: DeterministicSignPair -> DeterministicSignPair -> ArbByteString -> Bool+  test_sign_bad me fake (ABS plain) =+    let signed = sign (signSecret me) plain+        plain' = signOpen (signPublic fake) signed+    in plain' == Nothing++  test_secret_bad :: DeterministicSecretKey+                  -> DeterministicSecretKey+                  -> DeterministicSecretNonce+                  -> DeterministicSecretNonce+                  -> ArbByteString+                  -> Bool+  test_secret_bad key badkey nonce badnonce (ABS plain) =+    let cipher = secretbox (fromDSK key) (fromDSN nonce) plain+        plain' = secretboxOpen (fromDSK badkey) (fromDSN nonce) cipher+        plain2 = secretboxOpen (fromDSK key) (fromDSN badnonce) cipher+    in (plain' == Nothing) && (plain2 == Nothing)+