broke out Verifiable to a utility library, and added a quickcheck test
This commit is contained in:
parent
c12caf0a4e
commit
92df8250fa
3 changed files with 58 additions and 36 deletions
|
@ -8,13 +8,26 @@
|
||||||
module Assistant.Pairing where
|
module Assistant.Pairing where
|
||||||
|
|
||||||
import Assistant.Common
|
import Assistant.Common
|
||||||
|
import Utility.Verifiable
|
||||||
|
|
||||||
import Network.Socket (HostName)
|
import Network.Socket (HostName)
|
||||||
|
|
||||||
type SshPubKey = String
|
{- Messages sent in pairing are all verifiable using a secret that
|
||||||
type HMACDigest = String
|
- should be shared between the systems being paired. -}
|
||||||
type UserName = String
|
type PairMsg = Verifiable (PairStage, HostInfo, SshPubKey)
|
||||||
type Secret = String
|
|
||||||
|
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
|
data HostInfo = HostInfo
|
||||||
{ hostName :: HostName
|
{ hostName :: HostName
|
||||||
|
@ -22,35 +35,5 @@ data HostInfo = HostInfo
|
||||||
}
|
}
|
||||||
deriving (Eq, Read, Show)
|
deriving (Eq, Read, Show)
|
||||||
|
|
||||||
data PairStage
|
type SshPubKey = String
|
||||||
{- "I'd like to pair with somebody who knows a secret.
|
type UserName = String
|
||||||
- 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
|
|
||||||
|
|
37
Utility/Verifiable.hs
Normal file
37
Utility/Verifiable.hs
Normal 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
|
2
test.hs
2
test.hs
|
@ -47,6 +47,7 @@ import qualified Utility.FileMode
|
||||||
import qualified Utility.Gpg
|
import qualified Utility.Gpg
|
||||||
import qualified Build.SysConfig
|
import qualified Build.SysConfig
|
||||||
import qualified Utility.Format
|
import qualified Utility.Format
|
||||||
|
import qualified Utility.Verifiable
|
||||||
|
|
||||||
-- for quickcheck
|
-- for quickcheck
|
||||||
instance Arbitrary Types.Key.Key where
|
instance Arbitrary Types.Key.Key where
|
||||||
|
@ -89,6 +90,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
|
||||||
, qctest "prop_hmacWithCipher_sane" Crypto.prop_hmacWithCipher_sane
|
, qctest "prop_hmacWithCipher_sane" Crypto.prop_hmacWithCipher_sane
|
||||||
, qctest "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
|
, qctest "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
|
||||||
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
|
, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
|
||||||
|
, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
|
||||||
]
|
]
|
||||||
|
|
||||||
blackbox :: Test
|
blackbox :: Test
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue