fix hbs2-git cookie

This commit is contained in:
Dmitry Zuikov 2023-10-06 15:26:12 +03:00
parent af114056d3
commit 8ed863c552
2 changed files with 14 additions and 7 deletions

View File

@ -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)

View File

@ -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