{-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} module Main where import Data.Monoid ((<>)) import System.FilePath.Posix ((), (<.>)) import System.Process (runCommand, waitForProcess) import System.IO.Temp (withSystemTempDirectory) import qualified Data.ByteString.Char8 as SB import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Property, Arbitrary(..), elements, suchThat) import Test.QuickCheck.Monadic (monadicIO, run, assert) import Crypto.PubKey.OpenSsh.Types (OpenSshKeyType(..), OpenSshPublicKey(..), OpenSshPrivateKey(..)) import Crypto.PubKey.OpenSsh (encodePublic, decodePublic, encodePrivate, decodePrivate) type StrictByteString = SB.ByteString type PrivateKey = StrictByteString type PublicKey = StrictByteString instance Arbitrary OpenSshKeyType where arbitrary = elements [OpenSshKeyTypeRsa, OpenSshKeyTypeDsa] openSshKeys :: OpenSshKeyType -> IO (PrivateKey, PublicKey) openSshKeys t = withSystemTempDirectory base $ \dir -> do let path = dir typ let run = "ssh-keygen -t " <> typ <> " -N \"\" -f " <> path waitForProcess =<< runCommand run priv <- SB.readFile $ path pub <- fmap SB.init $ SB.readFile $ path <.> "pub" return (priv, pub) where base = "crypto-pubkey-openssh-tests" typ = case t of OpenSshKeyTypeRsa -> "rsa" OpenSshKeyTypeDsa -> "dsa" testWithOpenSsh :: OpenSshKeyType -> Property testWithOpenSsh t = monadicIO $ do (priv, pub) <- run $ openSshKeys t assert $ checkPublic (decodePublic pub) pub assert $ checkPrivate (decodePrivate priv) priv where checkPublic = case t of OpenSshKeyTypeRsa -> \r b -> case r of Right k@(OpenSshPublicKeyRsa _ _) -> encodePublic k == b _ -> False OpenSshKeyTypeDsa -> \r b -> case r of Right k@(OpenSshPublicKeyDsa _ _) -> encodePublic k == b _ -> False checkPrivate = case t of OpenSshKeyTypeRsa -> \r b -> case r of Right k@(OpenSshPrivateKeyRsa _) -> encodePrivate k == b _ -> False OpenSshKeyTypeDsa -> \r b -> case r of Right k@(OpenSshPrivateKeyDsa _ _) -> encodePrivate k == b _ -> False main :: IO () main = defaultMain [ #ifdef OPENSSH testGroup "ssh-keygen" [ testProperty "decode/encode" $ testWithOpenSsh ] #endif ]