Script.hs (11107B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE BinaryLiterals #-} 4 {-# LANGUAGE LambdaCase #-} 5 {-# LANGUAGE NumericUnderscores #-} 6 {-# LANGUAGE OverloadedStrings #-} 7 {-# LANGUAGE ViewPatterns #-} 8 9 -- | 10 -- Module: Bitcoin.Prim.Script 11 -- Copyright: (c) 2025 Jared Tobin 12 -- License: MIT 13 -- Maintainer: Jared Tobin <jared@ppad.tech> 14 -- 15 -- Representations for [Script](https://en.bitcoin.it/wiki/Script), 16 -- including abstract syntax, 'BA.ByteArray', and base16-encoded 17 -- 'BS.ByteString' versions, as well as fast conversion utilities for 18 -- working with them. 19 20 module Bitcoin.Prim.Script ( 21 -- * Script and Script Terms 22 Script(..) 23 , Term(..) 24 , Opcode(..) 25 26 -- * Conversion Utilities 27 , to_base16 28 , from_base16 29 , to_script 30 , from_script 31 32 -- for testing etc. 33 , ba_to_bs 34 , bs_to_ba 35 ) where 36 37 import Control.Monad (guard) 38 import qualified Data.Bits as B 39 import Data.Bits ((.&.), (.|.)) 40 import qualified Data.ByteString as BS 41 import qualified Data.ByteString.Base16 as B16 42 import qualified Data.ByteString.Internal as BI 43 import qualified Data.ByteString.Unsafe as BU 44 import qualified Data.Char as C 45 import qualified Data.Primitive.ByteArray as BA 46 import Data.Word (Word8, Word16, Word32) 47 import GHC.ForeignPtr 48 import System.IO.Unsafe 49 50 -- utilities ------------------------------------------------------------------ 51 52 fi :: (Num a, Integral b) => b -> a 53 fi = fromIntegral 54 {-# INLINE fi #-} 55 56 -- convert a pinned ByteArray to a ByteString 57 ba_to_bs :: BA.ByteArray -> BS.ByteString 58 ba_to_bs ba = unsafeDupablePerformIO $ do 59 guard (BA.isByteArrayPinned ba) 60 let l = BA.sizeofByteArray ba 61 buf <- mallocPlainForeignPtrBytes l 62 withForeignPtr buf $ \p -> 63 BA.copyByteArrayToAddr p ba 0 l 64 pure (BI.BS buf l) 65 {-# NOINLINE ba_to_bs #-} 66 67 -- convert a ByteString to a pinned ByteArray 68 bs_to_ba :: BS.ByteString -> BA.ByteArray 69 bs_to_ba (BI.PS bp _ l) = unsafeDupablePerformIO $ do 70 buf <- BA.newPinnedByteArray l 71 withForeignPtr bp $ \p -> 72 BA.copyPtrToMutableByteArray buf 0 p l 73 BA.unsafeFreezeByteArray buf 74 {-# NOINLINE bs_to_ba #-} 75 76 -- split a word8 into a pair of its high and low bits 77 -- only used for show instances 78 hilo :: Word8 -> (Word8, Word8) 79 hilo b = 80 let hex_charset = "0123456789abcdef" 81 hi = BU.unsafeIndex hex_charset (fi b `B.shiftR` 4) 82 lo = BU.unsafeIndex hex_charset (fi b .&. 0b0000_1111) 83 in (hi, lo) 84 85 -- script and term representation --------------------------------------------- 86 87 -- | A Script program, represented as a 'BA.ByteArray'. 88 -- 89 -- >>> from_base16 "0014b472a266d0bd89c13706a4132ccfb16f7c3b9fcb" 90 -- Just (Script 91 -- [ 0x00, 0x14, 0xb4, 0x72, 0xa2, 0x66, 0xd0, 0xbd, 0x89, 0xc1, 0x37 92 -- , 0x06, 0xa4, 0x13, 0x2c, 0xcf, 0xb1, 0x6f, 0x7c, 0x3b, 0x9f, 0xcb]) 93 newtype Script = Script BA.ByteArray 94 deriving (Eq, Show) 95 96 -- | Terms of the Script language, each being an 'Opcode' or 'Word8' 97 -- byte. 98 -- 99 -- >>> OPCODE OP_RETURN 100 -- OP_RETURN 101 -- >>> BYTE 0x00 102 -- 0x00 103 data Term = 104 OPCODE {-# UNPACK #-} !Opcode 105 | BYTE {-# UNPACK #-} !Word8 106 deriving Eq 107 108 instance Show Term where 109 show (OPCODE o) = show o 110 show (BYTE w) = 111 let (hi, lo) = hilo w 112 in "0x" <> (C.chr (fi hi) : C.chr (fi lo) : []) 113 114 -- script conversions --------------------------------------------------------- 115 116 -- | Convert a 'Script' to a base16-encoded 'BS.ByteString'. 117 -- 118 -- >>> let script = to_script [OPCODE OP_1, OPCODE OP_2, OPCODE OP_ADD] 119 -- >>> to_base16 script 120 -- "515293" 121 to_base16 :: Script -> BS.ByteString 122 to_base16 (Script ba) = B16.encode (ba_to_bs ba) 123 {-# INLINE to_base16 #-} 124 125 -- | Convert a base16-encoded 'BS.ByteString' to a 'Script'. 126 -- 127 -- >>> from_base16 "515293" 128 -- Just (Script [0x51, 0x52, 0x93]) 129 from_base16 :: BS.ByteString -> Maybe Script 130 from_base16 b16 = do 131 bs <- B16.decode b16 132 pure (Script (bs_to_ba bs)) 133 {-# INLINE from_base16 #-} 134 135 -- | Pack a list of Script terms into a 'Script'. 136 -- 137 -- >>> to_script [OPCODE OP_1, OPCODE OP_2, OPCODE OP_ADD] 138 -- Script [0x51, 0x52, 0x93] 139 to_script :: [Term] -> Script 140 to_script terms = 141 let !bs = BS.pack (fmap term_to_byte terms) 142 in Script (bs_to_ba bs) 143 where 144 term_to_byte :: Term -> Word8 145 term_to_byte = \case 146 OPCODE !op -> fi (fromEnum op) 147 BYTE !w8 -> w8 148 {-# INLINE term_to_byte #-} 149 {-# NOINLINE to_script #-} -- inlining causes GHC to panic during compilation 150 151 -- | Unpack a 'Script' into a list of Script terms. 152 -- 153 -- >>> let Just script = from_base16 "515293" 154 -- >>> from_script script 155 -- [OP_1, OP_2, OP_ADD] 156 from_script :: Script -> [Term] 157 from_script (Script bs) = go 0 where 158 !l = BA.sizeofByteArray bs 159 160 read_pay !cur !end 161 | cur == end = go cur 162 | otherwise = BYTE (BA.indexByteArray bs cur) : read_pay (cur + 1) end 163 164 go j 165 | j == l = mempty 166 | otherwise = 167 let !op = toEnum (fi (BA.indexByteArray bs j :: Word8)) :: Opcode 168 in case pushbytes op of 169 Just !i -> OPCODE op : read_pay (j + 1) (j + 1 + i) 170 Nothing -> OPCODE op : case op of 171 OP_PUSHDATA1 -> 172 let !len_idx = j + 1 173 !pay_len = BA.indexByteArray bs len_idx :: Word8 174 in BYTE pay_len 175 : read_pay (len_idx + 1) (len_idx + 1 + fi pay_len) 176 177 OP_PUSHDATA2 -> 178 let !len_idx = j + 1 179 !w8_0 = BA.indexByteArray bs len_idx :: Word8 180 !w8_1 = BA.indexByteArray bs (len_idx + 1) :: Word8 181 !pay_len = fi w8_0 .|. fi w8_1 `B.shiftL` 8 :: Word16 182 in BYTE w8_0 : BYTE w8_1 183 : read_pay (len_idx + 2) (len_idx + 2 + fi pay_len) 184 185 OP_PUSHDATA4 -> 186 let !len_idx = j + 1 187 !w8_0 = BA.indexByteArray bs len_idx :: Word8 188 !w8_1 = BA.indexByteArray bs (len_idx + 1) :: Word8 189 !w8_2 = BA.indexByteArray bs (len_idx + 2) :: Word8 190 !w8_3 = BA.indexByteArray bs (len_idx + 3) :: Word8 191 !pay_len = fi w8_0 192 .|. fi w8_1 `B.shiftL` 8 193 .|. fi w8_2 `B.shiftL` 16 194 .|. fi w8_3 `B.shiftL` 24 :: Word32 195 in BYTE w8_0 : BYTE w8_1 : BYTE w8_2 : BYTE w8_3 196 : read_pay (len_idx + 4) (len_idx + 4 + fi pay_len) 197 198 _ -> go (succ j) 199 200 -- opcodes and utilities ------------------------------------------------------ 201 202 -- | Primitive opcodes. 203 -- 204 -- See, for example [opcodeexplained](https://opcodeexplained.com/opcodes/) 205 -- for detail on each. 206 data Opcode = 207 OP_PUSHBYTES_0 208 | OP_PUSHBYTES_1 209 | OP_PUSHBYTES_2 210 | OP_PUSHBYTES_3 211 | OP_PUSHBYTES_4 212 | OP_PUSHBYTES_5 213 | OP_PUSHBYTES_6 214 | OP_PUSHBYTES_7 215 | OP_PUSHBYTES_8 216 | OP_PUSHBYTES_9 217 | OP_PUSHBYTES_10 218 | OP_PUSHBYTES_11 219 | OP_PUSHBYTES_12 220 | OP_PUSHBYTES_13 221 | OP_PUSHBYTES_14 222 | OP_PUSHBYTES_15 223 | OP_PUSHBYTES_16 224 | OP_PUSHBYTES_17 225 | OP_PUSHBYTES_18 226 | OP_PUSHBYTES_19 227 | OP_PUSHBYTES_20 228 | OP_PUSHBYTES_21 229 | OP_PUSHBYTES_22 230 | OP_PUSHBYTES_23 231 | OP_PUSHBYTES_24 232 | OP_PUSHBYTES_25 233 | OP_PUSHBYTES_26 234 | OP_PUSHBYTES_27 235 | OP_PUSHBYTES_28 236 | OP_PUSHBYTES_29 237 | OP_PUSHBYTES_30 238 | OP_PUSHBYTES_31 239 | OP_PUSHBYTES_32 240 | OP_PUSHBYTES_33 241 | OP_PUSHBYTES_34 242 | OP_PUSHBYTES_35 243 | OP_PUSHBYTES_36 244 | OP_PUSHBYTES_37 245 | OP_PUSHBYTES_38 246 | OP_PUSHBYTES_39 247 | OP_PUSHBYTES_40 248 | OP_PUSHBYTES_41 249 | OP_PUSHBYTES_42 250 | OP_PUSHBYTES_43 251 | OP_PUSHBYTES_44 252 | OP_PUSHBYTES_45 253 | OP_PUSHBYTES_46 254 | OP_PUSHBYTES_47 255 | OP_PUSHBYTES_48 256 | OP_PUSHBYTES_49 257 | OP_PUSHBYTES_50 258 | OP_PUSHBYTES_51 259 | OP_PUSHBYTES_52 260 | OP_PUSHBYTES_53 261 | OP_PUSHBYTES_54 262 | OP_PUSHBYTES_55 263 | OP_PUSHBYTES_56 264 | OP_PUSHBYTES_57 265 | OP_PUSHBYTES_58 266 | OP_PUSHBYTES_59 267 | OP_PUSHBYTES_60 268 | OP_PUSHBYTES_61 269 | OP_PUSHBYTES_62 270 | OP_PUSHBYTES_63 271 | OP_PUSHBYTES_64 272 | OP_PUSHBYTES_65 273 | OP_PUSHBYTES_66 274 | OP_PUSHBYTES_67 275 | OP_PUSHBYTES_68 276 | OP_PUSHBYTES_69 277 | OP_PUSHBYTES_70 278 | OP_PUSHBYTES_71 279 | OP_PUSHBYTES_72 280 | OP_PUSHBYTES_73 281 | OP_PUSHBYTES_74 282 | OP_PUSHBYTES_75 283 | OP_PUSHDATA1 284 | OP_PUSHDATA2 285 | OP_PUSHDATA4 286 | OP_1NEGATE 287 | OP_RESERVED 288 | OP_1 289 | OP_2 290 | OP_3 291 | OP_4 292 | OP_5 293 | OP_6 294 | OP_7 295 | OP_8 296 | OP_9 297 | OP_10 298 | OP_11 299 | OP_12 300 | OP_13 301 | OP_14 302 | OP_15 303 | OP_16 304 | OP_NOP 305 | OP_VER 306 | OP_IF 307 | OP_NOTIF 308 | OP_VERIF 309 | OP_VERNOTIF 310 | OP_ELSE 311 | OP_ENDIF 312 | OP_VERIFY 313 | OP_RETURN 314 | OP_TOALTSTACK 315 | OP_FROMALTSTACK 316 | OP_2DROP 317 | OP_2DUP 318 | OP_3DUP 319 | OP_2OVER 320 | OP_2ROT 321 | OP_2SWAP 322 | OP_IFDUP 323 | OP_DEPTH 324 | OP_DROP 325 | OP_DUP 326 | OP_NIP 327 | OP_OVER 328 | OP_PICK 329 | OP_ROLL 330 | OP_ROT 331 | OP_SWAP 332 | OP_TUCK 333 | OP_CAT 334 | OP_SUBSTR 335 | OP_LEFT 336 | OP_RIGHT 337 | OP_SIZE 338 | OP_INVERT 339 | OP_AND 340 | OP_OR 341 | OP_XOR 342 | OP_EQUAL 343 | OP_EQUALVERIFY 344 | OP_RESERVED1 345 | OP_RESERVED2 346 | OP_1ADD 347 | OP_1SUB 348 | OP_2MUL 349 | OP_2DIV 350 | OP_NEGATE 351 | OP_ABS 352 | OP_NOT 353 | OP_0NOTEQUAL 354 | OP_ADD 355 | OP_SUB 356 | OP_MUL 357 | OP_DIV 358 | OP_MOD 359 | OP_LSHIFT 360 | OP_RSHIFT 361 | OP_BOOLAND 362 | OP_BOOLOR 363 | OP_NUMEQUAL 364 | OP_NUMEQUALVERIFY 365 | OP_NUMNOTEQUAL 366 | OP_LESSTHAN 367 | OP_GREATERTHAN 368 | OP_LESSTHANOREQUAL 369 | OP_GREATERTHANOREQUAL 370 | OP_MIN 371 | OP_MAX 372 | OP_WITHIN 373 | OP_RIPEMD160 374 | OP_SHA1 375 | OP_SHA256 376 | OP_HASH160 377 | OP_HASH256 378 | OP_CODESEPARATOR 379 | OP_CHECKSIG 380 | OP_CHECKSIGVERIFY 381 | OP_CHECKMULTISIG 382 | OP_CHECKMULTISIGVERIFY 383 | OP_NOP1 384 | OP_CLTV 385 | OP_CSV 386 | OP_NOP4 387 | OP_NOP5 388 | OP_NOP6 389 | OP_NOP7 390 | OP_NOP8 391 | OP_NOP9 392 | OP_NOP10 393 | OP_CHECKSIGADD 394 | OP_RETURN_187 395 | OP_RETURN_188 396 | OP_RETURN_189 397 | OP_RETURN_190 398 | OP_RETURN_191 399 | OP_RETURN_192 400 | OP_RETURN_193 401 | OP_RETURN_194 402 | OP_RETURN_195 403 | OP_RETURN_196 404 | OP_RETURN_197 405 | OP_RETURN_198 406 | OP_RETURN_199 407 | OP_RETURN_200 408 | OP_RETURN_201 409 | OP_RETURN_202 410 | OP_RETURN_203 411 | OP_RETURN_204 412 | OP_RETURN_205 413 | OP_RETURN_206 414 | OP_RETURN_207 415 | OP_RETURN_208 416 | OP_RETURN_209 417 | OP_RETURN_210 418 | OP_RETURN_211 419 | OP_RETURN_212 420 | OP_RETURN_213 421 | OP_RETURN_214 422 | OP_RETURN_215 423 | OP_RETURN_216 424 | OP_RETURN_217 425 | OP_RETURN_218 426 | OP_RETURN_219 427 | OP_RETURN_220 428 | OP_RETURN_221 429 | OP_RETURN_222 430 | OP_RETURN_223 431 | OP_RETURN_224 432 | OP_RETURN_225 433 | OP_RETURN_226 434 | OP_RETURN_227 435 | OP_RETURN_228 436 | OP_RETURN_229 437 | OP_RETURN_230 438 | OP_RETURN_231 439 | OP_RETURN_232 440 | OP_RETURN_233 441 | OP_RETURN_234 442 | OP_RETURN_235 443 | OP_RETURN_236 444 | OP_RETURN_237 445 | OP_RETURN_238 446 | OP_RETURN_239 447 | OP_RETURN_240 448 | OP_RETURN_241 449 | OP_RETURN_242 450 | OP_RETURN_243 451 | OP_RETURN_244 452 | OP_RETURN_245 453 | OP_RETURN_246 454 | OP_RETURN_247 455 | OP_RETURN_248 456 | OP_RETURN_249 457 | OP_RETURN_250 458 | OP_RETURN_251 459 | OP_RETURN_252 460 | OP_RETURN_253 461 | OP_RETURN_254 462 | OP_INVALIDOPCODE 463 deriving (Eq, Show, Enum) 464 465 -- convert a pushbytes opcode to its corresponding int 466 pushbytes :: Opcode -> Maybe Int 467 pushbytes (fromEnum -> op) 468 | op < 76 = Just $! fi op 469 | otherwise = Nothing 470