hwormhole-0.2.0.1: tests/Generator.hs

-- | Hedgehog generators for the messages
module Generator
  ( abilityGen
  , abilityV1Gen
  , hintGen
  , connectionHintGen
  , ackGen
  , transitMsgGen
  , transitAckGen
  , nonceBytesGen
  , purposeGen
  )
where

import Protolude

import Hedgehog (MonadGen(..))
import Crypto.Saltine.Internal.ByteSizes (boxNonce)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import Transit.Internal.Messages
  ( Ability(..)
  , AbilityV1(..)
  , Hint(..)
  , ConnectionHint(..)
  , Ack(..)
  , TransitMsg(..)
  , TransitAck(..)
  )
import qualified Transit.Internal.Crypto as C

abilityGen :: MonadGen m => m Ability
abilityGen = Ability <$> abilityV1Gen

abilityV1Gen :: MonadGen m => m AbilityV1
abilityV1Gen = Gen.choice
  [ pure DirectTcpV1
  , pure RelayV1
  ]

hintGen :: MonadGen m => m Hint
hintGen = Hint <$> abilityV1Gen
           <*> Gen.double (Range.linearFrac 0.0 5.0)
           <*> Gen.text (Range.linear 0 100) Gen.unicode
           <*> Gen.word16 (Range.linear 0 maxBound)

connectionHintGen :: MonadGen m => m ConnectionHint
connectionHintGen = Gen.choice
  [ Direct <$> hintGen
  , Relay <$> abilityV1Gen <*> Gen.list (Range.linear 0 10) hintGen
  ]

ackGen :: MonadGen m => m Ack
ackGen = Gen.choice
  [ FileAck <$> Gen.text (Range.linear 0 100) Gen.ascii
  , MessageAck <$> Gen.text (Range.linear 0 100) Gen.ascii
  ]

transitMsgGen :: MonadGen m => m TransitMsg
transitMsgGen = Gen.choice
  [ Error <$> Gen.text (Range.linear 0 100) Gen.unicode
  , Answer <$> ackGen
  , Transit
    <$> Gen.list (Range.linear 0 5) abilityGen
    <*> Gen.set (Range.linear 0 5) connectionHintGen
  ]

transitAckGen :: MonadGen m => m TransitAck
transitAckGen = TransitAck
  <$> Gen.text (Range.linear 0 5) Gen.unicode
  <*> Gen.text (Range.singleton 64) Gen.hexit

nonceBytesGen :: MonadGen m => m ByteString
nonceBytesGen = Gen.bytes (Range.singleton boxNonce)

purposeGen :: MonadGen m => m C.Purpose
purposeGen = Gen.choice [ pure C.SenderHandshake
                        , pure C.ReceiverHandshake
                        , pure C.SenderRecord
                        , pure C.ReceiverRecord
                        , pure C.RelayHandshake ]