voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
hbs2-git/lib/HBS2Git/State.hs
View File

@ -20,6 +20,8 @@ import Database.SQLite.Simple.ToField
import Control.Monad.Reader import Control.Monad.Reader
import Text.InterpolatedString.Perl6 (qc) import Text.InterpolatedString.Perl6 (qc)
import Data.ByteString.Lazy.Char8 qualified as LBS 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.Directory
import System.FilePath import System.FilePath
import Data.Maybe import Data.Maybe
@ -32,7 +34,10 @@ import Lens.Micro.Platform
-- FIXME: move-orphans-to-separate-module -- FIXME: move-orphans-to-separate-module
instance ToField Cookie where 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 instance ToField GitHash where
toField h = toField (show $ pretty h) toField h = toField (show $ pretty h)
@ -259,7 +264,7 @@ readOrCreateCookie = do
if null cf then do if null cf then do
cookie <- stateGenCookie cookie <- stateGenCookie
liftIO $ LBS.writeFile cfn (fromCookie cookie) liftIO $ Text.writeFile cfn (fromCookie cookie)
pure cookie pure cookie
else do else do
let cookie = Cookie (fromString cf) let cookie = Cookie (fromString cf)

12
hbs2-git/lib/HBS2Git/Types.hs
View File

@ -26,6 +26,8 @@ import Control.Monad.Trans.Maybe
import Control.Applicative import Control.Applicative
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Data.Text qualified as Text
import Data.Text (Text)
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy.Char8 qualified as LBS import Data.ByteString.Lazy.Char8 qualified as LBS
import Database.SQLite.Simple (Connection) import Database.SQLite.Simple (Connection)
@ -53,15 +55,15 @@ type HBS2L4Proto = L4Proto
type API = String type API = String
newtype Cookie = newtype Cookie =
Cookie { fromCookie :: ByteString } Cookie { fromCookie :: Text }
deriving newtype (Eq,Ord,Show) deriving newtype (Eq,Ord,Show)
instance IsString Cookie where instance IsString Cookie where
fromString s = Cookie cookie fromString s = Cookie cookie
where cookie = LBS.pack $ take 8 where cookie = fromString $ take 8
$ show $ show
$ pretty $ pretty
$ hashObject @HbSync (LBS.pack s) $ hashObject @HbSync (LBS.pack s)
data DBEnv = data DBEnv =
DBEnv { _dbFilePath :: FilePath DBEnv { _dbFilePath :: FilePath
, _dbCookie :: Cookie , _dbCookie :: Cookie