mirror of https://github.com/voidlizard/hbs2
minor-fix: extracted SignedBox and code sweeped
This commit is contained in:
parent
93137d8f4c
commit
80278834b8
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue