cryptopals

Matasano's cryptopals challenges (cryptopals.com).
git clone git://git.jtobin.io/cryptopals.git
Log | Files | Refs | README | LICENSE

DH.hs (2372B)

      1 module Cryptopals.DH (
      2     p
      3   , g
      4   , modexp
      5   , encodekey
      6   ) where
      7 
      8 import Control.Monad.Primitive
      9 import Control.Monad.Trans.State (StateT)
     10 import qualified Control.Monad.Trans.State as S
     11 import Cryptopals.DH.Core
     12 import Cryptopals.DH.Session
     13 import qualified Data.Binary as DB
     14 import qualified Data.ByteString as BS
     15 import qualified Data.Text as T
     16 import GHC.Word (Word32)
     17 import Numeric.Natural
     18 import Pipes
     19 import qualified Pipes.Binary as PB
     20 import qualified Pipes.Network as PN
     21 import qualified System.Random.MWC as MWC
     22 
     23 -- await key exchange
     24 bob
     25   :: (DB.Binary b, DB.Binary c)
     26   => PN.ServiceName
     27   -> PN.Protocol (StateT Sesh IO) b c
     28   -> IO ()
     29 bob port eval = PN.serve "localhost" port $ \(sock, _) -> do
     30   let host = "bob"
     31       sesh = open sock host
     32   blog host "listening.."
     33   void $ S.evalStateT (runEffect (PN.session sock eval)) sesh
     34 
     35 -- initiate key exchange
     36 alice
     37   :: (DB.Binary b, DB.Binary c)
     38   => PN.ServiceName
     39   -> PN.Protocol (StateT Sesh IO) b c
     40   -> StateT Sesh IO Command
     41   -> IO ()
     42 alice port eval knit = PN.connect "localhost" port $ \(sock, _) -> do
     43   let host = "alice"
     44       sesh = open sock host
     45   blog host "session established"
     46 
     47   (cmd, nex) <- S.runStateT knit sesh
     48 
     49   runEffect $
     50         PB.encode (Just cmd)
     51     >-> PN.toSocket sock
     52 
     53   void $ S.runStateT (runEffect (PN.session sock eval)) nex
     54 
     55 -- await key exchange
     56 mallory
     57   :: (DB.Binary b, DB.Binary c)
     58   => PN.ServiceName
     59   -> PN.ServiceName
     60   -> PN.Protocol (StateT Sesh IO) b c
     61   -> IO ()
     62 mallory port bport eval = do
     63   let host = "mallory"
     64   PN.serve "localhost" port $ \(asock, _) -> do
     65     let sesh = open asock host
     66     blog host  "LiSteNIng.."
     67     PN.connect "localhost" bport $ \(bsock, _) -> do
     68       blog host "eStabLisHed MiTm coNNecTion"
     69       void $ S.runStateT (runEffect (PN.dance asock bsock eval)) sesh
     70 
     71 -- initialize session with basic stuff
     72 open :: PN.Socket -> T.Text -> Sesh
     73 open sock host = Sesh {
     74     dhGroup = Nothing
     75   , dhHost  = host
     76   , dhSock  = sock
     77   , dhKeys  = Nothing
     78   , dhKey   = Nothing
     79   , dhGen   = MWC.createSystemRandom
     80   }
     81 
     82 sendParams :: StateT Sesh IO Command
     83 sendParams = do
     84   grp <- genGroup p g
     85   Keys {..} <- genKeypair
     86   slog "sending group parameters and public key"
     87   pure (SendParams grp pub)
     88 
     89 sendGroup :: StateT Sesh IO Command
     90 sendGroup = do
     91   grp <- genGroup p g
     92   slog "sending group parameters"
     93   pure (SendGroup grp)