diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,9 @@ +# Revision history for crypto-srp + +`crypto-srp` uses [PVP Versioning][1]. + +## 0.1.0.0 -- 2026-07-05 + +* First version. + +[1]: https://pvp.haskell.org diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Tim Emiola + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Tim Emiola nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,16 @@ +# crypto-srp + +`crypto-srp` provides primitives for the +[Secure Remote Password (SRP)](https://datatracker.ietf.org/doc/html/rfc5054) protocol. + +It includes: + +- `Crypto.SRP` — core SRP computation: public key exchange, premaster secret derivation, + client/server proof generation and verification +- `Crypto.SRP.Constants` — standard large prime groups (1024–8192 bits) from + [RFC 5054 Appendix A](https://datatracker.ietf.org/doc/html/rfc5054#appendix-A) +- `Crypto.SRP.Hashing` — hash algorithm abstraction (`SHA1`, `SHA256`, `SHA384`, `SHA512`) + used throughout the SRP calculation +- `Crypto.SRP.PrimeGroup` — prime group representation and byte-string encoding +- `Crypto.SRP.Random` — cryptographically random private key generation + diff --git a/crypto-srp.cabal b/crypto-srp.cabal new file mode 100644 --- /dev/null +++ b/crypto-srp.cabal @@ -0,0 +1,92 @@ +cabal-version: 3.0 +name: crypto-srp +version: 0.1.0.0 +synopsis: SRP authentication primitives +description: + A library providing primitives for the + [Secure Remote Password (SRP)](https://datatracker.ietf.org/doc/html/rfc5054) protocol. + + It includes the core SRP computation — public key exchange, premaster secret + derivation, client\/server proof generation and verification — along with the + standard prime groups from RFC 5054 Appendix A, a hash algorithm abstraction + covering SHA1, SHA256, SHA384 and SHA512, and cryptographically random + private key generation. + +license: BSD-3-Clause +license-file: LICENSE +author: Tim Emiola +maintainer: adetokunbo@emio.la +category: Cryptography +tested-with: + GHC == 8.10.7 + GHC == 9.0.2 + GHC == 9.2.8 + GHC == 9.4.8 + GHC == 9.6 + GHC == 9.8 + GHC == 9.10 + GHC == 9.12 +extra-doc-files: + README.md + ChangeLog.md +data-files: + test/pysrp_server.py + +flag pysrp + description: Enable pysrp compatibility tests (requires Python 3 with srp package) + default: False + manual: True + +library + exposed-modules: Crypto.SRP + Crypto.SRP.Constants + Crypto.SRP.Hashing + Crypto.SRP.PrimeGroup + Crypto.SRP.Random + hs-source-dirs: src + build-depends: + base >= 4.12 && < 5 + , bytestring >=0.10.8 && <0.11 || >=0.11.3 && <0.13 + , cryptohash-sha1 >= 0.11 && < 0.12 + , cryptohash-sha256 >= 0.11 && < 0.12 + , cryptohash-sha512 >= 0.11 && < 0.12 + , entropy >= 0.3.7 && < 0.5 + , fmt >= 0.6.3 && < 0.8 + , text >= 1.2.3 && < 2.2 + , unicode-transforms >= 0.3 && < 0.5 + default-language: Haskell2010 + ghc-options: -Wall -Wincomplete-uni-patterns -Wpartial-fields -fwarn-tabs + +test-suite test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: Crypto.SRPSpec + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs + build-depends: + base + , bytestring + , crypto-srp + , fmt + , hspec >= 2.1 && < 3.0 + , QuickCheck >= 2.13 && < 2.16 + +test-suite pysrp-compat + if !flag(pysrp) + buildable: False + type: exitcode-stdio-1.0 + main-is: PysrpSpec.hs + hs-source-dirs: test + autogen-modules: Paths_crypto_srp + other-modules: Crypto.PysrpCompatSpec + Paths_crypto_srp + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs + build-depends: + base + , bytestring + , crypto-srp + , hspec >= 2.1 && < 3.0 + , process >= 1.6 && < 1.7 + , text >= 1.2.3 && < 2.2 diff --git a/src/Crypto/SRP.hs b/src/Crypto/SRP.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/SRP.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# OPTIONS_HADDOCK prune #-} + +{- | +Module : Crypto.SRP +Copyright : (c) 2025 Tim Emiola +Maintainer : Tim Emiola +SPDX-License-Identifier: BSD3 + +Core types and functions for the client side of an SRP authentication sequence. + +The typical flow: + +1. Call 'mkFromClient' with the username, password and a 'PrimeGroup' to + produce a 'FromClient' value and generate a random private ephemeral key. +2. Send 'fcPublicBytes' to the server; receive a 'FromServer' in reply. +3. Call 'calcResults' (supplying an 'XCalculator') to derive the shared + session key and client\/server proofs. +4. Optionally call 'verifyServerProof' to confirm the server holds the same key. +-} +module Crypto.SRP + ( -- * client-side inputs + FromClient (..) + , mkFromClient + + -- * server-side inputs + , FromServer (..) + + -- ** choose how to calculate @\'x\''@ + , XCalculator (..) + + -- * shared key and proofs + , Results (..) + + -- ** calculate and verify using @Results@ + , calcResults + , verifyServerProof + + -- * SRP Integer <=> ByteString interconversion + , bytesOf + , fromBytes + + -- * type aliases + , Username + , Password + + -- * re-exports + , PrimeGroup (..) + , KnownAlgorithm (..) + , digestSize + , hashText + , hashMany + , hash + ) +where + +import Crypto.SRP.Hashing + ( KnownAlgorithm (..) + , calcClientX + , calcK + , calcXorHashnHashg + , digestSize + , hash + , hashMany + , hashText + ) +import Crypto.SRP.PrimeGroup + ( PrimeGroup (..) + , bytesOf + , fromBytes + , modExpPrime + , padAs + , primeMod + , pubOf + ) +import Crypto.SRP.Random (gen256BitInteger) +import Data.ByteString (ByteString) +import Data.Text (Text) + + +-- | Identifies a user +type Username = Text + + +-- | A user's cleartext password +type Password = Text + + +-- | The shared secret key and proofs resulting from an SRP sequence +data Results = Results + { rKey :: !ByteString + , rClientProof :: !ByteString + , rServerProof :: !ByteString + } + deriving (Eq) + + +-- | Data sent back to the client from the server after it starts the SRP sequence +data FromServer = FromServer + { fsPublicBytes :: !ByteString + , fsSalt :: !ByteString + , fsPrimeGroup :: !PrimeGroup + , fsKnownAlgorithm :: !KnownAlgorithm + } + deriving (Eq) + + +-- | Data needed at the client to begin an SRP sequence +data FromClient = FromClient + { fcUser :: !Username + -- ^ identifies the user + , fcPassword :: !Password + -- ^ the clear text password + , fcPrivateNumber :: !Integer + -- ^ a randomly generated session secret + , fcPublicBytes :: !ByteString + -- ^ the client's public ephemeral key @g^a mod N@ + } + + +{- | Build a @FromClient@, generating the public and private ephemeral values +required for the client-side of the authentication process. + +The private ephemeral key is generated as a 256-bit random integer, which meets +the minimum key size required by +[RFC 5054 §2.6](https://datatracker.ietf.org/doc/html/rfc5054#section-2.6). +-} +mkFromClient :: Username -> Password -> PrimeGroup -> IO FromClient +mkFromClient fcUser fcPassword pg = do + private <- gen256BitInteger + let public = private `pubOf` pg + pure + FromClient + { fcUser + , fcPassword + , fcPublicBytes = bytesOf (fromIntegral public) + , fcPrivateNumber = private + } + + +-- | Verify a server proof +verifyServerProof :: (XCalculator a) => a -> ByteString -> FromClient -> FromServer -> Bool +verifyServerProof selectX serverProof fc fs = + case calcResults selectX fc fs of + Nothing -> False + Just results -> serverProof == rServerProof results + + +{- | Calculate the shared session key and proofs + + K = H(S) -- @S@ is the premaster secret, @K@ is the shared session key + + @M@ (clientProof) is calculated independently on the server and client and is + sent from the client to the server. If this does not match the server's value + the server aborts the authentication process. The client calculates this as: + + M = H(H(N) XOR H(g) | H(U) | s | A | B | K) + + @AMK@ (serverProof) is also calculated on both the server and client, but it's + sent by the server to the client after the server accepts the clientProof + received from the client + + AMK = H(A | M | K) + + if the serverProof does not match what the client expects, it aborts + + The 'XCalculator' argument models the choice existing in the calculation of + @x@, a hash depending on the user's password, on which @S@ in turn depends + + the calculation will abort if server public valid is invalid; in this case, the function + returns Nothing +-} +calcResults :: (XCalculator a) => a -> FromClient -> FromServer -> Maybe Results +calcResults selectX fc fs = + let FromServer {fsPublicBytes, fsSalt, fsPrimeGroup = pg, fsKnownAlgorithm = alg} = fs + FromClient {fcUser, fcPublicBytes = publicBytes} = fc + bigS = calcPremasterSecret selectX fc fs + xorNG = calcXorHashnHashg alg pg + hashedName = hashText alg fcUser + mkResult s = + let rKey = hash alg $ bytesOf (fromIntegral s) + + rClientProof = hashMany alg [xorNG, hashedName, fsSalt, publicBytes, fsPublicBytes, rKey] + rServerProof = hashMany alg [publicBytes, rClientProof, rKey] + in Results {rKey, rClientProof, rServerProof} + in mkResult <$> bigS + + +{- | Enables choice in the calculation of @x@ by 'calcResults'. + + One step in calculating @S@, the shared secret is the calculation of @x@, + which is a hash that depends on the user password. + + @x@ must depend on the password, and the SRP RFC specifies a hash calculation + that includes both the user identity and the password. + + However, it is not strictly necessary for @x@ to depend on the user identity, + and there are SRP server deployments that don't include the user name in @x@; + instead only the password is used, using a KDF (key derivation function) to + further protect it +-} +class XCalculator a where + -- | Calculates @x@, a hash that must depend on the user password + calcX :: a -> FromClient -> FromServer -> ByteString + + +{- | Implements the version of the @x@ calculation detailed in the SRP RFC + +@ x = H(s | H(I | ":" | P)) @ + +where @s@ is the salt from the server, @I@ is the user name, @P@ is the user +password and @H@ is the hash algorithm +-} +instance XCalculator () where + calcX () fc fs = + calcClientX (fcUser fc, fcPassword fc) (fsSalt fs) (fsKnownAlgorithm fs) + + +{- +The premaster secret is calculated by the client as follows: + I, P = + N, g, s, B = + a = random() + A = g^a % N + u = H(PAD(A) | PAD(B)) + k = H(N | PAD(g)) + x = calcX(FromClient, FromServer) + = (B - (k * g^x)) ^ (a + (u * x)) % N + == ((B - (k * g^x)) % N) ^ (a + (u * x)) % N + == (((B % N) - ((k * g^x) % N)) % N) ^ (a + (u *x)) % N + +the calculation will abort if B % N is zero; in this case, the function returns +Nothing +-} +calcPremasterSecret :: (XCalculator a) => a -> FromClient -> FromServer -> Maybe Integer +calcPremasterSecret selectX fc fs = + let + FromServer {fsPublicBytes, fsPrimeGroup = pg, fsKnownAlgorithm = alg} = fs + FromClient {fcPrivateNumber = private, fcPublicBytes = publicBytes} = fc + x = fromBytes $ calcX selectX fc fs + u = fromBytes $ hashMany alg [publicBytes `padAs` pg, fsPublicBytes `padAs` pg] + power = private + (u * x) + x' = x `pubOf` pg + bigB = fromBytes fsPublicBytes + shouldAbort = bigB `primeMod` pg == 0 + k = fromBytes $ calcK alg pg + base = ((bigB `primeMod` pg) - ((k * x') `primeMod` pg)) `primeMod` pg + in + if shouldAbort then Nothing else Just $ modExpPrime base power pg diff --git a/src/Crypto/SRP/Constants.hs b/src/Crypto/SRP/Constants.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/SRP/Constants.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune #-} + +{- | +Module : Crypto.SRP.Constants +Copyright : (c) 2025 Tim Emiola +Maintainer : Tim Emiola +SPDX-License-Identifier: BSD3 + +Provides the standard large safe primes and generators from +[RFC 5054 Appendix A](https://datatracker.ietf.org/doc/html/rfc5054#appendix-A), +encoded as hex @'ByteString'@s. +-} +module Crypto.SRP.Constants + ( -- * Hex ByteStrings of SRP primes + n1024Bits + , n1536Bits + , n2048Bits + , n3072Bits + , n4096Bits + , n6144Bits + , n8192Bits + ) +where + +import Data.ByteString (ByteString) + + +-- | A large safe prime (from RFC 5054, 1024-bit group) +n1024Bits :: ByteString +n1024Bits = + "EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C9C256576D674DF7496" + <> "EA81D3383B4813D692C6E0E0D5D8E250B98BE48E495C1D6089DAD15DC7D7B46154D6B6CE8E" + <> "F4AD69B15D4982559B297BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA" + <> "9AFD5138FE8376435B9FC61D2FC0EB06E3" + + +-- | A large safe prime (from RFC 5054, 1536-bit group) +n1536Bits :: ByteString +n1536Bits = + "9DEF3CAFB939277AB1F12A8617A47BBBDBA51DF499AC4C80BEEEA961" + <> "4B19CC4D5F4F5F556E27CBDE51C6A94BE4607A291558903BA0D0F843" + <> "80B655BB9A22E8DCDF028A7CEC67F0D08134B1C8B97989149B609E0B" + <> "E3BAB63D47548381DBC5B1FC764E3F4B53DD9DA1158BFD3E2B9C8CF5" + <> "6EDF019539349627DB2FD53D24B7C48665772E437D6C7F8CE442734A" + <> "F7CCB7AE837C264AE3A9BEB87F8A2FE9B8B5292E5A021FFF5E91479E" + <> "8CE7A28C2442C6F315180F93499A234DCF76E3FED135F9BB" + + +-- | A large safe prime (from RFC 5054, 2048-bit group) +n2048Bits :: ByteString +n2048Bits = + "AC6BDB41324A9A9BF166DE5E1389582FAF72B6651987EE07FC3192943DB56050A37329CBB4" + <> "A099ED8193E0757767A13DD52312AB4B03310DCD7F48A9DA04FD50E8083969EDB767B0CF60" + <> "95179A163AB3661A05FBD5FAAAE82918A9962F0B93B855F97993EC975EEAA80D740ADBF4FF" + <> "747359D041D5C33EA71D281E446B14773BCA97B43A23FB801676BD207A436C6481F1D2B907" + <> "8717461A5B9D32E688F87748544523B524B0D57D5EA77A2775D2ECFA032CFBDBF52FB37861" + <> "60279004E57AE6AF874E7303CE53299CCC041C7BC308D82A5698F3A8D0C38271AE35F8E9DB" + <> "FBB694B5C803D89F7AE435DE236D525F54759B65E372FCD68EF20FA7111F9E4AFF73" + + +-- | A large safe prime (from RFC 5054, 3072-bit group) +n3072Bits :: ByteString +n3072Bits = + "FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E08" + <> "8A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B" + <> "302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9" + <> "A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE6" + <> "49286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8" + <> "FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D" + <> "670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C" + <> "180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF695581718" + <> "3995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D" + <> "04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7D" + <> "B3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D226" + <> "1AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200C" + <> "BBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFC" + <> "E0FD108E4B82D120A93AD2CAFFFFFFFFFFFFFFFF" + + +-- | A large safe prime (from RFC 5054, 4096-bit group) +n4096Bits :: ByteString +n4096Bits = + "FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E08" + <> "8A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B" + <> "302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9" + <> "A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE6" + <> "49286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8" + <> "FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D" + <> "670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C" + <> "180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF695581718" + <> "3995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D" + <> "04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7D" + <> "B3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D226" + <> "1AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200C" + <> "BBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFC" + <> "E0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B26" + <> "99C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB" + <> "04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2" + <> "233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127" + <> "D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934063199" + <> "FFFFFFFFFFFFFFFF" + + +-- | A large safe prime (from RFC 5054, 6144-bit group) +n6144Bits :: ByteString +n6144Bits = + "FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E08" + <> "8A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B" + <> "302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9" + <> "A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE6" + <> "49286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8" + <> "FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D" + <> "670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C" + <> "180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF695581718" + <> "3995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D" + <> "04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7D" + <> "B3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D226" + <> "1AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200C" + <> "BBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFC" + <> "E0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B26" + <> "99C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB" + <> "04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2" + <> "233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127" + <> "D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934028492" + <> "36C3FAB4D27C7026C1D4DCB2602646DEC9751E763DBA37BDF8FF9406" + <> "AD9E530EE5DB382F413001AEB06A53ED9027D831179727B0865A8918" + <> "DA3EDBEBCF9B14ED44CE6CBACED4BB1BDB7F1447E6CC254B33205151" + <> "2BD7AF426FB8F401378CD2BF5983CA01C64B92ECF032EA15D1721D03" + <> "F482D7CE6E74FEF6D55E702F46980C82B5A84031900B1C9E59E7C97F" + <> "BEC7E8F323A97A7E36CC88BE0F1D45B7FF585AC54BD407B22B4154AA" + <> "CC8F6D7EBF48E1D814CC5ED20F8037E0A79715EEF29BE32806A1D58B" + <> "B7C5DA76F550AA3D8A1FBFF0EB19CCB1A313D55CDA56C9EC2EF29632" + <> "387FE8D76E3C0468043E8F663F4860EE12BF2D5B0B7474D6E694F91E" + <> "6DCC4024FFFFFFFFFFFFFFFF" + + +-- | A large safe prime (from RFC 5054, 8192-bit group) +n8192Bits :: ByteString +n8192Bits = + "FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E08" + <> "8A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B" + <> "302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9" + <> "A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE6" + <> "49286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8" + <> "FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D" + <> "670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C" + <> "180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF695581718" + <> "3995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D" + <> "04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7D" + <> "B3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D226" + <> "1AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200C" + <> "BBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFC" + <> "E0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B26" + <> "99C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB" + <> "04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2" + <> "233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127" + <> "D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934028492" + <> "36C3FAB4D27C7026C1D4DCB2602646DEC9751E763DBA37BDF8FF9406" + <> "AD9E530EE5DB382F413001AEB06A53ED9027D831179727B0865A8918" + <> "DA3EDBEBCF9B14ED44CE6CBACED4BB1BDB7F1447E6CC254B33205151" + <> "2BD7AF426FB8F401378CD2BF5983CA01C64B92ECF032EA15D1721D03" + <> "F482D7CE6E74FEF6D55E702F46980C82B5A84031900B1C9E59E7C97F" + <> "BEC7E8F323A97A7E36CC88BE0F1D45B7FF585AC54BD407B22B4154AA" + <> "CC8F6D7EBF48E1D814CC5ED20F8037E0A79715EEF29BE32806A1D58B" + <> "B7C5DA76F550AA3D8A1FBFF0EB19CCB1A313D55CDA56C9EC2EF29632" + <> "387FE8D76E3C0468043E8F663F4860EE12BF2D5B0B7474D6E694F91E" + <> "6DBE115974A3926F12FEE5E438777CB6A932DF8CD8BEC4D073B931BA" + <> "3BC832B68D9DD300741FA7BF8AFC47ED2576F6936BA424663AAB639C" + <> "5AE4F5683423B4742BF1C978238F16CBE39D652DE3FDB8BEFC848AD9" + <> "22222E04A4037C0713EB57A81A23F0C73473FC646CEA306B4BCBC886" + <> "2F8385DDFA9D4B7FA2C087E879683303ED5BDD3A062B3CF5B3A278A6" + <> "6D2A13F83F44F82DDF310EE074AB6A364597E899A0255DC164F31CC5" + <> "0846851DF9AB48195DED7EA1B1D510BD7EE74D73FAF36BC31ECFA268" + <> "359046F4EB879F924009438B481C6CD7889A002ED5EE382BC9190DA6" + <> "FC026E479558E4475677E9AA9E3050E2765694DFC81F56E880B96E71" + <> "60C980DD98EDD3DFFFFFFFFFFFFFFFFF" diff --git a/src/Crypto/SRP/Hashing.hs b/src/Crypto/SRP/Hashing.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/SRP/Hashing.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# OPTIONS_HADDOCK prune #-} + +{- | +Module : Crypto.SRP.Hashing +Copyright : (c) 2025 Tim Emiola +Maintainer : Tim Emiola +SPDX-License-Identifier: BSD3 + +Provides the 'KnownAlgorithm' abstraction over SHA1, SHA256, SHA384 and SHA512, +together with the SRP-specific hash combinators ('calcK', 'calcClientX', +'calcXorHashnHashg') that implement the intermediate steps from +[RFC 5054 §2.6](https://datatracker.ietf.org/doc/html/rfc5054#section-2.6). +-} +module Crypto.SRP.Hashing + ( -- * Supported hash algorithms + KnownAlgorithm (..) + + -- ** Use the @'KnownAlgorithm's@ for hashing + , digestSize + , hash + , hashMany + , hashText + + -- * SRP-specific hash calculations + , calcK + , calcClientX + , calcXorHashnHashg + ) +where + +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA384 as SHA384 +import qualified Crypto.Hash.SHA512 as SHA512 +import Crypto.SRP.PrimeGroup + ( PrimeGroup + , bytesOf + , generatorFor + , padAs + , safePrimeFor + ) +import Data.Bits (xor) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Data.Text.Normalize (NormalizationMode (NFKC), normalize) +import Data.Word (Word32) + + +{- | Compute the multiplier \'k\' as a step in the calculation of the premaster + secret + +See [premaster secret calculation](https://datatracker.ietf.org/doc/html/rfc5054#section-2.6) +-} +calcK :: KnownAlgorithm -> PrimeGroup -> ByteString +calcK known pg = + hashMany + known + [ bytesOf (fromIntegral (safePrimeFor pg)) `padAs` pg + , bytesOf (fromIntegral (generatorFor pg)) `padAs` pg + ] + + +-- | Compute an XORed hash describing a @'PrimeGroup'@. +calcXorHashnHashg :: KnownAlgorithm -> PrimeGroup -> ByteString +calcXorHashnHashg known pg = + let hashedN = hash known (bytesOf (fromIntegral (safePrimeFor pg))) + hashedG = hash known (bytesOf (fromIntegral (generatorFor pg)) `padAs` pg) + in BS.pack $ BS.zipWith xor hashedN hashedG + + +{- | Compute the hash \'x\' as a step in the calculation of the premaster secret + +See [premaster secret calculation](https://datatracker.ietf.org/doc/html/rfc5054#section-2.6) +-} +calcClientX :: (Text, Text) -> ByteString -> KnownAlgorithm -> ByteString +calcClientX (username, password) serverSalt known = + let h = hashMany known + normalize' = encodeUtf8 . normalize NFKC + in h [serverSalt, h [normalize' username, ":", normalize' password]] + + +-- | Hash a 'Text' value after normalising it to NFKC form +hashText :: KnownAlgorithm -> Text -> ByteString +hashText known txt = + let + normalize' = encodeUtf8 . normalize NFKC + in + hash known $ normalize' txt + + +-- | Provides an interface to the implemention of a hash algorithm +data Algorithm = Algorithm + { algDigestSize :: {-# UNPACK #-} !Word32 + , algHash :: !(ByteString -> ByteString) + , algHashMany :: !([ByteString] -> ByteString) + } + + +-- | Hash a @ByteString@ using the hash function of a 'KnownAlgorithm' +hash :: KnownAlgorithm -> ByteString -> ByteString +hash = algHash . alg + + +-- | Hash several @ByteStrings@ using the hash function of a 'KnownAlgorithm' +hashMany :: KnownAlgorithm -> [ByteString] -> ByteString +hashMany = algHashMany . alg + + +-- | The size of digest computed by a 'KnownAlgorithm' +digestSize :: KnownAlgorithm -> Word32 +digestSize = algDigestSize . alg + + +-- | Enumerates specific hash algorithms supported by this package +data KnownAlgorithm + = SHA1 + | SHA256 + | SHA384 + | SHA512 + deriving (Eq, Show) + + +-- Provides an 'Algorithm' that contains the implementation for each 'KnownAlgorithm' +alg :: KnownAlgorithm -> Algorithm +alg SHA1 = Algorithm 20 SHA1.hash (SHA1.finalize . SHA1.updates SHA1.init) +alg SHA256 = Algorithm 32 SHA256.hash (SHA256.finalize . SHA256.updates SHA256.init) +alg SHA384 = Algorithm 48 SHA384.hash (SHA384.finalize . SHA384.updates SHA384.init) +alg SHA512 = Algorithm 64 SHA512.hash (SHA512.finalize . SHA512.updates SHA512.init) diff --git a/src/Crypto/SRP/PrimeGroup.hs b/src/Crypto/SRP/PrimeGroup.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/SRP/PrimeGroup.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_HADDOCK prune #-} + +{- | +Module : Crypto.SRP.PrimeGroup +Copyright : (c) 2025 Tim Emiola +Maintainer : Tim Emiola +SPDX-License-Identifier: BSD3 + +Provides the 'PrimeGroup' type representing the standard SRP prime groups +(1024–8192 bits) and the group-arithmetic operations used during the SRP +handshake: public key generation ('pubOf'), modular exponentiation +('modExpPrime'), and @'ByteString'@ encoding helpers. +-} +module Crypto.SRP.PrimeGroup + ( -- * the PrimeGroups + PrimeGroup (..) + , generatorFor + , safePrimeFor + , asByteString + , hexLength + , byteLength + , pubOf + , padAs + , primeMod + , modExpPrime + + -- * SRP Integer \<=> ByteString interconversion + , bytesOf + , fromBytes + ) +where + +import Crypto.SRP.Constants + ( n1024Bits + , n1536Bits + , n2048Bits + , n3072Bits + , n4096Bits + , n6144Bits + , n8192Bits + ) +import Data.Bits (Bits (shiftR, testBit, (.&.))) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Char (ord) +import Data.Word (Word8) +import Numeric.Natural (Natural) + + +-- | Represents the primeGroups used in SRP computations +data PrimeGroup + = G1024 + | G1536 + | G2048 + | G3072 + | G4096 + | G6144 + | G8192 + deriving (Eq, Show) + + +-- | The generator for 'PrimeGroup' +generatorFor :: PrimeGroup -> Word8 +generatorFor G1024 = 0x2 +generatorFor G1536 = 0x2 +generatorFor G2048 = 0x2 +generatorFor G3072 = 0x5 +generatorFor G4096 = 0x5 +generatorFor G6144 = 0x5 +generatorFor G8192 = 0x19 + + +-- | The safe prime for 'PrimeGroup' +safePrimeFor :: PrimeGroup -> Integer +safePrimeFor G1024 = p1024 +safePrimeFor G1536 = p1536 +safePrimeFor G2048 = p2048 +safePrimeFor G3072 = p3072 +safePrimeFor G4096 = p4096 +safePrimeFor G6144 = p6144 +safePrimeFor G8192 = p8192 + + +fromHexBS :: ByteString -> Integer +fromHexBS = BS.foldl' (\acc d -> acc * 16 + hexCharToInt d) 0 + + +hexCharToInt :: Word8 -> Integer +hexCharToInt w = + let wI = fromIntegral w :: Integer + to0 = wI - fromIntegral (ord '0') + toa = wI - fromIntegral (ord 'a') + toA = wI - fromIntegral (ord 'A') + in if + | to0 >= 0 && to0 < 10 -> to0 + | toa >= 0 && toa < 6 -> toa + 10 + | toA >= 0 && toA < 6 -> toA + 10 + | otherwise -> error $ "fromHexBS: invalid hex byte " ++ show w + + +p1024, p1536, p2048, p3072, p4096, p6144, p8192 :: Integer +p1024 = fromHexBS n1024Bits +p1536 = fromHexBS n1536Bits +p2048 = fromHexBS n2048Bits +p3072 = fromHexBS n3072Bits +p4096 = fromHexBS n4096Bits +p6144 = fromHexBS n6144Bits +p8192 = fromHexBS n8192Bits + + +-- | A ByteString representing the safe prime in hexadecimal +asByteString :: PrimeGroup -> ByteString +asByteString G1024 = n1024Bits +asByteString G1536 = n1536Bits +asByteString G2048 = n2048Bits +asByteString G3072 = n3072Bits +asByteString G4096 = n4096Bits +asByteString G6144 = n6144Bits +asByteString G8192 = n8192Bits + + +-- | The number of hex characters in the representation of the safe prime +hexLength :: PrimeGroup -> Int +hexLength = BS.length . asByteString + + +-- | The number of bytes in the binary encoding of the safe prime +byteLength :: PrimeGroup -> Int +byteLength = (`div` 2) . hexLength + + +-- | Encode a @Natural@ number as a @ByteString@ +bytesOf :: Natural -> ByteString +bytesOf 0 = BS.pack [0] +bytesOf n = BS.pack $ reverse (bytes n) + where + bytes 0 = [] + bytes x = fromIntegral (x .&. 0xFF) : bytes (shiftR x 8) + + +-- | Obtain an @Integer@ from its @ByteString@ encoding +fromBytes :: ByteString -> Integer +fromBytes = BS.foldl' (\acc b -> acc * 256 + fromIntegral b) 0 + + +-- | Reduce an @Integer@ modulo the safe prime of a 'PrimeGroup' +primeMod :: Integer -> PrimeGroup -> Integer +primeMod num pg = + let prime = safePrimeFor pg + in num `mod` prime + + +{- | Pad a 'ByteString' to the binary byte length of the safe prime of a +'PrimeGroup', prepending zero bytes as needed. + +Precondition: @'BS.length' bs <= 'byteLength' pg@. If @bs@ is longer than the +group's byte length, no truncation occurs — the input is returned unchanged. +-} +padAs :: ByteString -> PrimeGroup -> ByteString +padAs bs pg = + let padLength = byteLength pg - BS.length bs + in BS.replicate padLength 0 <> bs + + +{- | Generate the public version of a private ephemeral key + +the private version of the key is expected to be a randomly generated integer +-} +pubOf :: Integer -> PrimeGroup -> Integer +pubOf priv pg = modExpPrime (fromIntegral (generatorFor pg)) priv pg + + +{- | Perform exponentiation modulus the large number in a 'PrimeGroup' + +Example + + > modExpPrime base power G2048 +-} +modExpPrime :: Integer -> Integer -> PrimeGroup -> Integer +modExpPrime base power pg = modExp base power (safePrimeFor pg) + + +modExp :: Integer -> Integer -> Integer -> Integer +modExp base expn m = go 1 (base `mod` m) expn + where + go !acc !b !e + | e == 0 = acc + | otherwise = + let acc' = if testBit e 0 then (acc * b) `mod` m else acc + in go acc' ((b * b) `mod` m) (shiftR e 1) diff --git a/src/Crypto/SRP/Random.hs b/src/Crypto/SRP/Random.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/SRP/Random.hs @@ -0,0 +1,31 @@ +{-# OPTIONS_HADDOCK prune #-} + +{- | +Module : Crypto.SRP.Random +Copyright : (c) 2025 Tim Emiola +Maintainer : Tim Emiola +SPDX-License-Identifier: BSD3 + +Provides cryptographically secure random byte generation used to produce the +private ephemeral key in the SRP handshake. Uses hardware entropy when +available, falling back to the OS entropy source via @System.Entropy@. +-} +module Crypto.SRP.Random + ( genNSecureBytes + , gen256BitInteger + ) +where + +import Crypto.SRP.PrimeGroup (fromBytes) +import Data.ByteString (ByteString) +import System.Entropy (getEntropy, getHardwareEntropy) + + +-- | Get a specific number of bytes of cryptographically secure random data +genNSecureBytes :: Int -> IO ByteString +genNSecureBytes n = maybe (getEntropy n) pure =<< getHardwareEntropy n + + +-- | Generate a cryptographically secure random 256-bit @Integer@ +gen256BitInteger :: IO Integer +gen256BitInteger = fromBytes <$> genNSecureBytes 32 diff --git a/test/Crypto/PysrpCompatSpec.hs b/test/Crypto/PysrpCompatSpec.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/PysrpCompatSpec.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Crypto.PysrpCompatSpec + ( spec + ) +where + +import Crypto.SRP + ( FromServer (..) + , KnownAlgorithm (..) + , PrimeGroup (..) + , Results (..) + , calcResults + , fcPublicBytes + , mkFromClient + ) +import qualified Data.ByteString as BS +import Numeric (readHex, showHex) +import Paths_crypto_srp (getDataFileName) +import System.Environment (getEnvironment) +import System.IO + ( BufferMode (..) + , hFlush + , hGetLine + , hPutStrLn + , hSetBuffering + ) +import System.Process + ( CreateProcess (..) + , StdStream (..) + , createProcess + , proc + , waitForProcess + ) +import Test.Hspec (Spec, describe, it, shouldBe) + + +encodeHex :: BS.ByteString -> String +encodeHex = concatMap padByte . BS.unpack + where + padByte b = case showHex b "" of + [c] -> ['0', c] + s -> s + + +decodeHex :: String -> BS.ByteString +decodeHex = BS.pack . go + where + go [] = [] + go (a : b : rest) = case readHex [a, b] of + [(v, "")] -> v : go rest + _ -> error $ "invalid hex pair: " ++ [a, b] + go [_] = error "odd-length hex string" + + +spec :: Spec +spec = describe "pysrp compatibility" $ + it "completes a full SRP round-trip with pysrp as the server" $ do + scriptPath <- getDataFileName "test/pysrp_server.py" + baseEnv <- getEnvironment + let creds = [("PYSRP_USER", "alice"), ("PYSRP_PASS", "hunter2")] + processEnv = creds ++ baseEnv + user = "alice" + pass = "hunter2" + + fc <- mkFromClient user pass G2048 + + (Just hin, Just hout, _, ph) <- + createProcess + (proc "python3" [scriptPath]) + { std_in = CreatePipe + , std_out = CreatePipe + , env = Just processEnv + } + hSetBuffering hin LineBuffering + hSetBuffering hout LineBuffering + + hPutStrLn hin $ encodeHex $ fcPublicBytes fc + hFlush hin + + line <- hGetLine hout + let (saltBS, bBS) = case words line of + [s, b] -> (decodeHex s, decodeHex b) + _ -> error $ "unexpected pysrp_server.py output: " ++ line + fs = + FromServer + { fsPublicBytes = bBS + , fsSalt = saltBS + , fsPrimeGroup = G2048 + , fsKnownAlgorithm = SHA256 + } + + case calcResults () fc fs of + Nothing -> fail "calcResults returned Nothing (server public key was invalid)" + Just results -> do + hPutStrLn hin $ encodeHex $ rClientProof results + hFlush hin + + m2Line <- hGetLine hout + m2Line `shouldBe` encodeHex (rServerProof results) + + _ <- waitForProcess ph + pure () diff --git a/test/Crypto/SRPSpec.hs b/test/Crypto/SRPSpec.hs new file mode 100644 --- /dev/null +++ b/test/Crypto/SRPSpec.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} + +module Crypto.SRPSpec + ( spec + ) +where + +import Crypto.SRP + ( FromClient (..) + , FromServer (..) + , KnownAlgorithm (..) + , Results (..) + , bytesOf + , calcResults + , digestSize + , fromBytes + , hash + , verifyServerProof + ) +import Crypto.SRP.Constants + ( n1024Bits + , n1536Bits + , n2048Bits + , n3072Bits + , n4096Bits + , n6144Bits + , n8192Bits + ) +import Crypto.SRP.Hashing (calcClientX, calcK) +import Crypto.SRP.PrimeGroup + ( PrimeGroup (..) + , byteLength + , hexLength + , padAs + , safePrimeFor + ) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Char (ord) +import Data.Word (Word8) +import Fmt (build, fmt, hexF, (+|), (|+)) +import Numeric (readHex) +import Numeric.Natural (Natural) +import Test.Hspec (Spec, context, describe, expectationFailure, it, shouldBe) +import Test.QuickCheck + ( Property + , chooseInteger + , forAll + ) + + +spec :: Spec +spec = describe "module Crypto.SRP.Constants" $ do + largeNumberSpec + viaBytesSpec + primeGroupSpec + hashingSpec + rfc5054Spec + + +viaBytes :: Natural -> Integer +viaBytes = fromBytes . bytesOf + + +max64Bit :: Integer +max64Bit = (2 ^ (63 :: Int)) - 1 + + +prop_roundtripViaBytes :: Property +prop_roundtripViaBytes = forAll (chooseInteger (0, max64Bit)) $ \anInteger -> + viaBytes (fromIntegral anInteger) == anInteger + + +viaBytesSpec :: Spec +viaBytesSpec = describe "roundtrip bytesOf then fromBytes" $ do + context "for any 64-bit integer" $ do + it "should succeed" prop_roundtripViaBytes + + +largeNumberSpec :: Spec +largeNumberSpec = describe "the fixed large numbers" $ do + oneNumberSpec n1024Bits 1024 + oneNumberSpec n1536Bits 1536 + oneNumberSpec n2048Bits 2048 + oneNumberSpec n3072Bits 3072 + oneNumberSpec n4096Bits 4096 + oneNumberSpec n6144Bits 6144 + oneNumberSpec n8192Bits 8192 + + +oneNumberSpec :: ByteString -> Int -> Spec +oneNumberSpec b bitSize = do + context ("the ByteString representing the " +| bitSize |+ " bit number") $ do + context "each byte" $ do + it "should be a valid hexadecimal value" $ isAllHex b + it "should roundtrip with its integer value" $ fromHexBS b == fromHexBS (bsShow (fromHexBS b)) + context "hexLength" $ do + it "should be consistent with the number of bits" $ BS.length b == bitSize `div` 4 + + +hashingSpec :: Spec +hashingSpec = describe "module Crypto.SRP.Hashing" $ do + context "digestSize" $ do + it "SHA1 is 20 bytes" $ digestSize SHA1 == 20 + it "SHA256 is 32 bytes" $ digestSize SHA256 == 32 + it "SHA384 is 48 bytes" $ digestSize SHA384 == 48 + it "SHA512 is 64 bytes" $ digestSize SHA512 == 64 + context "hash output length" $ do + it "SHA1 produces digestSize bytes" $ BS.length (hash SHA1 "x") == fromIntegral (digestSize SHA1) + it "SHA256 produces digestSize bytes" $ BS.length (hash SHA256 "x") == fromIntegral (digestSize SHA256) + it "SHA384 produces digestSize bytes" $ BS.length (hash SHA384 "x") == fromIntegral (digestSize SHA384) + it "SHA512 produces digestSize bytes" $ BS.length (hash SHA512 "x") == fromIntegral (digestSize SHA512) + + +-- RFC 5054 Appendix B test vectors (G1024 / SHA1). +-- Private ephemeral values a and b are fixed so the exchange is deterministic. +rfc5054Spec :: Spec +rfc5054Spec = describe "RFC 5054 Appendix B" $ do + let salt = hexBS "BEB25379D1A8581EB5A727673A2441EE" + aPriv = fromHexBS "60975527035CF2AD1989806F0407210BC81EDC04E2762A56AFD529DDDA2D4393" + aPub = + hexBS + "61d5e490f6f1b79547b0704c436f523dd0e560f0c64115bb72557ec44352e8903211c04692272d8b2d1a5358a2cf1b6e0bfcf99f921530ec8e39356179eae45e42ba92aeaced825171e1e8b9af6d9c03e1327f44be087ef06530e69f66615261eef54073ca11cf5858f0edfdfe15efeab349ef5d76988a3672fac47b0769447b" + bPub = + hexBS + "bd0c61512c692c0cb6d041fa01bb152d4916a1e77af46ae105393011baf38964dc46a0670dd125b95a981652236f99d9b681cbf87837ec996c6da04453728610d0c6ddb58b318885d7d82c7f8deb75ce7bd4fbaa37089e6f9c6059f388838e7a00030b331eb76840910440b1b27aaeaeeb4012b7d7665238a8e3fb004b117b58" + fc = + FromClient + { fcUser = "alice" + , fcPassword = "password123" + , fcPrivateNumber = aPriv + , fcPublicBytes = aPub + } + fs = + FromServer + { fsPublicBytes = bPub + , fsSalt = salt + , fsPrimeGroup = G1024 + , fsKnownAlgorithm = SHA1 + } + expectedK = hexBS "017eefa1cefc5c2e626e21598987f31e0f1b11bb" + expectedM1 = hexBS "62c71b289cb22a034b405667e1541202ce5d8e03" + expectedM2 = hexBS "b475d7f2d75ce9537748005483e5d326048b59e9" + expectedMultiplierK = hexBS "7556AA045AEF2CDD07ABAF0F665C3E818913186F" + expectedX = hexBS "94B7555AABE9127CC58CCF4993DB6CF84D16C124" + + it "calcResults produces the correct session key and proofs" $ + case calcResults () fc fs of + Nothing -> expectationFailure "calcResults returned Nothing" + Just results -> do + rKey results `shouldBe` expectedK + rClientProof results `shouldBe` expectedM1 + rServerProof results `shouldBe` expectedM2 + + it "verifyServerProof returns True for the correct M2" $ + verifyServerProof () expectedM2 fc fs `shouldBe` True + + it "verifyServerProof returns False for a wrong M2" $ + verifyServerProof () (BS.replicate (fromIntegral (digestSize SHA1)) 0) fc fs `shouldBe` False + + it "calcResults returns Nothing when B is a multiple of N" $ + let fsInvalid = fs {fsPublicBytes = bytesOf (fromIntegral (safePrimeFor G1024))} + in case calcResults () fc fsInvalid of + Nothing -> pure () + Just _ -> expectationFailure "expected Nothing for B ≡ 0 (mod N)" + + it "calcK produces the RFC 5054 Appendix B multiplier k" $ + calcK SHA1 G1024 `shouldBe` expectedMultiplierK + + it "calcClientX produces the RFC 5054 Appendix B x for alice/password123" $ + calcClientX ("alice", "password123") salt SHA1 `shouldBe` expectedX + + +fromHexBS :: ByteString -> Integer +fromHexBS = BS.foldl' (\acc d -> acc * 16 + hexCharToInt d) 0 + + +hexCharToInt :: Word8 -> Integer +hexCharToInt w = + let to0 = w - ordAlt '0' + toa = w - ordAlt 'a' + toA = w - ordAlt 'A' + in if + | to0 < 10 -> fromIntegral to0 + | toa < 6 -> fromIntegral toa + 10 + | toA < 6 -> fromIntegral toA + 10 + | otherwise -> error $ "fromHexBS: invalid hex byte " ++ show w + + +hexBS :: String -> ByteString +hexBS = BS.pack . go + where + go [] = [] + go (a : b : rest) = case readHex [a, b] of + [(v, "")] -> v : go rest + _ -> error $ "hexBS: invalid pair: " ++ [a, b] + go [_] = error "hexBS: odd-length string" + + +isHexChar :: Word8 -> Bool +isHexChar w = w - ordAlt '0' < 10 || w - ordAlt 'A' < 6 || w - ordAlt 'a' < 6 + + +ordAlt :: Char -> Word8 +ordAlt = fromIntegral . ord + + +isAllHex :: ByteString -> Bool +isAllHex b = + let + checkWord _ignored False = False + checkWord nextChar True = isHexChar nextChar + in + BS.foldr checkWord True b + + +bsShow :: Integer -> ByteString +bsShow = fmt . build . hexF + + +primeGroupSpec :: Spec +primeGroupSpec = describe "module Crypto.SRP.PrimeGroup" $ do + it "byteLength is hexLength `div` 2" $ + byteLength G2048 == hexLength G2048 `div` 2 + it "padAs pads a short ByteString to the binary byte length of N" $ + BS.length (BS.empty `padAs` G2048) == byteLength G2048 + it "padAs returns an oversized ByteString unchanged" $ + let oversized = BS.replicate (byteLength G2048 + 1) 0 + in BS.length (oversized `padAs` G2048) == byteLength G2048 + 1 diff --git a/test/PysrpSpec.hs b/test/PysrpSpec.hs new file mode 100644 --- /dev/null +++ b/test/PysrpSpec.hs @@ -0,0 +1,6 @@ +import qualified Crypto.PysrpCompatSpec +import Test.Hspec (hspec) + + +main :: IO () +main = hspec Crypto.PysrpCompatSpec.spec diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,6 @@ +import qualified Crypto.SRPSpec +import Test.Hspec (hspec) + + +main :: IO () +main = hspec Crypto.SRPSpec.spec diff --git a/test/pysrp_server.py b/test/pysrp_server.py new file mode 100644 --- /dev/null +++ b/test/pysrp_server.py @@ -0,0 +1,44 @@ +#!/usr/bin/env python3 +""" +pysrp compatibility server for crypto-srp tests. + +Protocol (all values hex-encoded, one value per line): + stdin: A + stdout: salt B + stdin: M1 + stdout: M2 (or FAIL if M1 did not verify) + +Username and password are read from environment variables PYSRP_USER and PYSRP_PASS. +""" +import os +import sys +import srp + +# Use RFC 5054 padding (PAD(g) for k, PAD(A)/PAD(B) for u) to match crypto-srp. +srp.rfc5054_enable() + +user = os.environ["PYSRP_USER"] +password = os.environ["PYSRP_PASS"] + +salt, verifier = srp.create_salted_verification_key( + user, password, hash_alg=srp.SHA256, ng_type=srp.NG_2048 +) + +a_hex = sys.stdin.readline().strip() +A = bytes.fromhex(a_hex) + +svr = srp.Verifier(user, salt, verifier, A, hash_alg=srp.SHA256, ng_type=srp.NG_2048) +svr_salt, B = svr.get_challenge() + +sys.stdout.write(svr_salt.hex() + " " + B.hex() + "\n") +sys.stdout.flush() + +m1_hex = sys.stdin.readline().strip() +M1 = bytes.fromhex(m1_hex) + +HAMK = svr.verify_session(M1) +if HAMK is None: + sys.stdout.write("FAIL\n") +else: + sys.stdout.write(HAMK.hex() + "\n") +sys.stdout.flush()