diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index ae9473e7d..39e21a777 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -40,7 +40,7 @@ import Network.Socket (ServiceName) import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite.Schema (createSchema) import Simplex.Messaging.Agent.Transmission -import Simplex.Messaging.Parsers (parseAll) +import Simplex.Messaging.Parsers (blobFieldParser) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Util (bshow, liftIOEither) import System.Exit (ExitCode (ExitFailure), exitWith) @@ -279,13 +279,7 @@ instance ToField SndMsgStatus where toField = toField . show instance ToField MsgIntegrity where toField = toField . serializeMsgIntegrity -instance FromField MsgIntegrity where - fromField = \case - f@(Field (SQLBlob b) _) -> - case parseAll msgIntegrityP b of - Right k -> Ok k - Left e -> returnError ConversionFailed f ("can't parse msg integrity field: " ++ e) - f -> returnError ConversionFailed f "expecting SQLBlob column type" +instance FromField MsgIntegrity where fromField = blobFieldParser msgIntegrityP fromFieldToReadable_ :: forall a. (Read a, E.Typeable a) => Field -> Ok a fromFieldToReadable_ = \case diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index efab6ce67..05bd4fbc8 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -76,15 +76,11 @@ import qualified Data.ByteString.Char8 as B import Data.ByteString.Internal (c2w, w2c) import Data.ByteString.Lazy (fromStrict, toStrict) import Data.String -import Data.Typeable (Typeable) import Data.X509 -import Database.SQLite.Simple (ResultError (..), SQLData (..)) -import Database.SQLite.Simple.FromField (FieldParser, FromField (..), returnError) -import Database.SQLite.Simple.Internal (Field (..)) -import Database.SQLite.Simple.Ok (Ok (Ok)) +import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) import Network.Transport.Internal (decodeWord32, encodeWord32) -import Simplex.Messaging.Parsers (base64P, parseAll) +import Simplex.Messaging.Parsers (base64P, blobFieldParser, parseAll) import Simplex.Messaging.Util (liftEitherError, (<$?>)) newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show) @@ -122,17 +118,9 @@ instance ToField SafePrivateKey where toField = toField . encodePrivKey instance ToField PublicKey where toField = toField . encodePubKey -instance FromField SafePrivateKey where fromField = keyFromField binaryPrivKeyP +instance FromField SafePrivateKey where fromField = blobFieldParser binaryPrivKeyP -instance FromField PublicKey where fromField = keyFromField binaryPubKeyP - -keyFromField :: Typeable k => Parser k -> FieldParser k -keyFromField p = \case - f@(Field (SQLBlob b) _) -> - case parseAll p b of - Right k -> Ok k - Left e -> returnError ConversionFailed f ("couldn't parse key field: " ++ e) - f -> returnError ConversionFailed f "expecting SQLBlob column type" +instance FromField PublicKey where fromField = blobFieldParser binaryPubKeyP type KeyPair k = (PublicKey, k) @@ -211,9 +199,9 @@ newtype KeyHash = KeyHash {unKeyHash :: ByteString} deriving (Eq, Ord, Show) instance IsString KeyHash where fromString = parseString . parseAll $ KeyHash <$> base64P -instance ToField KeyHash where toField = toField . unKeyHash +instance ToField KeyHash where toField = toField . encode . unKeyHash -instance FromField KeyHash where fromField f = KeyHash <$> fromField f +instance FromField KeyHash where fromField = blobFieldParser $ KeyHash <$> base64P publicKeyHash :: PublicKey -> KeyHash publicKeyHash = KeyHash . sha256Hash . encodePubKey diff --git a/src/Simplex/Messaging/Parsers.hs b/src/Simplex/Messaging/Parsers.hs index 25e2f32bb..10ef29257 100644 --- a/src/Simplex/Messaging/Parsers.hs +++ b/src/Simplex/Messaging/Parsers.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Simplex.Messaging.Parsers where @@ -11,6 +12,11 @@ import qualified Data.ByteString.Char8 as B import Data.Char (isAlphaNum) import Data.Time.Clock (UTCTime) import Data.Time.ISO8601 (parseISO8601) +import Data.Typeable (Typeable) +import Database.SQLite.Simple (ResultError (..), SQLData (..)) +import Database.SQLite.Simple.FromField (FieldParser, returnError) +import Database.SQLite.Simple.Internal (Field (..)) +import Database.SQLite.Simple.Ok (Ok (Ok)) import Simplex.Messaging.Util ((<$?>)) import Text.Read (readMaybe) @@ -43,3 +49,11 @@ parseRead2 = parseRead $ do w1 <- A.takeTill (== ' ') <* A.char ' ' w2 <- A.takeTill (== ' ') pure $ w1 <> " " <> w2 + +blobFieldParser :: Typeable k => Parser k -> FieldParser k +blobFieldParser p = \case + f@(Field (SQLBlob b) _) -> + case parseAll p b of + Right k -> Ok k + Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e) + f -> returnError ConversionFailed f "expecting SQLBlob column type"