crypto-srp (empty) → 0.1.0.0
raw patch · 14 files changed
+1317/−0 lines, 14 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, crypto-srp, cryptohash-sha1, cryptohash-sha256, cryptohash-sha512, entropy, fmt, hspec, process, text, unicode-transforms
Files
- ChangeLog.md +9/−0
- LICENSE +30/−0
- README.md +16/−0
- crypto-srp.cabal +92/−0
- src/Crypto/SRP.hs +249/−0
- src/Crypto/SRP/Constants.hs +177/−0
- src/Crypto/SRP/Hashing.hs +132/−0
- src/Crypto/SRP/PrimeGroup.hs +192/−0
- src/Crypto/SRP/Random.hs +31/−0
- test/Crypto/PysrpCompatSpec.hs +103/−0
- test/Crypto/SRPSpec.hs +230/−0
- test/PysrpSpec.hs +6/−0
- test/Spec.hs +6/−0
- test/pysrp_server.py +44/−0
+ ChangeLog.md view
@@ -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
+ LICENSE view
@@ -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.
+ README.md view
@@ -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+
+ crypto-srp.cabal view
@@ -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
+ src/Crypto/SRP.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module : Crypto.SRP+Copyright : (c) 2025 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+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 = <read from user>+ N, g, s, B = <read from server>+ a = random()+ A = g^a % N+ u = H(PAD(A) | PAD(B))+ k = H(N | PAD(g))+ x = calcX(FromClient, FromServer)+ <premaster secret> = (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
+ src/Crypto/SRP/Constants.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module : Crypto.SRP.Constants+Copyright : (c) 2025 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+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"
+ src/Crypto/SRP/Hashing.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module : Crypto.SRP.Hashing+Copyright : (c) 2025 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+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)
+ src/Crypto/SRP/PrimeGroup.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module : Crypto.SRP.PrimeGroup+Copyright : (c) 2025 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+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)
+ src/Crypto/SRP/Random.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_HADDOCK prune #-}++{- |+Module : Crypto.SRP.Random+Copyright : (c) 2025 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+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
+ test/Crypto/PysrpCompatSpec.hs view
@@ -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 ()
+ test/Crypto/SRPSpec.hs view
@@ -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
+ test/PysrpSpec.hs view
@@ -0,0 +1,6 @@+import qualified Crypto.PysrpCompatSpec+import Test.Hspec (hspec)+++main :: IO ()+main = hspec Crypto.PysrpCompatSpec.spec
+ test/Spec.hs view
@@ -0,0 +1,6 @@+import qualified Crypto.SRPSpec+import Test.Hspec (hspec)+++main :: IO ()+main = hspec Crypto.SRPSpec.spec
+ test/pysrp_server.py view
@@ -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()