diff options
| -rw-r--r-- | Assistant/Pairing.hs | 45 | ||||
| -rw-r--r-- | Utility/Verifiable.hs | 37 | ||||
| -rw-r--r-- | test.hs | 2 |
3 files changed, 53 insertions, 31 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index b4861b20d..ef7b66d5c 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -8,49 +8,32 @@ 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) -data HostInfo = HostInfo - { hostName :: HostName - , userName :: UserName - } - deriving (Eq, Read, Show) +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, both verifiable with - - our shared 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, also verified, please set it - - up too, and start syncing!" -} + - your ssh key already. Here's mine." -} | 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 +data HostInfo = HostInfo + { hostName :: HostName + , userName :: UserName } 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 diff --git a/Utility/Verifiable.hs b/Utility/Verifiable.hs new file mode 100644 index 000000000..58218db2a --- /dev/null +++ b/Utility/Verifiable.hs @@ -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 @@ -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 |