From 1a10c09d6150dbc9e8a1718b710252cb7b38b776 Mon Sep 17 00:00:00 2001 From: Cypher Date: Tue, 3 May 2022 15:05:40 -0500 Subject: use stack lts-18.8 Update text handling to keep uptodate with changes with string conversion, using 'encodeUtf' and 'decodeUtf' where necessary. One update uses an odd encoding to and from JSON, which must be looked at later. --- src/Ssb/Aux.hs | 7 ++++--- src/Ssb/Feed.hs | 14 +++++++------- src/Ssb/Identity.hs | 9 +++++---- src/Ssb/Peer.hs | 2 +- src/Ssb/Peer/RPC.hs | 2 +- src/Ssb/Peer/RPC/Room.hs | 3 ++- src/Ssb/Peer/RPC/WhoAmI.hs | 2 +- src/Ssb/Pub.hs | 2 +- 8 files changed, 22 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/Ssb/Aux.hs b/src/Ssb/Aux.hs index 4be61b9..39a09b8 100644 --- a/src/Ssb/Aux.hs +++ b/src/Ssb/Aux.hs @@ -3,7 +3,8 @@ module Ssb.Aux where import Protolude import Data.Aeson as Aeson -import Data.ByteString.Lazy as BS (toStrict) +import Data.ByteString.Lazy as BS (toStrict) +import Data.ByteString.Char8 as BS (pack, unpack) import Data.Default import Data.Serialize as Serialize import Data.Either.Combinators ( mapLeft @@ -59,9 +60,9 @@ command cmd input output = do hSetBinaryMode hErr False let loop = do v <- atomically $ takeTMVar input - hPutStr hIn (toS v :: [Char]) + hPutStr hIn (BS.unpack v :: [Char]) hFlush hIn v' <- hGetLine hOut - atomically $ putTMVar output (toS v') + atomically $ putTMVar output (BS.pack v') loop loop diff --git a/src/Ssb/Feed.hs b/src/Ssb/Feed.hs index f4e96c2..ebdd2f4 100644 --- a/src/Ssb/Feed.hs +++ b/src/Ssb/Feed.hs @@ -72,7 +72,7 @@ extractMessageID (MessageID buf) = buf -- Format of '%[base64 messageId].sha256', the '.sha256' is appended for -- forward compatibility, and is currently assumed. formatMessageID :: MessageID -> Text -formatMessageID (MessageID buf) = "%" <> toS (Base64.encode buf) <> ".sha256" +formatMessageID (MessageID buf) = "%" <> decodeUtf8 (Base64.encode buf) <> ".sha256" -- | TODO: make safe parseMessageID :: Text -> Either Text MessageID @@ -80,7 +80,7 @@ parseMessageID arg = decode $ T.dropEnd constLen $ T.drop 1 arg where constLen = T.length ".sha256" decode :: Text -> Either Text MessageID - decode = mapRight MessageID . mapLeft toS . Base64.decode . toS + decode = mapRight MessageID . mapLeft toS . Base64.decode . encodeUtf8 instance FromJSON MessageID where parseJSON = Aeson.withText "MessageID" $ \v -> case parseMessageID v of @@ -115,14 +115,14 @@ extractSignature :: Signature -> ByteString extractSignature (Signature buf) = buf formatSignature :: Signature -> Text -formatSignature (Signature buf) = toS (Base64.encode buf) <> ".sig.ed25519" +formatSignature (Signature buf) = decodeUtf8 (Base64.encode buf) <> ".sig.ed25519" parseSignature :: Text -> Either Text Signature parseSignature txt = decode $ T.dropEnd constLen txt where constLen = T.length ".sig.ed25519" decode :: Text -> Either Text Signature - decode = mapRight Signature . mapLeft toS . Base64.decode . toS + decode = mapRight Signature . mapLeft toS . Base64.decode . encodeUtf8 instance FromJSON Signature where parseJSON = Aeson.withText "Signature" $ \v -> case parseSignature v of @@ -206,7 +206,7 @@ withSignature signature buf = (dropEnd (BS.length endTxt) buf) <> sigTxt sigTxt = ",\n \"signature\": " <> "\"" - <> toS (formatSignature signature) + <> encodeUtf8 (formatSignature signature) <> "\"" <> endTxt endTxt = "\n}" @@ -332,9 +332,9 @@ encodeForSigning contentOrder arg = do then return (error "external V8 byte string encoder not initialized") else do - atomically $ putTMVar v8Input (cmd <> toS arg) + atomically $ putTMVar v8Input (cmd <> arg) ret <- atomically $ takeTMVar v8Output - let ret' = Base64.decode (toS ret) + let ret' = Base64.decode ret return $ mapLeft toS ret' where cmd = if contentOrder diff --git a/src/Ssb/Identity.hs b/src/Ssb/Identity.hs index e3fa4dc..f599669 100644 --- a/src/Ssb/Identity.hs +++ b/src/Ssb/Identity.hs @@ -9,6 +9,7 @@ import qualified Crypto.Saltine.Class as Nacl import Data.Serialize ( Serialize ) import Data.Either.Combinators ( mapLeft ) +import qualified Data.ByteString as S import qualified Data.Text as T newtype PrivateKey = PrivateKey ByteString @@ -21,13 +22,13 @@ instance Serialize PrivateKey formatPrivateKey :: PrivateKey -> Text formatPrivateKey (PrivateKey buf) = "@" <> pubKey <> ".ed25519" - where pubKey = toS $ Base64.encode buf + where pubKey = decodeUtf8 $ Base64.encode buf parsePrivateKey :: Text -> Either Text PrivateKey parsePrivateKey arg = decode $ T.dropEnd constLen $ T.drop 1 arg where constLen = T.length ".ed25519" - decode = fmap PrivateKey . mapLeft toS . Base64.decode . toS + decode = fmap PrivateKey . mapLeft toS . Base64.decode . encodeUtf8 instance FromJSON PrivateKey where parseJSON = withText "PrivateKey" $ \v -> case parsePrivateKey v of @@ -47,13 +48,13 @@ instance Serialize PublicKey formatPublicKey :: PublicKey -> Text formatPublicKey (PublicKey buf) = "@" <> pubKey <> ".ed25519" - where pubKey = toS $ Base64.encode buf + where pubKey = decodeUtf8 $ Base64.encode buf parsePublicKey :: Text -> Either Text PublicKey parsePublicKey arg = decode $ T.dropEnd constLen $ T.drop 1 arg where constLen = T.length ".ed25519" - decode = fmap PublicKey . mapLeft toS . Base64.decode . toS + decode = fmap PublicKey . mapLeft toS . Base64.decode . encodeUtf8 instance FromJSON PublicKey where parseJSON = withText "PublicKey" $ \v -> case parsePublicKey v of diff --git a/src/Ssb/Peer.hs b/src/Ssb/Peer.hs index 75078ff..41a49cb 100644 --- a/src/Ssb/Peer.hs +++ b/src/Ssb/Peer.hs @@ -45,7 +45,7 @@ parseMultiAddress txt = do { protocol = protocol , host = address , port = port - , key = PublicKey $ Base64.decodeLenient $ toS key + , key = PublicKey $ Base64.decodeLenient $ encodeUtf8 key } where split c arg = (identity *** Text.drop 1) $ Text.breakOn c arg diff --git a/src/Ssb/Peer/RPC.hs b/src/Ssb/Peer/RPC.hs index 3286a33..1336b5e 100644 --- a/src/Ssb/Peer/RPC.hs +++ b/src/Ssb/Peer/RPC.hs @@ -3,7 +3,7 @@ module Ssb.Peer.RPC where -import Protolude +import Protolude hiding (Handler) import Control.Concurrent.STM import Control.Monad.Fail diff --git a/src/Ssb/Peer/RPC/Room.hs b/src/Ssb/Peer/RPC/Room.hs index 1f53cf0..7be7d2c 100644 --- a/src/Ssb/Peer/RPC/Room.hs +++ b/src/Ssb/Peer/RPC/Room.hs @@ -280,7 +280,8 @@ instance RPC.Handler Room where -- should decode request serve h (RPC.Endpoint ["tunnel", "connect"] RPC.Duplex) args stream = do let args' = - decodeJSON (toS $ Aeson.encode args) :: Either + -- TODO: why encode to JSON then decode from JSON redundantly? + decodeJSON (encodeJSON args) :: Either Text [ConnectRequest] case args' of diff --git a/src/Ssb/Peer/RPC/WhoAmI.hs b/src/Ssb/Peer/RPC/WhoAmI.hs index be979fc..c92c56c 100644 --- a/src/Ssb/Peer/RPC/WhoAmI.hs +++ b/src/Ssb/Peer/RPC/WhoAmI.hs @@ -7,7 +7,7 @@ module Ssb.Peer.RPC.WhoAmI where -import Protolude hiding ( Identity ) +import Protolude hiding ( Handler, Identity ) import Data.Aeson as Aeson (FromJSON,ToJSON) import qualified Ssb.Identity as Ssb diff --git a/src/Ssb/Pub.hs b/src/Ssb/Pub.hs index 9ed5410..16e9e2e 100644 --- a/src/Ssb/Pub.hs +++ b/src/Ssb/Pub.hs @@ -33,7 +33,7 @@ parsePub txt = do return PubAddress { host = address , port = port - , key = PublicKey $ Base64.decodeLenient $ toS key + , key = PublicKey $ Base64.decodeLenient $ encodeUtf8 key } where split c arg = (identity *** Text.drop 1) $ Text.breakOn c arg -- cgit v1.2.3