From 8ed863c552fc6c1e244e1e728db82267a8fea85d Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Fri, 6 Oct 2023 15:26:12 +0300
Subject: [PATCH] fix hbs2-git cookie

---
 hbs2-git/lib/HBS2Git/State.hs |  9 +++++++--
 hbs2-git/lib/HBS2Git/Types.hs | 12 +++++++-----
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/hbs2-git/lib/HBS2Git/State.hs b/hbs2-git/lib/HBS2Git/State.hs
index fb02bb08..c3cf75ea 100644
--- a/hbs2-git/lib/HBS2Git/State.hs
+++ b/hbs2-git/lib/HBS2Git/State.hs
@@ -20,6 +20,8 @@ import Database.SQLite.Simple.ToField
 import Control.Monad.Reader
 import Text.InterpolatedString.Perl6 (qc)
 import Data.ByteString.Lazy.Char8 qualified as LBS
+import Data.Text.IO qualified as Text
+import Data.Text qualified as Text
 import System.Directory
 import System.FilePath
 import Data.Maybe
@@ -32,7 +34,10 @@ import Lens.Micro.Platform
 -- FIXME: move-orphans-to-separate-module
 
 instance ToField Cookie where
-  toField (Cookie lbs) = toField lbs
+  toField (Cookie x) = toField x
+
+instance FromField Cookie where
+  fromField = fmap Cookie . fromField @Text.Text
 
 instance ToField GitHash where
   toField h = toField (show $ pretty h)
@@ -259,7 +264,7 @@ readOrCreateCookie = do
 
   if null cf then do
     cookie <- stateGenCookie
-    liftIO $ LBS.writeFile cfn (fromCookie cookie)
+    liftIO $ Text.writeFile cfn (fromCookie cookie)
     pure cookie
   else do
     let cookie = Cookie (fromString cf)
diff --git a/hbs2-git/lib/HBS2Git/Types.hs b/hbs2-git/lib/HBS2Git/Types.hs
index 8f36e338..1b7f6d10 100644
--- a/hbs2-git/lib/HBS2Git/Types.hs
+++ b/hbs2-git/lib/HBS2Git/Types.hs
@@ -26,6 +26,8 @@ import Control.Monad.Trans.Maybe
 import Control.Applicative
 import Control.Monad.IO.Class
 import Control.Monad.Reader
+import Data.Text qualified as Text
+import Data.Text (Text)
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy.Char8 qualified as LBS
 import Database.SQLite.Simple (Connection)
@@ -53,15 +55,15 @@ type HBS2L4Proto = L4Proto
 type API = String
 
 newtype Cookie =
-  Cookie { fromCookie :: ByteString }
+  Cookie { fromCookie :: Text }
   deriving newtype (Eq,Ord,Show)
 
 instance IsString Cookie where
   fromString s = Cookie cookie
-    where cookie = LBS.pack $ take 8
-                            $ show
-                            $ pretty
-                            $ hashObject @HbSync (LBS.pack s)
+    where cookie = fromString $ take 8
+                              $ show
+                              $ pretty
+                              $ hashObject @HbSync (LBS.pack s)
 data DBEnv =
   DBEnv { _dbFilePath :: FilePath
         , _dbCookie   :: Cookie