minor-fix: extracted SignedBox and code sweeped

This commit is contained in:
Dmitry Zuikov 2023-09-15 10:59:54 +03:00
parent 93137d8f4c
commit 80278834b8
3 changed files with 37 additions and 31 deletions

View File

@ -1,4 +1,5 @@
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module HBS2.Data.Types.SignedBox where module HBS2.Data.Types.SignedBox where
import HBS2.Prelude.Plated import HBS2.Prelude.Plated
@ -8,6 +9,10 @@ import HBS2.Net.Auth.Credentials
import Codec.Serialise import Codec.Serialise
import Data.Hashable import Data.Hashable
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as LBS
import Control.Monad.Trans.Maybe
import Data.Function
import Control.Monad.Identity
data SignedBox p e = data SignedBox p e =
SignedBox (PubKey 'Sign (Encryption e)) ByteString (Signature (Encryption e)) SignedBox (PubKey 'Sign (Encryption e)) ByteString (Signature (Encryption e))
@ -33,3 +38,34 @@ type ForSignedBox e = ( Serialise ( PubKey 'Sign (Encryption e))
instance ForSignedBox e => Serialise (SignedBox p e) instance ForSignedBox e => Serialise (SignedBox p e)
makeSignedBox :: forall e p . (Serialise p, ForSignedBox e, Signatures (Encryption e))
=> PubKey 'Sign (Encryption e)
-> PrivKey 'Sign (Encryption e)
-> p
-> SignedBox p e
makeSignedBox pk sk msg = SignedBox @p @e pk bs sign
where
bs = LBS.toStrict (serialise msg)
sign = makeSign @(Encryption e) sk bs
unboxSignedBox0 :: forall p e . (Serialise p, ForSignedBox e, Signatures (Encryption e))
=> SignedBox p e
-> Maybe (PubKey 'Sign (Encryption e), p)
unboxSignedBox0 (SignedBox pk bs sign) = runIdentity $ runMaybeT do
guard $ verifySign @(Encryption e) pk sign bs
p <- MaybeT $ pure $ deserialiseOrFail @p (LBS.fromStrict bs) & either (const Nothing) Just
pure (pk, p)
unboxSignedBox :: forall p e . (Serialise p, ForSignedBox e, Signatures (Encryption e))
=> LBS.ByteString
-> Maybe (PubKey 'Sign (Encryption e), p)
unboxSignedBox bs = runIdentity $ runMaybeT do
box <- MaybeT $ pure $ deserialiseOrFail @(SignedBox p e) bs
& either (pure Nothing) Just
MaybeT $ pure $ unboxSignedBox0 box

View File

@ -857,37 +857,6 @@ makeProposeTran creds chan box1 = do
let sk = view peerSignSk creds let sk = view peerSignSk creds
pure $ makeSignedBox @e pk sk tran pure $ makeSignedBox @e pk sk tran
makeSignedBox :: forall e p . (Serialise p, ForRefChans e, Signatures (Encryption e))
=> PubKey 'Sign (Encryption e)
-> PrivKey 'Sign (Encryption e)
-> p
-> SignedBox p e
makeSignedBox pk sk msg = SignedBox @p @e pk bs sign
where
bs = LBS.toStrict (serialise msg)
sign = makeSign @(Encryption e) sk bs
unboxSignedBox0 :: forall p e . (Serialise p, ForRefChans e, Signatures (Encryption e))
=> SignedBox p e
-> Maybe (PubKey 'Sign (Encryption e), p)
unboxSignedBox0 (SignedBox pk bs sign) = runIdentity $ runMaybeT do
guard $ verifySign @(Encryption e) pk sign bs
p <- MaybeT $ pure $ deserialiseOrFail @p (LBS.fromStrict bs) & either (const Nothing) Just
pure (pk, p)
unboxSignedBox :: forall p e . (Serialise p, ForRefChans e, Signatures (Encryption e))
=> LBS.ByteString
-> Maybe (PubKey 'Sign (Encryption e), p)
unboxSignedBox bs = runIdentity $ runMaybeT do
box <- MaybeT $ pure $ deserialiseOrFail @(SignedBox p e) bs
& either (pure Nothing) Just
MaybeT $ pure $ unboxSignedBox0 box
instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where
fromStringMay str = RefChanHeadBlockSmall <$> version fromStringMay str = RefChanHeadBlockSmall <$> version

View File

@ -6,6 +6,7 @@ import HBS2.Net.Auth.Credentials
import HBS2.Net.Proto.Definition() import HBS2.Net.Proto.Definition()
import HBS2.Net.Proto.RefChan import HBS2.Net.Proto.RefChan
import HBS2.Net.Proto.Types import HBS2.Net.Proto.Types
import HBS2.Data.Types.SignedBox
import HBS2.OrDie import HBS2.OrDie