broke out Verifiable to a utility library, and added a quickcheck test

This commit is contained in:
Joey Hess 2012-09-07 23:23:52 -04:00
parent c12caf0a4e
commit 92df8250fa
3 changed files with 58 additions and 36 deletions

View file

@ -8,13 +8,26 @@
module Assistant.Pairing where
import Assistant.Common
import Utility.Verifiable
import Network.Socket (HostName)
type SshPubKey = String
type HMACDigest = String
type UserName = String
type Secret = String
{- Messages sent in pairing are all verifiable using a secret that
- should be shared between the systems being paired. -}
type PairMsg = Verifiable (PairStage, HostInfo, SshPubKey)
mkPairMsg :: Secret -> PairStage -> HostInfo -> SshPubKey -> PairMsg
mkPairMsg secret pairstage hostinfo sshkey = mkVerifiable
(pairstage, hostinfo, sshkey) secret
data PairStage
{- "I'd like to pair with somebody who knows a secret.
- Here's my ssh key, and hostinfo." -}
= PairRequest
{- "I've checked your PairRequest, and like it; I set up
- your ssh key already. Here's mine." -}
| PairAck
deriving (Eq, Read, Show)
data HostInfo = HostInfo
{ hostName :: HostName
@ -22,35 +35,5 @@ data HostInfo = HostInfo
}
deriving (Eq, Read, Show)
data PairStage
{- "I'd like to pair with somebody who knows a secret.
- Here's my ssh key, and hostinfo, both verifiable with
- our shared secret." -}
= PairRequest
{- "I've checked your PairRequest, and like it; I set up
- your ssh key already. Here's mine, also verified, please set it
- up too, and start syncing!" -}
| PairAck
deriving (Eq, Read, Show)
type PairMsg = Verifiable (PairStage, HostInfo, SshPubKey)
mkPairMsg :: Secret -> PairStage -> HostInfo -> SshPubKey -> PairMsg
mkPairMsg secret pairstage hostinfo sshkey = mkVerifiable
(pairstage, hostinfo, sshkey) secret
{- A value, verifiable using a HMAC digest to encrypt using a shared secret. -}
data Verifiable a = Verifiable
{ val :: a
, digest :: HMACDigest
}
deriving (Eq, Read, Show)
mkVerifiable :: Show a => a -> Secret -> Verifiable a
mkVerifiable a secret = Verifiable a (calcDigest (show a) secret)
verified :: (Eq a, Show a) => Verifiable a -> Secret -> Bool
verified v secret = v == mkVerifiable (val v) secret
calcDigest :: String -> Secret -> HMACDigest
calcDigest = undefined -- TODO
type SshPubKey = String
type UserName = String

37
Utility/Verifiable.hs Normal file
View file

@ -0,0 +1,37 @@
{- values verified using a shared secret
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.Verifiable where
import Data.Digest.Pure.SHA
import Data.ByteString.Lazy.UTF8 (fromString)
import qualified Data.ByteString.Lazy as L
type Secret = L.ByteString
type HMACDigest = String
{- A value, verifiable using a HMAC digest and a secret. -}
data Verifiable a = Verifiable
{ val :: a
, digest :: HMACDigest
}
deriving (Eq, Read, Show)
mkVerifiable :: Show a => a -> Secret -> Verifiable a
mkVerifiable a secret = Verifiable a (calcDigest (show a) secret)
verified :: (Eq a, Show a) => Verifiable a -> Secret -> Bool
verified v secret = v == mkVerifiable (val v) secret
calcDigest :: String -> Secret -> HMACDigest
calcDigest v secret = showDigest $ hmacSha1 secret $ fromString v
{- for quickcheck -}
prop_verifiable_sane :: String -> String -> Bool
prop_verifiable_sane a s = verified (mkVerifiable a secret) secret
where
secret = fromString s

View file

@ -47,6 +47,7 @@ import qualified Utility.FileMode
import qualified Utility.Gpg
import qualified Build.SysConfig
import qualified Utility.Format
import qualified Utility.Verifiable
-- for quickcheck
instance Arbitrary Types.Key.Key where
@ -89,6 +90,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
, qctest "prop_hmacWithCipher_sane" Crypto.prop_hmacWithCipher_sane
, qctest "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
]
blackbox :: Test