1-- -fno-cse is here because of anonymousNamedPrim - see the comments on that 2{-# OPTIONS_GHC -fno-cse #-} 3-- | Wrapper for prim patches to give them an identity derived from the identity 4-- of the containined Named patch. 5module Darcs.Patch.Prim.Named 6 ( NamedPrim 7 -- accessors 8 , PrimPatchId 9 , namedPrim 10 , positivePrimPatchIds 11 , anonymousNamedPrim 12 -- for testing 13 , unsafePrimPatchId 14 , prop_primPatchIdNonZero 15 ) where 16 17import Control.Monad ( mzero ) 18 19import qualified Data.ByteString.Char8 as BC 20import qualified Data.ByteString.Lazy as BL 21 22import qualified Data.Binary as Binary 23import Crypto.Random ( getRandomBytes ) 24import System.IO.Unsafe ( unsafePerformIO ) 25 26import Darcs.Prelude hiding ( take ) 27 28import Darcs.Patch.Ident ( PatchId, SignedId(..), StorableId(..) ) 29import Darcs.Patch.Info ( PatchInfo, makePatchname ) 30import Darcs.Patch.Prim.WithName ( PrimWithName(..) ) 31import Darcs.Patch.Show ( ShowPatchFor(..) ) 32 33import Darcs.Test.TestOnly 34import Darcs.Util.Hash ( SHA1, sha1Show, sha1Read ) 35import Darcs.Util.Parser 36import Darcs.Util.Printer 37 38-- TODO [V3INTEGRATION]: 39-- Review whether we can use a PatchInfo directly here instead of a SHA1 40-- Unless we can use observable sharing, this might be significantly 41-- slower/less space efficient. 42-- | Signed patch identity. 43-- The 'SHA1' hash of the non-inverted meta data ('PatchInfo') plus an 'Int' 44-- for the sequence number within the named patch, starting with 1. The 'Int' 45-- gets inverted together with the patch and must never be 0 else we could not 46-- distinguish between the patch and its inverse. 47data PrimPatchId = PrimPatchId !Int !SHA1 48 deriving (Eq, Ord, Show) 49 50-- | This should only be used for testing, as it exposes the internal structure 51-- of a 'PrimPatchId'. 52unsafePrimPatchId :: TestOnly => Int -> SHA1 -> PrimPatchId 53unsafePrimPatchId = PrimPatchId 54 55prop_primPatchIdNonZero :: PrimPatchId -> Bool 56prop_primPatchIdNonZero (PrimPatchId i _) = i /= 0 57 58instance SignedId PrimPatchId where 59 positiveId (PrimPatchId i _) = i > 0 60 invertId (PrimPatchId i h) = PrimPatchId (- i) h 61 62-- | Create an infinite list of positive 'PrimPatchId's. 63positivePrimPatchIds :: PatchInfo -> [PrimPatchId] 64positivePrimPatchIds info = map (flip PrimPatchId (makePatchname info)) [1..] 65 66type NamedPrim = PrimWithName PrimPatchId 67 68namedPrim :: PrimPatchId -> p wX wY -> NamedPrim p wX wY 69namedPrim = PrimWithName 70 71type instance PatchId (NamedPrim p) = PrimPatchId 72 73-- TODO [V3INTEGRATION]: 74-- It might be nice to elide the patch identifiers from the 75-- on-disk format when they are the same as that of the containing patch 76-- (which is the common case when there are no conflicts). 77-- It's not that easy to implement as it requires refactoring to pass 78-- the patch identifier downwards. 79-- The sequence numbers could also be inferred from position. 80instance StorableId PrimPatchId where 81 readId = do 82 lexString (BC.pack "hash") 83 i <- int 84 skipSpace 85 x <- take 40 86 liftMaybe $ PrimPatchId i <$> sha1Read x 87 where 88 liftMaybe = maybe mzero return 89 90 showId ForStorage (PrimPatchId i h) = 91 text "hash" <+> text (show i) <+> packedString (sha1Show h) 92 showId ForDisplay _ = mempty 93 94-- Because we are using unsafePerformIO, we need -fno-cse for 95-- this module. We don't need -fno-full-laziness because the 96-- body of the unsafePerformIO mentions 'p' so can't float outside 97-- the scope of 'p'. 98-- http://hackage.haskell.org/package/base-4.12.0.0/docs/System-IO-Unsafe.html 99{-# NOINLINE anonymousNamedPrim #-} 100anonymousNamedPrim :: p wX wY -> NamedPrim p wX wY 101anonymousNamedPrim p = 102 unsafePerformIO $ do 103 b20 <- getRandomBytes 20 104 b8 <- getRandomBytes 8 105 return $ 106 PrimWithName 107 (PrimPatchId 108 (abs (Binary.decode $ BL.fromStrict b8)) 109 (Binary.decode $ BL.fromStrict b20)) 110 p 111