module GenSmsPdu where {- IDEA: TP_UD depends on TP_UDHI and TP_DCS. Hence the current interface definition for toBit, BitRep a => [Int] -> a, is not enought. Something like BitRep a b => [Int] -> b -> a is required. Normally, BitRep a () is enought. Regarding TP_UD, BitRep TP_UD (TP_UDHI * TP_DCS) is required. TP_VP also shows similar phenomena. TP_VP depends on TP_VPF. BitRep TP_UD TP_VP TP_VPF is good enought. AddrValue is a variable length field. The length is defined by AddrLength field. TP_CDL specifies the length of TP_CD. 0) Explicit manipulation of bits [ b7,b6,b5,b4,b3,b2,b1,b0,b7',b6',b5',b4',b3',b2',b1',b0', ... ] 1) pattern matching cf) show encoder/decoder written in C and compare it with Haskell version! 2) value oriented programming bits1, bits2, bits3 3) Modular definition of encoding/decoding using instance declarations with contextual information 4) Same idea for modularitiy is applied to random value generation 5) a collection of small pieces of utilities to parse bits 6) finding a suitable instance with a given type 7) interactive system allowing to give various queries [Discussion] Pros 1) QuickCheck does help to identify bugs of this Haskell program itself! ex) SMS_Submit_Report_for_RP_NAck (TP_UDHI False) (TP_FCS 166) (TP_PI True 13 False True False) (TP_SCTS 75 68 9 30 55 7 72) Nothing (Just (TP_DCS_General True True Class1 UCS2_16Bit)) Nothing Nothing -> 01A6EA7568093055077236 sanity test: False SMS_Submit_Report_for_RP_NAck (TP_UDHI False) (TP_FCS 166) (TP_PI True 13 False True False) (TP_SCTS 75 68 9 30 55 7 72) Nothing (Just (TP_DCS_General True True Class2 CS_8Bit)) Nothing Nothing [] We have only to look at the decoding/encoding functions for TP_DCS_General, particularly for Class and Character encoding. 2) Interactive environment by GHCi => Allow a modular test by running smaller pieces of encoding and decoding functions. *GenSmsPdu> encode TP_PID_Bits7_6_SC_specific_use (TP_PID_Bits5_0_SC_Specific_Use 87) [0,1,0,1,1,1] *GenSmsPdu> decode TP_PID_Bits7_6_SC_specific_use [0,1,0,1,1,1] 3) Some ambiguity of SMS PDU specification - TP_PI (1 octet) is optional. What does that mean? - TP_UDHI (1 bit) is also declared to be optional. What does this mean? Cons 1) The definition of valid requires to know both Haskell and SMS. But no one here in MC R&D center knows Haskell. How can we separate Haskell from SMS? The separation would be a good idea to make QuickCheck popular and to be maintainable. 2) Places that types cann't be effective [0,1] ++ [b5,b4] ++ encode () cs ++ encode () msgclass vs. [0,1] ++ [b5,b4] ++ encode () msgclass ++ encode () cs KNOWN BUGS - 2010/02/26 [OPEN] : A bit longer PDUs are generated. - 2010/02/26 [OPEN] : Seven octets are mandatory for Enhanced VP, but shoter ones are generated. - 2010/02/26 [OPEN] : The length of UCS2 16bits in PDU is defined to be the unit of octets, not to be the unit of a 16 bit character. - 2010/02/26 [FIXED] : The following exception. It seems to be relevant to the long PDU bug. encode (TP_UDHI False, UCS2_16Bit) (TP_UD_NoUDH 138 "You'll never see all the places, or read all the books, but fortunately, they're not all recommended.-- Mark Twain, \"Tom Sawyer\"Q:\tHow man") *** Exception: [intToBits8] Too big or too small for 8bits: 276 -} import Char import Maybe import Control.Monad import System.Random import System.IO import Test.QuickCheck import Test.QuickCheck.Gen class Variant a where valid :: Gen a invalid :: Gen a instance Variant a => Arbitrary a where arbitrary = oneof [valid, invalid] instance Variant Bool where valid = elements [ False, True ] invalid = valid instance Variant a => Variant (Maybe a) where valid = oneof [ liftM Just valid, return Nothing ] invalid = valid -- proper1 f = liftM f valid -- proper2 f = liftM2 f valid valid -- proper3 f = liftM3 f valid valid valid -- proper4 f = liftM4 f valid valid valid valid -- proper5 f = liftM5 f valid valid valid valid valid -- bad1 f = liftM f invalid -- bad2 f = oneof $ tail [ liftM2 f g1 g2 | g1 <- [valid, invalid], g2 <- [valid, invalid] ] -- bad3 f = oneof $ tail [ liftM3 f g1 g2 g3 | g1 <- [valid, invalid], g2 <- [valid, invalid], g3 <- [valid, invalid] ] -- bad4 f = oneof $ tail [ liftM4 f g1 g2 g3 g4 | g1 <- [valid, invalid], g2 <- [valid, invalid], g3 <- [valid, invalid], g4 <- [valid, invalid] ] -- bad5 f = oneof $ tail [ liftM5 f g1 g2 g3 g4 g5 | g1 <- [valid, invalid], g2 <- [valid, invalid], g3 <- [valid, invalid], g4 <- [valid, invalid], g5 <- [valid, invalid] ] -- class BitRep a b where encode :: b -> a -> [Int] decode :: b -> [Int] -> (a, [Int]) instance (Show a, Show b, BitRep a b) => BitRep (Maybe a) (Bool, b) where encode (False, b) Nothing = [] encode (True, b) (Just a) = encode b a encode (flag, b) a = error ("[encode] Maybe : "++ show (flag,b) ++ ", " ++ show a) decode (False, b) bits = (Nothing, bits) decode (True, b) bits = let (a, bits') = decode b bits in (Just a, bits') -- Utilities -- 16 bits intToBits16 i | 0 <= i && i <= 65536-1 = let [b15,b14,b13,b12,b11,b10,b9,b8] = intToBits8 (i `div` 2^8) [b7,b6,b5,b4,b3,b2,b1,b0] = intToBits8 (i `mod` 2^8) in [b15,b14,b13,b12,b11,b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0] | otherwise = error ("[intToBits16] Too big or too small for 16bits: " ++ show i) bits16ToInt (b15:b14:b13:b12:b11:b10:b9:b8:b7:b6:b5:b4:b3:b2:b1:b0:bits) = bits8ToInt [b15,b14,b13,b12,b11,b10,b9,b8] * 2^8 + bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0] bits16ToInt bits = error ("[bits16ToInt] More than or less than 16 bits:" ++ show bits) -- 8 bits intToBits8 i | 0 <= i && i <= 256-1 = [b7,b6,b5,b4,b3,b2,b1,b0] | otherwise = error ("[intToBits8] Too big or too small for 8bits: " ++ show i) where [b7,b6,b5,b4] = intToBits4 (i `div` 2^4) [b3,b2,b1,b0] = intToBits4 (i `mod` 2^4) bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0] = bits4ToInt [b7,b6,b5,b4] * 2^4 + bits4ToInt [b3,b2,b1,b0] bits8ToInt bits = error ("[bits8ToInt] More than or less than 8 bits:" ++ show bits) -- 4 bits intToBits4 i | 0 <= i && i <= 16-1 = [b3,b2,b1,b0] | otherwise = error ("[intToBits4] Too big or too small for " ++ show i) where b3 = i `div` 2^3 b2 = (i - b3 * 2^3) `div` 2^2 b1 = (i - b3 * 2^3 - b2 * 2^2) `div` 2^1 b0 = (i - b3 * 2^3 - b2 * 2^2 - b1 * 2^1) `div` 2^0 bits4ToInt [b3,b2,b1,b0] = b3 * 2^3 + b2 * 2^2 + b1 * 2^1 + b0 * 2^0 bits4ToInt bits = error ("[bits4ToInt] " ++ show bits) hexdigitToBits4 '0' = [0,0,0,0] hexdigitToBits4 '1' = [0,0,0,1] hexdigitToBits4 '2' = [0,0,1,0] hexdigitToBits4 '3' = [0,0,1,1] hexdigitToBits4 '4' = [0,1,0,0] hexdigitToBits4 '5' = [0,1,0,1] hexdigitToBits4 '6' = [0,1,1,0] hexdigitToBits4 '7' = [0,1,1,1] hexdigitToBits4 '8' = [1,0,0,0] hexdigitToBits4 '9' = [1,0,0,1] hexdigitToBits4 'a' = [1,0,1,0] hexdigitToBits4 'b' = [1,0,1,1] hexdigitToBits4 'c' = [1,1,0,0] hexdigitToBits4 'd' = [1,1,0,1] hexdigitToBits4 'e' = [1,1,1,0] hexdigitToBits4 'f' = [1,1,1,1] hexdigitToBits4 'A' = [1,0,1,0] hexdigitToBits4 'B' = [1,0,1,1] hexdigitToBits4 'C' = [1,1,0,0] hexdigitToBits4 'D' = [1,1,0,1] hexdigitToBits4 'E' = [1,1,1,0] hexdigitToBits4 'F' = [1,1,1,1] hexdigitToBits4 c = error ("[hexdigitToBits4] c : " ++ show c) bits4ToHexdigit [0,0,0,0] = '0' bits4ToHexdigit [0,0,0,1] = '1' bits4ToHexdigit [0,0,1,0] = '2' bits4ToHexdigit [0,0,1,1] = '3' bits4ToHexdigit [0,1,0,0] = '4' bits4ToHexdigit [0,1,0,1] = '5' bits4ToHexdigit [0,1,1,0] = '6' bits4ToHexdigit [0,1,1,1] = '7' bits4ToHexdigit [1,0,0,0] = '8' bits4ToHexdigit [1,0,0,1] = '9' bits4ToHexdigit [1,0,1,0] = 'A' bits4ToHexdigit [1,0,1,1] = 'B' bits4ToHexdigit [1,1,0,0] = 'C' bits4ToHexdigit [1,1,0,1] = 'D' bits4ToHexdigit [1,1,1,0] = 'E' bits4ToHexdigit [1,1,1,1] = 'F' bits4ToHexdigit bits = error ("[bits4ToHexdigit] bits : " ++ show bits) -- GSM 7bit bytesToGsm7bit bytes = let is7bit c = 0 <= Char.ord c && Char.ord c <= 127 mkOctetList (b0:b1:b2:b3:b4:b5:b6:b7:therest) = b7:b6:b5:b4:b3:b2:b1:b0 : mkOctetList therest mkOctetList (b0:b1:b2:b3:b4:b5:b6:[]) = 0:b6:b5:b4:b3:b2:b1:b0 : [] mkOctetList (b0:b1:b2:b3:b4:b5:[]) = 0:0:b5:b4:b3:b2:b1:b0 : [] mkOctetList (b0:b1:b2:b3:b4:[]) = 0:0:0:b4:b3:b2:b1:b0 : [] mkOctetList (b0:b1:b2:b3:[]) = 0:0:0:0:b3:b2:b1:b0 : [] mkOctetList (b0:b1:b2:[]) = 0:0:0:0:0:b2:b1:b0 : [] mkOctetList (b0:b1:[]) = 0:0:0:0:0:0:b1:b0 : [] mkOctetList (b0:[]) = 0:0:0:0:0:0:0:b0 : [] mkOctetList [] = [] in if all is7bit bytes then mkOctetList $ reverse $ concat $ reverse $ map (drop 1 . intToBits8 . Char.ord) bytes else error ("[bytesToGsm7bit] bytes=" ++ show bytes) mkOctetList [] = [] mkOctetList (b7:b6:b5:b4:b3:b2:b1:b0:bits) = [b7,b6,b5,b4,b3,b2,b1,b0] : mkOctetList bits mkOctetList bits = error ("[gsm7bitToBytes mkOctetList] " ++ show bits) gsm7bitToBytes len bits = gsm7bitToBytes' len (concat $ map reverse bits8s) [] where bits8s = mkOctetList bits gsm7bitToBytes' 0 (0:0:0:0:0:0:0:bits) accu = (accu, bits) gsm7bitToBytes' 0 (0:0:0:0:0:0:bits) accu = (accu, bits) gsm7bitToBytes' 0 (0:0:0:0:0:bits) accu = (accu, bits) gsm7bitToBytes' 0 (0:0:0:0:bits) accu = (accu, bits) gsm7bitToBytes' 0 (0:0:0:bits) accu = (accu, bits) gsm7bitToBytes' 0 (0:0:bits) accu = (accu, bits) gsm7bitToBytes' 0 (0:bits) accu = (accu, bits) gsm7bitToBytes' 0 bits accu = (accu, bits) gsm7bitToBytes' len (b0:b1:b2:b3:b4:b5:b6:bits) accu = gsm7bitToBytes' (len-1) bits (accu ++ [Char.chr (bits8ToInt [0,b6,b5,b4,b3,b2,b1,b0])]) gsm7bitToBytes' len bits accu = error ("[gsm7bitToBytes gsm7bitToBytes'] accu=" ++ show accu ++ ", len=" ++ show len ++ ", bits=" ++ show bits) -- 8bit bytesToCS8bit bytes = if and (map (\i -> 0<=i && i<=2^8-1) (map Char.ord bytes)) then concat $ map (intToBits8 . Char.ord) bytes else error ("[bytesToCS8bit] " ++ bytes) cs8bitToBytes len bits = cs8bitToBytes' len bits where cs8bitToBytes' 0 bits = ([], bits) cs8bitToBytes' n (b7:b6:b5:b4:b3:b2:b1:b0:bits) = let (bytes', bits') = cs8bitToBytes' (n-1) bits in (Char.chr (bits8ToInt (b7:b6:b5:b4:b3:b2:b1:b0:[])) : bytes', bits') cs8bitToBytes' _ _ = error ("[cs8bitToBytes] len=" ++ show len ++ ", " ++ show bits) -- UCS2 bytesToUCS16bit bytes = if and (map (\i -> 0<=i && i<=2^16-1) (map Char.ord bytes)) then concat $ map (intToBits16 . Char.ord) bytes else error ("[bytesToCS16bit] " ++ bytes) ucs16bitToBytes len bits = ucs16bitToBytes' len bits where ucs16bitToBytes' 0 bits = ([], bits) ucs16bitToBytes' n (b15:b14:b13:b12:b11:b10:b9:b8:b7:b6:b5:b4:b3:b2:b1:b0:bits) = let (bytes', bits') = ucs16bitToBytes' (n-1) bits in (Char.chr (bits16ToInt (b15:b14:b13:b12:b11:b10:b9:b8:b7:b6:b5:b4:b3:b2:b1:b0:[])) : bytes', bits') ucs16bitToBytes' _ _ = error ("[ucs16bitToBytes] len=" ++ show len ++ ", " ++ show bits) -- bitsToHexString bits = bitsToHexString' bits where bitsToHexString' (b7:b6:b5:b4:b3:b2:b1:b0:bits) = bits4ToHexdigit [b7,b6,b5,b4] : bits4ToHexdigit [b3,b2,b1,b0] : bitsToHexString' bits bitsToHexString' [] = [] bitsToHexString' bits' = error ("[bitsToHexString] " ++ show (length bits') ++ " : " ++ show bits) hexStringToBits [] = [] hexStringToBits (c:hstr) = hexdigitToBits4 c : hexStringToBits hstr -- Random texts getRandomText len = getRandomText' "" where getRandomText' accu_str = do { i <- choose (0,length text_samples-1); let accu_str' = accu_str ++ (text_samples !! i) in if length accu_str' < len then getRandomText' accu_str' else return (take len accu_str') } text_samples = [ "You will soon forget this.", "Persons attempting to find a motive in this narrative will be prosecuted; persons attempting to find a moral in it will be banished; persons attempting to find a plot in it will be shot. By Order of the Author", "-- Mark Twain, \"Tom Sawyer\"", "Bank error in your favor. Collect $200.", "You are capable of planning your future.", "The mind is its own place, and in itself Can make a Heav'n of Hell, a Hell of Heav'n.", "-- John Milton", "I was gratified to be able to answer promptly, and I did. I said I didn't know.", "-- Mark Twain", "You dialed 5483.", "Don't worry so loud, your roommate can't think.", "You'll never see all the places, or read all the books, but fortunately, they're not all recommended.", "Q: How many journalists does it take to screw in a light bulb?\nA: Three. One to report it as an inspired government program to bring\nlight to the people, one to report it as a diabolical government plot\nto deprive the poor of darkness, and one to win a Pulitzer prize for\nreporting that Electric Company hired a light bulb-assassin to break\nthe bulb in the first place.", "Truth will out this morning. (Which may really mess things up.)", "Soap and education are not as sudden as a massacre, but they are more deadly in the long run.", "-- Mark Twain", "Q:\tHow many DEC repairman does it take to fix a flat?,\nA:\tFive; four to hold the car up and one to swap tires.", "Q:\tHow long does it take?\nA:\tIt's indeterminate.\nIt will depend upon how many flats they've brought with them.", "Q:\tWhat happens if you've got TWO flats?\nA:\tThey replace your generator.", "As to the Adjective: when in doubt, strike it out.", "-- Mark Twain, \"Pudd'nhead Wilson's Calendar\"", "You're not my type. For that matter, you're not even my species!!!", "Your aims are high, and you are capable of much.", "Q:\tWhat's the difference between USL and the Titanic?\nA:\tThe Titanic had a band.", "The human race has one really effective weapon, and that is laughter.", "-- Mark Twain", "You look like a million dollars. All green and wrinkled.", "\"I understand this is your first dead client,\" Sabian was saying. The\nabsurdity of the statement made me want to laugh but they don't call me\nDeadpan Allie and lie.", "-- Pat Cadigan, \"Mindplayers\"", "The Least Perceptive Literary Critic\n\tThe most important critic in our field of study is Lord Halifax. A most individual judge of poetry, he once invited Alexander Pope round to give a public reading of his latest poem.\n\tPope, the leading poet of his day, was greatly surprised when Lord Halifax stopped him four or five times and said, \"I beg your pardon, Mr. Pope, but there is something in that passage that does not quite please me.\"\n\tPope was rendered speechless, as this fine critic suggested sizeable\nand unwise emendations to his latest masterpiece. \"Be so good as to mark\nthe place and consider at your leisure. I'm sure you can give it a better turn.\"\n\tAfter the reading, a good friend of Lord Halifax, a certain Dr.\nGarth, took the stunned Pope to one side. \"There is no need to touch the\nlines,\" he said. \"All you need do is leave them just as they are, call on\nLord Halifax two or three months hence, thank him for his kind observation\non those passages, and then read them to him as altered. I have known him\nmuch longer than you have, and will be answerable for the event.\"\n\tPope took his advice, called on Lord Halifax and read the poem\nexactly as it was before. His unique critical faculties had lost none of\ntheir edge. \"Ay\", he commented, \"now they are perfectly right. Nothing can\nbe better.\"", "-- Stephen Pile, \"The Book of Heroic Failures\"", "Avoid reality at all costs.", "You will have good luck and overcome many hardships.", "You will triumph over your enemy.", "Your talents will be recognized and suitably rewarded.", "You are dishonest, but never to the point of hurting a friend.", "It's all in the mind, ya know.", "Your supervisor is thinking about you.", "Your motives for doing whatever good deed you may have in mind will be\nmisinterpreted by somebody.", "I don't know half of you half as well as I should like; and I like less\nthan half of you half as well as you deserve.", "-- J. R. R. Tolkien", "Life is to you a dashing and bold adventure.", "A hundred years from now it is very likely that [of Twain's works] \"The\nJumping Frog\" alone will be remembered.", "-- Harry Thurston Peck (Editor of \"The Bookman\"), January 1901.", "You will get what you deserve.", "You are so boring that when I see you my feet go to sleep.", "You will win success in whatever calling you adopt.", "Q:\tHow many psychiatrists does it take to change a light bulb?\nA:\tOnly one, but it takes a long time, and the light bulb has\n to really want to change.", "Someone is speaking well of you.", "How unusual!\n\nQ:\tWhy did the germ cross the microscope?\nA:\tTo get to the other slide.", "Your sister swims out to meet troop ships." ] getRandomPhoneNumber len = getRandomPhoneNumber' "" where getRandomPhoneNumber' accu_str = do { digit <- elements bcd_digits; let accu_str' = accu_str ++ [digit] in if length accu_str' < len then getRandomPhoneNumber' accu_str' else return (take len accu_str') } bcd_digits = ['0','1','2','3','4','5','6','7','8','9', '#','*','a', 'b', 'c'] bitsToBCDDigits [0,0,0,0] = '0' bitsToBCDDigits [0,0,0,1] = '1' bitsToBCDDigits [0,0,1,0] = '2' bitsToBCDDigits [0,0,1,1] = '3' bitsToBCDDigits [0,1,0,0] = '4' bitsToBCDDigits [0,1,0,1] = '5' bitsToBCDDigits [0,1,1,0] = '6' bitsToBCDDigits [0,1,1,1] = '7' bitsToBCDDigits [1,0,0,0] = '8' bitsToBCDDigits [1,0,0,1] = '9' bitsToBCDDigits [1,0,1,0] = '#' bitsToBCDDigits [1,0,1,1] = '*' bitsToBCDDigits [1,1,0,0] = 'a' bitsToBCDDigits [1,1,0,1] = 'b' bitsToBCDDigits [1,1,1,0] = 'c' bitsToBCDDigits bits = error ("[bitsToBCDDigits] " ++ show bits) bcdDigitsToBits '0' = [0,0,0,0] bcdDigitsToBits '1' = [0,0,0,1] bcdDigitsToBits '2' = [0,0,1,0] bcdDigitsToBits '3' = [0,0,1,1] bcdDigitsToBits '4' = [0,1,0,0] bcdDigitsToBits '5' = [0,1,0,1] bcdDigitsToBits '6' = [0,1,1,0] bcdDigitsToBits '7' = [0,1,1,1] bcdDigitsToBits '8' = [1,0,0,0] bcdDigitsToBits '9' = [1,0,0,1] bcdDigitsToBits '#' = [1,0,1,0] bcdDigitsToBits '*' = [1,0,1,1] bcdDigitsToBits 'a' = [1,1,0,0] bcdDigitsToBits 'b' = [1,1,0,1] bcdDigitsToBits 'c' = [1,1,1,0] bcdDigitsToBits bits = error ("[bcdDigitsToBits] " ++ show bits) {- 3GPP TS23.040 v6.7.0 -} -------------------------------------------------------------------------------- -- Address fields -------------------------------------------------------------------------------- data AddrFields = AddrFields AddrLen TypeOfAddr AddrValue deriving (Show,Eq) instance BitRep AddrFields a where encode _ (AddrFields addrlen toa addrvalue) = encode () addrlen ++ encode () toa ++ encode addrlen addrvalue decode _ bits = let (addrlen, bits1) = decode () bits (toa, bits2) = decode () bits1 (addrval, bits3) = decode addrlen bits2 in (AddrFields addrlen toa addrval, bits3) instance Variant AddrFields where valid = liftM3 AddrFields valid valid valid `suchThat` (\(AddrFields (AddrLen len) toa (AddrValue s)) -> len == length s) invalid = valid -------------------------------------------------------------------------------- -- Address Length -------------------------------------------------------------------------------- data AddrLen = AddrLen Int {- 8bits -} deriving (Show,Eq) instance BitRep AddrLen a where encode _ (AddrLen i) | 0 <= i && i <= 256 = intToBits8 i | otherwise = error ("[encode] AddrLen: " ++ show i) decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (AddrLen (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) decode _ bits = error ("[decode] AddrLen : " ++ show bits) instance Variant AddrLen where valid = do len <- choose (0, 10 * 2) return (AddrLen len) invalid = valid -------------------------------------------------------------------------------- -- Type of Address -------------------------------------------------------------------------------- data TypeOfAddr = TypeOfAddr TypeOfNum NumberingPlanIdentification deriving (Show,Eq) instance BitRep TypeOfAddr a where encode _ (TypeOfAddr ton npi) = [1] ++ (encode () ton) ++ (encode () npi) decode _ (1:bits) = let (ton, bits1) = decode () bits (npi, bits2) = decode () bits1 in (TypeOfAddr ton npi, bits2) decode _ bits = error ("[decode] TypeOfAddr : " ++ show bits) instance Variant TypeOfAddr where valid = liftM2 TypeOfAddr valid valid invalid = valid -------------------------------------------------------------------------------- -- Type of Number -------------------------------------------------------------------------------- data TypeOfNum = TON_Unknown {- 000 -} | TON_Internation_number {- 001 -} | TON_National_number {- 010 -} | TON_Network_specific_number {- 011 -} | TON_Subscriber_number {- 100 -} | TON_Alphanumeric_gsm7bit {- 101 -} | TON_Abbreviated_number {- 110 -} | TON_Reserved {- 111 -} deriving (Show, Eq) instance BitRep TypeOfNum a where encode _ TON_Unknown = [0,0,0] encode _ TON_Internation_number = [0,0,1] encode _ TON_National_number = [0,1,0] encode _ TON_Network_specific_number = [0,1,1] encode _ TON_Subscriber_number = [1,0,0] encode _ TON_Alphanumeric_gsm7bit = [1,0,1] encode _ TON_Abbreviated_number = [1,1,0] encode _ TON_Reserved = [1,1,1] decode _ (0:0:0:bits) = (TON_Unknown, bits) decode _ (0:0:1:bits) = (TON_Internation_number, bits) decode _ (0:1:0:bits) = (TON_National_number, bits) decode _ (0:1:1:bits) = (TON_Network_specific_number, bits) decode _ (1:0:0:bits) = (TON_Subscriber_number, bits) decode _ (1:0:1:bits) = (TON_Alphanumeric_gsm7bit, bits) decode _ (1:1:0:bits) = (TON_Abbreviated_number, bits) decode _ (1:1:1:bits) = (TON_Reserved, bits) decode _ bits = error ("[decode] TypeOfNum : " ++ show bits) instance Variant TypeOfNum where valid = elements [ TON_Unknown, TON_Internation_number, TON_National_number, TON_Network_specific_number, TON_Subscriber_number, TON_Alphanumeric_gsm7bit, TON_Abbreviated_number, TON_Reserved ] invalid = valid -------------------------------------------------------------------------------- -- Numbering Plan Identification -------------------------------------------------------------------------------- data NumberingPlanIdentification = NPI_Unknown {- 0000 -} | NPI_ISDN_Tel_numbering_plan {- 0001 -} | NPI_Data_numbering_plan {- 0011 -} | NPI_Telex_numbering_plan {- 0100 -} | NPI_Service_center_specific_plan1 {- 0101 -} | NPI_Service_center_specific_plan2 {- 0102 -} | NPI_National_numbering_plan {- 1000 -} | NPI_Private_numbering_plan {- 1001 -} | NPI_ERMES_numbering_plan {- 1010 -} | NPI_Reserved Int {- 1111 and the rest values -} deriving (Show, Eq) instance BitRep NumberingPlanIdentification a where encode _ NPI_Unknown = [0,0,0,0] encode _ NPI_ISDN_Tel_numbering_plan = [0,0,0,1] encode _ NPI_Data_numbering_plan = [0,0,1,1] encode _ NPI_Telex_numbering_plan = [0,1,0,0] encode _ NPI_Service_center_specific_plan1 = [0,1,0,1] encode _ NPI_Service_center_specific_plan2 = [0,1,1,0] encode _ NPI_National_numbering_plan = [1,0,0,0] encode _ NPI_Private_numbering_plan = [1,0,0,1] encode _ NPI_ERMES_numbering_plan = [1,0,1,0] encode _ (NPI_Reserved i) | 0 <= i && i <= 15 && i `elem` [2,7,11,12,13,14,15] = drop 4 (intToBits8 i) | otherwise = error ("[encode] NumberingPlanIdentification :" ++ show i) decode _ (0:0:0:0:bits) = (NPI_Unknown, bits) decode _ (0:0:0:1:bits) = (NPI_ISDN_Tel_numbering_plan, bits) decode _ (0:0:1:1:bits) = (NPI_Data_numbering_plan, bits) decode _ (0:1:0:0:bits) = (NPI_Telex_numbering_plan, bits) decode _ (0:1:0:1:bits) = (NPI_Service_center_specific_plan1, bits) decode _ (0:1:1:0:bits) = (NPI_Service_center_specific_plan2, bits) decode _ (1:0:0:0:bits) = (NPI_National_numbering_plan, bits) decode _ (1:0:0:1:bits) = (NPI_Private_numbering_plan, bits) decode _ (1:0:1:0:bits) = (NPI_ERMES_numbering_plan, bits) decode _ (b3:b2:b1:b0:bits) = (NPI_Reserved (bits8ToInt ([0,0,0,0]++[b3,b2,b1,b0])), bits) decode _ bits = error ("[decode] NumberingPlanIdentification : " ++ show bits) instance Variant NumberingPlanIdentification where valid = let gen1 = elements [ NPI_Unknown, NPI_ISDN_Tel_numbering_plan, NPI_Data_numbering_plan, NPI_Telex_numbering_plan, NPI_Service_center_specific_plan1, NPI_Service_center_specific_plan2, NPI_National_numbering_plan, NPI_Private_numbering_plan, NPI_ERMES_numbering_plan] gen2 = liftM NPI_Reserved (elements [2,7,11,12,13,14,15]) in frequency [(20,gen1), (1,gen2)] invalid = valid -------------------------------------------------------------------------------- -- Address Value -------------------------------------------------------------------------------- {- TBD: Assumption: 1) each character of the string is a hexa digit. 2) The length of the string must be even so that each pair of the characters will be one octet. -} data AddrValue = AddrValue String deriving (Show, Eq) instance BitRep AddrValue AddrLen where encode (AddrLen len) (AddrValue s) | len == length s = let f (high_digit:low_digit:ss) = bcdDigitsToBits low_digit ++ bcdDigitsToBits high_digit ++ f ss f [single_digit] = [1,1,1,1] ++ bcdDigitsToBits single_digit f [] = [] in f s | otherwise = error ("[encode] AddrValue string : " ++ show s ++ " whose length is " ++ show (length s)) decode (AddrLen len) bits = let toStr 0 bits = ([], bits) toStr i (b7:b6:b5:b4:b3:b2:b1:b0:bits) | i>=2 = let (hs,bits') = toStr (i-2) bits in (bitsToBCDDigits [b3,b2,b1,b0] : bitsToBCDDigits [b7,b6,b5,b4] : hs, bits') | i==1 = (bitsToBCDDigits [b3,b2,b1,b0] : [], bits) toStr i bits = error ("[decode] AddrValue : " ++ show i ++ ", " ++ show bits) (hs, bits'') = toStr len bits in (AddrValue hs, bits'') instance Variant AddrValue where valid = do len <- choose (0, 10*2) digits <- getRandomPhoneNumber len return (AddrValue digits) invalid = valid -------------------------------------------------------------------------------- -- TP-Message-Type-Indicator (TP-MTI) -------------------------------------------------------------------------------- data TP_MTI = SMS_DELIVER {- 00 when SC=>MS -} | SMS_DELIVER_REPORT_ACK {- 00 when SC<=MS -} | SMS_DELIVER_REPORT_NACK {- 00 when SC<=MS -} | SMS_STATUS_REPORT {- 10 when SC=>MS -} | SMS_COMMAND {- 10 when SC<=MS -} | SMS_SUBMIT {- 01 when SC<=MS -} | SMS_SUBMIT_REPORT_ACK {- 01 when SC=>MS -} | SMS_SUBMIT_REPORT_NACK {- 01 when SC=>MS -} | TP_MTI_RESERVED {- 11 -} deriving (Show, Eq) data Direction = SCtoMS | MStoSC deriving (Show, Eq) data Acknowledgement = Ack | NAck deriving (Show, Eq) instance BitRep TP_MTI (Direction, Maybe Acknowledgement) where encode (SCtoMS,Nothing) SMS_DELIVER = [0,0] encode (MStoSC,Just Ack) SMS_DELIVER_REPORT_ACK = [0,0] encode (MStoSC,Just NAck) SMS_DELIVER_REPORT_NACK = [0,0] encode (SCtoMS,Nothing) SMS_STATUS_REPORT = [1,0] encode (MStoSC,Nothing) SMS_COMMAND = [1,0] encode (MStoSC,Nothing) SMS_SUBMIT = [0,1] encode (SCtoMS,Just Ack) SMS_SUBMIT_REPORT_ACK = [0,1] encode (SCtoMS,Just NAck) SMS_SUBMIT_REPORT_NACK = [0,1] encode (_,_) TP_MTI_RESERVED = [1,1] encode dir_ack tp_mti = error ("[encode] TP_MTI : " ++ show dir_ack ++ ", " ++ show tp_mti) decode (SCtoMS,Nothing) (0:0:bits) = (SMS_DELIVER, bits) decode (MStoSC,Just Ack) (0:0:bits) = (SMS_DELIVER_REPORT_ACK, bits) decode (MStoSC,Just NAck) (0:0:bits) = (SMS_DELIVER_REPORT_NACK, bits) decode (SCtoMS,Nothing) (1:0:bits) = (SMS_STATUS_REPORT, bits) decode (MStoSC,Nothing) (1:0:bits) = (SMS_COMMAND, bits) decode (MStoSC,Nothing) (0:1:bits) = (SMS_SUBMIT, bits) decode (SCtoMS,Just Ack) (0:1:bits) = (SMS_SUBMIT_REPORT_ACK, bits) decode (SCtoMS,Just NAck) (0:1:bits) = (SMS_SUBMIT_REPORT_NACK, bits) decode (_,_) (1:1:bits) = (TP_MTI_RESERVED, bits) decode dir_ack bits = error ("[decode] TP_MTI : " ++ show dir_ack ++ ", " ++ show bits) instance Variant TP_MTI where valid = elements [ SMS_DELIVER, SMS_DELIVER_REPORT_ACK, SMS_DELIVER_REPORT_NACK, SMS_STATUS_REPORT, SMS_COMMAND, SMS_SUBMIT, SMS_SUBMIT_REPORT_ACK, SMS_SUBMIT_REPORT_NACK, TP_MTI_RESERVED ] invalid = valid -------------------------------------------------------------------------------- -- TP-More-Message-to-Send (TP-MMS) -------------------------------------------------------------------------------- data TP_MMS = TP_MMS_More_Messages {- 0 -} | TP_MMS_No_More_Messages {- 1 -} deriving (Show, Eq) instance BitRep TP_MMS a where encode _ TP_MMS_More_Messages = [0] encode _ TP_MMS_No_More_Messages = [1] decode _ (0:bits) = (TP_MMS_More_Messages, bits) decode _ (1:bits) = (TP_MMS_No_More_Messages, bits) decode _ bits = error ("[decode] TP_MMS : " ++ show bits) instance Variant TP_MMS where valid = elements [ TP_MMS_More_Messages, TP_MMS_No_More_Messages ] invalid = valid -------------------------------------------------------------------------------- -- TP-Validity-Period-Format (TP-VPF) -------------------------------------------------------------------------------- data TP_VPF = TP_VP_Field_Not_Present {- 00 -} | TP_VP_Field_Present_Relative {- 10 -} | TP_VP_Field_Present_Enhanced {- 01 -} | TP_VP_Field_Present_Absolute {- 11 -} deriving (Show, Eq) isTP_VP_Field_Not_Present TP_VP_Field_Not_Present = True isTP_VP_Field_Not_Present _ = False isTP_VP_Field_Present_Relative TP_VP_Field_Present_Relative = True isTP_VP_Field_Present_Relative _ = False isTP_VP_Field_Present_Enhanced TP_VP_Field_Present_Enhanced = True isTP_VP_Field_Present_Enhanced _ = False isTP_VP_Field_Present_Absolute TP_VP_Field_Present_Absolute = True isTP_VP_Field_Present_Absolute _ = False instance BitRep TP_VPF a where encode _ TP_VP_Field_Not_Present = [0,0] encode _ TP_VP_Field_Present_Relative = [1,0] encode _ TP_VP_Field_Present_Enhanced = [0,1] encode _ TP_VP_Field_Present_Absolute = [1,1] decode _ (0:0:bits) = (TP_VP_Field_Not_Present, bits) decode _ (1:0:bits) = (TP_VP_Field_Present_Relative, bits) decode _ (0:1:bits) = (TP_VP_Field_Present_Enhanced, bits) decode _ (1:1:bits) = (TP_VP_Field_Present_Absolute, bits) decode _ bits = error ("[decode] TP_VPF : " ++ show bits) instance Variant TP_VPF where valid = elements [ TP_VP_Field_Not_Present, TP_VP_Field_Present_Relative, TP_VP_Field_Present_Enhanced, TP_VP_Field_Present_Absolute ] invalid = valid -------------------------------------------------------------------------------- -- TP-Status-Report-Indication (TP-SRI) -------------------------------------------------------------------------------- data TP_SRI = TP_SRI_No_Status_Report_Indication {- 0 -} | TP_SRI_Status_Report_Indication {- 1 -} deriving (Show, Eq) instance BitRep TP_SRI a where encode _ TP_SRI_No_Status_Report_Indication = [0] encode _ TP_SRI_Status_Report_Indication = [1] decode _ (0:bits) = (TP_SRI_No_Status_Report_Indication, bits) decode _ (1:bits) = (TP_SRI_Status_Report_Indication, bits) decode _ bits = error ("[decode] TP_SRI : " ++ show bits) instance Variant TP_SRI where valid = elements [ TP_SRI_No_Status_Report_Indication, TP_SRI_Status_Report_Indication ] invalid = valid -------------------------------------------------------------------------------- -- TP-Status-Report-Request (TP-SRR) -------------------------------------------------------------------------------- data TP_SRR = TP_SRR_No_Status_Report_Requested {- 0 -} | TP_SRR_Status_Report_Requested {- 1 -} deriving (Show, Eq) isTP_SRR_No_Status_Report_Requested TP_SRR_No_Status_Report_Requested = True isTP_SRR_No_Status_Report_Requested _ = False isTP_SRR_Status_Report_Requested TP_SRR_Status_Report_Requested = True isTP_SRR_Status_Report_Requested _ = False instance BitRep TP_SRR a where encode _ TP_SRR_No_Status_Report_Requested = [0] encode _ TP_SRR_Status_Report_Requested = [1] decode _ (0:bits) = (TP_SRR_No_Status_Report_Requested, bits) decode _ (1:bits) = (TP_SRR_Status_Report_Requested, bits) decode _ bits = error ("[decode] TP_SRR : " ++ show bits) instance Variant TP_SRR where valid = elements [ TP_SRR_No_Status_Report_Requested, TP_SRR_Status_Report_Requested ] invalid = valid -------------------------------------------------------------------------------- -- TP-Message-Reference (TP-MR) -------------------------------------------------------------------------------- data TP_MR = TP_MR Int {- 0 to 255 -} deriving (Show,Eq) instance BitRep TP_MR a where encode _ (TP_MR i) | 0 <= i && i <= 255 = intToBits8 i | otherwise = error ("[encode] TP_MR " ++ show i) decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_MR (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) decode _ bits = error ("[decode] TP_MR : " ++ show bits) instance Variant TP_MR where valid = liftM TP_MR (choose (0,255)) invalid = valid -------------------------------------------------------------------------------- -- TP-Originating-Address (TP-OA) -------------------------------------------------------------------------------- data TP_OA = TP_OA AddrFields deriving (Show, Eq) instance BitRep TP_OA a where encode _ (TP_OA addrfields) = encode () addrfields decode _ bits = let (addrfields, bits') = decode () bits in (TP_OA addrfields, bits') instance Variant TP_OA where valid = liftM TP_OA valid invalid = valid -------------------------------------------------------------------------------- -- TP-Destination-Address (TP-DA) -------------------------------------------------------------------------------- data TP_DA = TP_DA AddrFields deriving (Show, Eq) instance BitRep TP_DA a where encode _ (TP_DA addrfields) = encode () addrfields decode _ bits = let (addrfields,bits') = decode () bits in (TP_DA addrfields, bits') instance Variant TP_DA where valid = liftM TP_DA valid invalid = valid -------------------------------------------------------------------------------- -- TP-Protocol-Identifier (TP-PID) -------------------------------------------------------------------------------- data TP_PID = TP_PID TP_PID_Bits7_6 TP_PID_Bits5_0 deriving (Show, Eq) instance BitRep TP_PID a where encode _ (TP_PID tp_pid_bits7_6 tp_pid_bits5_0) = encode () tp_pid_bits7_6 ++ encode tp_pid_bits7_6 tp_pid_bits5_0 decode _ bits = let (tp_pid_bits7_6, bits') = decode () bits (tp_pid_bits5_0, bits'') = decode tp_pid_bits7_6 bits' in (TP_PID tp_pid_bits7_6 tp_pid_bits5_0, bits'') instance Variant TP_PID where valid = do tp_pid_bits7_6 <- valid tp_pid_bits5_0 <- valid `suchThat` (\tp_pid_bits5_0 -> isTP_PID_Bits7_6_00 tp_pid_bits7_6 && isTP_PID_Bit5_Bits4_0 tp_pid_bits5_0 || isTP_PID_Bits7_6_01 tp_pid_bits7_6 && isTP_PID_Bits5_0_ tp_pid_bits5_0 || isTP_PID_Bits7_6_Reserved tp_pid_bits7_6 && isTP_PID_Bits5_0_Reserved tp_pid_bits5_0 || isTP_PID_Bits7_6_SC_specific_use tp_pid_bits7_6 && isTP_PID_Bits5_0_SC_Specific_Use tp_pid_bits5_0 ) return (TP_PID tp_pid_bits7_6 tp_pid_bits5_0) invalid = valid -------------------------------------------------------------------------------- -- TP-Protocol-Identifier 7 to 6 bits -------------------------------------------------------------------------------- data TP_PID_Bits7_6 = TP_PID_Bits7_6_00 {- 00 -} | TP_PID_Bits7_6_01 {- 01 -} | TP_PID_Bits7_6_Reserved {- 10 -} | TP_PID_Bits7_6_SC_specific_use {- 11 -} deriving (Show, Eq) isTP_PID_Bits7_6_00 TP_PID_Bits7_6_00 = True isTP_PID_Bits7_6_00 _ = False isTP_PID_Bits7_6_01 TP_PID_Bits7_6_01 = True isTP_PID_Bits7_6_01 _ = False isTP_PID_Bits7_6_Reserved TP_PID_Bits7_6_Reserved = True isTP_PID_Bits7_6_Reserved _ = False isTP_PID_Bits7_6_SC_specific_use TP_PID_Bits7_6_SC_specific_use = True isTP_PID_Bits7_6_SC_specific_use _ = False instance BitRep TP_PID_Bits7_6 a where encode _ TP_PID_Bits7_6_00 = [0,0] encode _ TP_PID_Bits7_6_01 = [0,1] encode _ TP_PID_Bits7_6_Reserved = [1,0] encode _ TP_PID_Bits7_6_SC_specific_use = [1,1] decode _ (0:0:bits) = (TP_PID_Bits7_6_00, bits) decode _ (0:1:bits) = (TP_PID_Bits7_6_01, bits) decode _ (1:0:bits) = (TP_PID_Bits7_6_Reserved, bits) decode _ (1:1:bits) = (TP_PID_Bits7_6_SC_specific_use, bits) decode _ bits = error ("[decode] TP_PID_Bits7_6 : " ++ show bits) instance Variant TP_PID_Bits7_6 where valid = elements [ TP_PID_Bits7_6_00, TP_PID_Bits7_6_01, TP_PID_Bits7_6_Reserved, TP_PID_Bits7_6_SC_specific_use ] invalid = valid -------------------------------------------------------------------------------- -- TP-Protocol-Identifier 5 to 0 bits -------------------------------------------------------------------------------- data TP_PID_Bits5_0 = TP_PID_Bit5_Bits4_0 TP_PID_Bit5 TP_PID_Bits4_0 | TP_PID_Bits5_0_ TP_PID_Bits5_0_ | TP_PID_Bits5_0_Reserved Int -- 6 bits | TP_PID_Bits5_0_SC_Specific_Use Int -- 6 bits deriving (Show, Eq) isTP_PID_Bit5_Bits4_0 (TP_PID_Bit5_Bits4_0 _ _) = True isTP_PID_Bit5_Bits4_0 _ = False isTP_PID_Bits5_0_ (TP_PID_Bits5_0_ _) = True isTP_PID_Bits5_0_ _ = False isTP_PID_Bits5_0_Reserved (TP_PID_Bits5_0_Reserved _) = True isTP_PID_Bits5_0_Reserved _ = False isTP_PID_Bits5_0_SC_Specific_Use (TP_PID_Bits5_0_SC_Specific_Use _) = True isTP_PID_Bits5_0_SC_Specific_Use _ = False instance BitRep TP_PID_Bits5_0 TP_PID_Bits7_6 where encode TP_PID_Bits7_6_00 (TP_PID_Bit5_Bits4_0 tp_pid_bit5 tp_pid_bits4_0) = encode TP_PID_Bits7_6_00 tp_pid_bit5 ++ encode (TP_PID_Bits7_6_00, tp_pid_bit5) tp_pid_bits4_0 encode TP_PID_Bits7_6_01 (TP_PID_Bits5_0_ tp_pid_bits5_0_) = encode TP_PID_Bits7_6_01 tp_pid_bits5_0_ encode TP_PID_Bits7_6_Reserved (TP_PID_Bits5_0_Reserved i) = if 0 <= i && i <= 2^6 - 1 then drop 2 (intToBits8 i) else error ("[encode] TP_PID_Bits7_6_Reserved : " ++ show i) encode TP_PID_Bits7_6_SC_specific_use (TP_PID_Bits5_0_SC_Specific_Use i) = if 0 <= i && i <= 2^6 - 1 then drop 2 (intToBits8 i) else error ("[encode] TP_PID_Bits5_0_SC_Specific_Use : " ++ show i) decode TP_PID_Bits7_6_00 bits = let (tp_pid_bit5,bits1) = decode TP_PID_Bits7_6_00 bits (tp_pid_bits4_0,bits2) = decode (TP_PID_Bits7_6_00, tp_pid_bit5) bits1 in (TP_PID_Bit5_Bits4_0 tp_pid_bit5 tp_pid_bits4_0, bits2) decode TP_PID_Bits7_6_01 bits = let (tp_pid_bits5_0_ ,bits') = decode TP_PID_Bits7_6_01 bits in (TP_PID_Bits5_0_ tp_pid_bits5_0_, bits') decode TP_PID_Bits7_6_Reserved (b5:b4:b3:b2:b1:b0:bits) = (TP_PID_Bits5_0_Reserved (bits8ToInt [0,0,b5,b4,b3,b2,b1,b0]), bits) decode TP_PID_Bits7_6_Reserved bits = error ("[decode] TP_PID_Bits7_6_Reserved : " ++ show bits) decode TP_PID_Bits7_6_SC_specific_use (b5:b4:b3:b2:b1:b0:bits) = (TP_PID_Bits5_0_SC_Specific_Use (bits8ToInt [0,0,b5,b4,b3,b2,b1,b0]), bits) decode TP_PID_Bits7_6_SC_specific_use bits = error ("[decode] TP_PID_Bits7_6_SC_specific_use : " ++ show bits) instance Variant TP_PID_Bits5_0 where valid = oneof [ do tp_pid_bit5 <- valid tp_pid_bit4_0 <- valid `suchThat` (\tp_pid_bit4_0 -> isTP_PID_Bit5_Telematic_interworking tp_pid_bit5 && isTP_PID_Bits4_0_STSP tp_pid_bit4_0 == False || isTP_PID_Bit5_Sme_to_sme_protocol tp_pid_bit5 && isTP_PID_Bits4_0_STSP tp_pid_bit4_0 == True ) return (TP_PID_Bit5_Bits4_0 tp_pid_bit5 tp_pid_bit4_0), liftM TP_PID_Bits5_0_ valid, liftM TP_PID_Bits5_0_Reserved (choose (0,2^6 - 1)), liftM TP_PID_Bits5_0_SC_Specific_Use (choose (0,2^6 - 1)) ] invalid = valid -------------------------------------------------------------------------------- -- TP-Protocol-Identifier bit 5 when Bit7 and Bit6 are 00 -------------------------------------------------------------------------------- data TP_PID_Bit5 = TP_PID_Bit5_Sme_to_sme_protocol {- 0 -} | TP_PID_Bit5_Telematic_interworking {- 1 -} deriving (Show, Eq) isTP_PID_Bit5_Sme_to_sme_protocol TP_PID_Bit5_Sme_to_sme_protocol = True isTP_PID_Bit5_Sme_to_sme_protocol _ = False isTP_PID_Bit5_Telematic_interworking TP_PID_Bit5_Telematic_interworking = True isTP_PID_Bit5_Telematic_interworking _ = False instance BitRep TP_PID_Bit5 TP_PID_Bits7_6 where encode TP_PID_Bits7_6_00 TP_PID_Bit5_Sme_to_sme_protocol = [0] encode TP_PID_Bits7_6_00 TP_PID_Bit5_Telematic_interworking = [1] encode tp_pid_bits7_6 tp_pid_bit5 = error ("[encode] TP_PID_Bit5 : " ++ show tp_pid_bits7_6 ++ ", " ++ show tp_pid_bit5) decode TP_PID_Bits7_6_00 (0:bits) = (TP_PID_Bit5_Sme_to_sme_protocol, bits) decode TP_PID_Bits7_6_00 (1:bits) = (TP_PID_Bit5_Telematic_interworking, bits) decode tp_pid_bits7_6 bits = error ("[decode] TP_PID_Bit5 : " ++ show tp_pid_bits7_6 ++ ", " ++ show bits) instance Variant TP_PID_Bit5 where valid = elements [ TP_PID_Bit5_Sme_to_sme_protocol, TP_PID_Bit5_Telematic_interworking ] invalid = valid -------------------------------------------------------------------------------- -- TP-Protocol-Identifier 4 to 0 bits when Bit7 and Bit6 are 00 -------------------------------------------------------------------------------- data TP_PID_Bits4_0 = TP_PID_Bits4_0_Implicit {- 00000 -} | TP_PID_Bits4_0_Telex {- 00001 -} | TP_PID_Bits4_0_Group3_telefax {- 00010 -} | TP_PID_Bits4_0_Group4_telefax {- 00011 -} | TP_PID_Bits4_0_Voice_telephoney {- 00100 -} | TP_PID_Bits4_0_ERMES {- 00101 -} | TP_PID_Bits4_0_National_paging_system {- 00110 -} | TP_PID_Bits4_0_Videotex {- 00111 -} | TP_PID_Bits4_0_Teletex {- 01000 -} | TP_PID_Bits4_0_Teletex_in_PSPDN {- 01001 -} | TP_PID_Bits4_0_Teletex_in_CSPDN {- 01010 -} | TP_PID_Bits4_0_Teletex_in_analog_PSTN {- 01011 -} | TP_PID_Bits4_0_Teletex_in_digital_ISDN {- 01100 -} | TP_PID_Bits4_0_UCI {- 01101 -} | TP_PID_Bits4_0_Reserved1 {- 01110 -} | TP_PID_Bits4_0_Reserved2 {- 01111 -} | TP_PID_Bits4_0_Msg_handling_facility {- 10000 -} | TP_PID_Bits4_0_X400_msg_handling_system {- 10001 -} | TP_PID_Bits4_0_Internet_email {- 10010 -} | TP_PID_Bits4_0_Reserved3 {- 10011 -} | TP_PID_Bits4_0_Reserved4 {- 10100 -} | TP_PID_Bits4_0_Reserved5 {- 10101 -} | TP_PID_Bits4_0_Reserved6 {- 10110 -} | TP_PID_Bits4_0_Reserved7 {- 10111 -} | TP_PID_Bits4_0_Specific_to_SC1 {- 11000 -} | TP_PID_Bits4_0_Specific_to_SC2 {- 11001 -} | TP_PID_Bits4_0_Specific_to_SC3 {- 11010 -} | TP_PID_Bits4_0_Specific_to_SC4 {- 11011 -} | TP_PID_Bits4_0_Specific_to_SC5 {- 11100 -} | TP_PID_Bits4_0_Specific_to_SC6 {- 11101 -} | TP_PID_Bits4_0_Specific_to_SC7 {- 11110 -} | TP_PID_Bits4_0_Gsm_UMTS_mobile_station {- 11111 -} | TP_PID_Bits4_0_STSP Int -- This is for SME-TO-SME-Protocol deriving (Show, Eq) isTP_PID_Bits4_0_STSP (TP_PID_Bits4_0_STSP i) = True isTP_PID_Bits4_0_STSP _ = False instance BitRep TP_PID_Bits4_0 (TP_PID_Bits7_6, TP_PID_Bit5) where encode (TP_PID_Bits7_6_00, TP_PID_Bit5_Sme_to_sme_protocol) = (\x -> case x of TP_PID_Bits4_0_STSP i -> if 0 <= i && i <= 2^5 - 1 then drop 3 (intToBits8 i) else error ("[encode] TP_PID_Bits7_6_00, TP_PID_Bit5_Sme_to_sme_protocol : " ++ show x) _ -> error ("[encode] TP_PID_Bits7_6_00, TP_PID_Bit5_Sme_to_sme_protocol : " ++ show x)) encode (TP_PID_Bits7_6_00, TP_PID_Bit5_Telematic_interworking)= (\x -> case x of TP_PID_Bits4_0_Implicit -> [0,0,0,0,0] TP_PID_Bits4_0_Telex -> [0,0,0,0,1] TP_PID_Bits4_0_Group3_telefax -> [0,0,0,1,0] TP_PID_Bits4_0_Group4_telefax -> [0,0,0,1,1] TP_PID_Bits4_0_Voice_telephoney -> [0,0,1,0,0] TP_PID_Bits4_0_ERMES -> [0,0,1,0,1] TP_PID_Bits4_0_National_paging_system -> [0,0,1,1,0] TP_PID_Bits4_0_Videotex -> [0,0,1,1,1] TP_PID_Bits4_0_Teletex -> [0,1,0,0,0] TP_PID_Bits4_0_Teletex_in_PSPDN -> [0,1,0,0,1] TP_PID_Bits4_0_Teletex_in_CSPDN -> [0,1,0,1,0] TP_PID_Bits4_0_Teletex_in_analog_PSTN -> [0,1,0,1,1] TP_PID_Bits4_0_Teletex_in_digital_ISDN -> [0,1,1,0,0] TP_PID_Bits4_0_UCI -> [0,1,1,0,1] TP_PID_Bits4_0_Reserved1 -> [0,1,1,1,0] TP_PID_Bits4_0_Reserved2 -> [0,1,1,1,1] TP_PID_Bits4_0_Msg_handling_facility -> [1,0,0,0,0] TP_PID_Bits4_0_X400_msg_handling_system -> [1,0,0,0,1] TP_PID_Bits4_0_Internet_email -> [1,0,0,1,0] TP_PID_Bits4_0_Reserved3 -> [1,0,0,1,1] TP_PID_Bits4_0_Reserved4 -> [1,0,1,0,0] TP_PID_Bits4_0_Reserved5 -> [1,0,1,0,1] TP_PID_Bits4_0_Reserved6 -> [1,0,1,1,0] TP_PID_Bits4_0_Reserved7 -> [1,0,1,1,1] TP_PID_Bits4_0_Specific_to_SC1 -> [1,1,0,0,0] TP_PID_Bits4_0_Specific_to_SC2 -> [1,1,0,0,1] TP_PID_Bits4_0_Specific_to_SC3 -> [1,1,0,1,0] TP_PID_Bits4_0_Specific_to_SC4 -> [1,1,0,1,1] TP_PID_Bits4_0_Specific_to_SC5 -> [1,1,1,0,0] TP_PID_Bits4_0_Specific_to_SC6 -> [1,1,1,0,1] TP_PID_Bits4_0_Specific_to_SC7 -> [1,1,1,1,0] TP_PID_Bits4_0_Gsm_UMTS_mobile_station -> [1,1,1,1,1] ) encode cond = \bit4_0 -> error ("[encode] TP_PID_Bit4_0 : " ++ "cond=" ++ show cond ++ ", bit4_0=" ++ show bit4_0) decode (TP_PID_Bits7_6_00, TP_PID_Bit5_Sme_to_sme_protocol) (b4:b3:b2:b1:b0:bits) = (TP_PID_Bits4_0_STSP (bits8ToInt [0,0,0,b4,b3,b2,b1,b0]), bits) decode (TP_PID_Bits7_6_00, TP_PID_Bit5_Telematic_interworking) x = case x of (0:0:0:0:0:bits) -> (TP_PID_Bits4_0_Implicit, bits) (0:0:0:0:1:bits) -> (TP_PID_Bits4_0_Telex, bits) (0:0:0:1:0:bits) -> (TP_PID_Bits4_0_Group3_telefax, bits) (0:0:0:1:1:bits) -> (TP_PID_Bits4_0_Group4_telefax, bits) (0:0:1:0:0:bits) -> (TP_PID_Bits4_0_Voice_telephoney, bits) (0:0:1:0:1:bits) -> (TP_PID_Bits4_0_ERMES, bits) (0:0:1:1:0:bits) -> (TP_PID_Bits4_0_National_paging_system, bits) (0:0:1:1:1:bits) -> (TP_PID_Bits4_0_Videotex, bits) (0:1:0:0:0:bits) -> (TP_PID_Bits4_0_Teletex, bits) (0:1:0:0:1:bits) -> (TP_PID_Bits4_0_Teletex_in_PSPDN, bits) (0:1:0:1:0:bits) -> (TP_PID_Bits4_0_Teletex_in_CSPDN, bits) (0:1:0:1:1:bits) -> (TP_PID_Bits4_0_Teletex_in_analog_PSTN, bits) (0:1:1:0:0:bits) -> (TP_PID_Bits4_0_Teletex_in_digital_ISDN, bits) (0:1:1:0:1:bits) -> (TP_PID_Bits4_0_UCI, bits) (0:1:1:1:0:bits) -> (TP_PID_Bits4_0_Reserved1, bits) (0:1:1:1:1:bits) -> (TP_PID_Bits4_0_Reserved2, bits) (1:0:0:0:0:bits) -> (TP_PID_Bits4_0_Msg_handling_facility, bits) (1:0:0:0:1:bits) -> (TP_PID_Bits4_0_X400_msg_handling_system, bits) (1:0:0:1:0:bits) -> (TP_PID_Bits4_0_Internet_email, bits) (1:0:0:1:1:bits) -> (TP_PID_Bits4_0_Reserved3, bits) (1:0:1:0:0:bits) -> (TP_PID_Bits4_0_Reserved4, bits) (1:0:1:0:1:bits) -> (TP_PID_Bits4_0_Reserved5, bits) (1:0:1:1:0:bits) -> (TP_PID_Bits4_0_Reserved6, bits) (1:0:1:1:1:bits) -> (TP_PID_Bits4_0_Reserved7, bits) (1:1:0:0:0:bits) -> (TP_PID_Bits4_0_Specific_to_SC1, bits) (1:1:0:0:1:bits) -> (TP_PID_Bits4_0_Specific_to_SC2, bits) (1:1:0:1:0:bits) -> (TP_PID_Bits4_0_Specific_to_SC3, bits) (1:1:0:1:1:bits) -> (TP_PID_Bits4_0_Specific_to_SC4, bits) (1:1:1:0:0:bits) -> (TP_PID_Bits4_0_Specific_to_SC5, bits) (1:1:1:0:1:bits) -> (TP_PID_Bits4_0_Specific_to_SC6, bits) (1:1:1:1:0:bits) -> (TP_PID_Bits4_0_Specific_to_SC7, bits) (1:1:1:1:1:bits) -> (TP_PID_Bits4_0_Gsm_UMTS_mobile_station, bits) decode cond bits = error ("[decode] TP_PID_Bit5 : cond=" ++ show cond ++ " bits=" ++ show bits) instance Variant TP_PID_Bits4_0 where valid = oneof ( map return [ TP_PID_Bits4_0_Implicit, TP_PID_Bits4_0_Telex, TP_PID_Bits4_0_Group3_telefax, TP_PID_Bits4_0_Group4_telefax, TP_PID_Bits4_0_Voice_telephoney, TP_PID_Bits4_0_ERMES, TP_PID_Bits4_0_National_paging_system, TP_PID_Bits4_0_Videotex, TP_PID_Bits4_0_Teletex, TP_PID_Bits4_0_Teletex_in_PSPDN, TP_PID_Bits4_0_Teletex_in_CSPDN, TP_PID_Bits4_0_Teletex_in_analog_PSTN, TP_PID_Bits4_0_Teletex_in_digital_ISDN, TP_PID_Bits4_0_UCI, TP_PID_Bits4_0_Reserved1, TP_PID_Bits4_0_Reserved2, TP_PID_Bits4_0_Msg_handling_facility, TP_PID_Bits4_0_X400_msg_handling_system, TP_PID_Bits4_0_Internet_email, TP_PID_Bits4_0_Reserved3, TP_PID_Bits4_0_Reserved4, TP_PID_Bits4_0_Reserved5, TP_PID_Bits4_0_Reserved6, TP_PID_Bits4_0_Reserved7, TP_PID_Bits4_0_Specific_to_SC1, TP_PID_Bits4_0_Specific_to_SC2, TP_PID_Bits4_0_Specific_to_SC3, TP_PID_Bits4_0_Specific_to_SC4, TP_PID_Bits4_0_Specific_to_SC5, TP_PID_Bits4_0_Specific_to_SC6, TP_PID_Bits4_0_Specific_to_SC7, TP_PID_Bits4_0_Gsm_UMTS_mobile_station ] ++ [ liftM TP_PID_Bits4_0_STSP (choose (0,2^5-1)) ] ) invalid = valid -------------------------------------------------------------------------------- -- TP-Protocol-Identifier 5 to 0 bits when Bit7 and Bit6 are 01 -------------------------------------------------------------------------------- data TP_PID_Bits5_0_ = TP_PID_Bits5_0_Short_message_type0 {- 000000 -} | TP_PID_Bits5_0_Replace_short_message_type1 {- 000001 -} | TP_PID_Bits5_0_Replace_short_message_type2 {- 000010 -} | TP_PID_Bits5_0_Replace_short_message_type3 {- 000011 -} | TP_PID_Bits5_0_Replace_short_message_type4 {- 000100 -} | TP_PID_Bits5_0_Replace_short_message_type5 {- 000101 -} | TP_PID_Bits5_0_Replace_short_message_type6 {- 000110 -} | TP_PID_Bits5_0_Replace_short_message_type7 {- 000111 -} | TP_PID_Bits5_0_Reserved001000_011101 Int {- 001000 ~ 011101 -} | TP_PID_Bits5_0_Enhanced_message_service {- 011110 -} | TP_PID_Bits5_0_Return_call_message {- 011111 -} | TP_PID_Bits5_0_Reserved100000_111011 Int {- 100000 ~ 111011 -} | TP_PID_Bits5_0_Ansi_136_R_data {- 111100 -} | TP_PID_Bits5_0_ME_data_download {- 111101 -} | TP_PID_Bits5_0_ME_depersonalized_short_message {- 111110 -} | TP_PID_Bits5_0_U_SIM_data_download {- 111111 -} deriving (Show, Eq) instance BitRep TP_PID_Bits5_0_ TP_PID_Bits7_6 where encode TP_PID_Bits7_6_01 = (\x -> case x of TP_PID_Bits5_0_Short_message_type0 -> [0,0,0,0,0,0] TP_PID_Bits5_0_Replace_short_message_type1 -> [0,0,0,0,0,1] TP_PID_Bits5_0_Replace_short_message_type2 -> [0,0,0,0,1,0] TP_PID_Bits5_0_Replace_short_message_type3 -> [0,0,0,0,1,1] TP_PID_Bits5_0_Replace_short_message_type4 -> [0,0,0,1,0,0] TP_PID_Bits5_0_Replace_short_message_type5 -> [0,0,0,1,0,1] TP_PID_Bits5_0_Replace_short_message_type6 -> [0,0,0,1,1,0] TP_PID_Bits5_0_Replace_short_message_type7 -> [0,0,0,1,1,1] TP_PID_Bits5_0_Reserved001000_011101 i -> if bits8ToInt [0,0,0,0,1,0,0,0] <= i && i <= bits8ToInt [0,0,0,1,1,1,0,1] then drop 2 (intToBits8 i) else error ("[encode] TP_PID: TP_PID_Bits5_0_Reserved001000_011101 " ++ show i) TP_PID_Bits5_0_Enhanced_message_service -> [0,1,1,1,1,0] TP_PID_Bits5_0_Return_call_message -> [0,1,1,1,1,1] TP_PID_Bits5_0_Reserved100000_111011 i -> if bits8ToInt [0,0,1,0,0,0,0,0] <= i && i <= bits8ToInt [0,0,1,1,1,0,1,1] then drop 2 (intToBits8 i) else error ("[encode] TP_PID: TP_PID_Bits5_0_Reserved100000_111011 " ++ show i) TP_PID_Bits5_0_Ansi_136_R_data -> [1,1,1,1,0,0] TP_PID_Bits5_0_ME_data_download -> [1,1,1,1,0,1] TP_PID_Bits5_0_ME_depersonalized_short_message -> [1,1,1,1,1,0] TP_PID_Bits5_0_U_SIM_data_download -> [1,1,1,1,1,1] ) decode TP_PID_Bits7_6_01 = (\x -> case x of (0:0:0:0:0:0:bits) -> (TP_PID_Bits5_0_Short_message_type0, bits) (0:0:0:0:0:1:bits) -> (TP_PID_Bits5_0_Replace_short_message_type1, bits) (0:0:0:0:1:0:bits) -> (TP_PID_Bits5_0_Replace_short_message_type2, bits) (0:0:0:0:1:1:bits) -> (TP_PID_Bits5_0_Replace_short_message_type3, bits) (0:0:0:1:0:0:bits) -> (TP_PID_Bits5_0_Replace_short_message_type4, bits) (0:0:0:1:0:1:bits) -> (TP_PID_Bits5_0_Replace_short_message_type5, bits) (0:0:0:1:1:0:bits) -> (TP_PID_Bits5_0_Replace_short_message_type6, bits) (0:0:0:1:1:1:bits) -> (TP_PID_Bits5_0_Replace_short_message_type7, bits) (0:1:1:1:1:0:bits) -> (TP_PID_Bits5_0_Enhanced_message_service, bits) (0:1:1:1:1:1:bits) -> (TP_PID_Bits5_0_Return_call_message, bits) (1:1:1:1:0:0:bits) -> (TP_PID_Bits5_0_Ansi_136_R_data, bits) (1:1:1:1:0:1:bits) -> (TP_PID_Bits5_0_ME_data_download, bits) (1:1:1:1:1:0:bits) -> (TP_PID_Bits5_0_ME_depersonalized_short_message, bits) (1:1:1:1:1:1:bits) -> (TP_PID_Bits5_0_U_SIM_data_download, bits) (b5:b4:b3:b2:b1:b0:bits) -> if bits8ToInt [0,0,0,0,1,0,0,0] <= bits8ToInt ([0,0]++[b5,b4,b3,b2,b1,b0]) && bits8ToInt ([0,0]++[b5,b4,b3,b2,b1,b0]) <= bits8ToInt [0,0,0,1,1,1,0,1] then (TP_PID_Bits5_0_Reserved001000_011101 (bits8ToInt ([0,0] ++ [b5,b4,b3,b2,b1,b0])), bits) else if bits8ToInt [0,0,1,0,0,0,0,0] <= bits8ToInt ([0,0]++[b5,b4,b3,b2,b1,b0]) && bits8ToInt ([0,0]++[b5,b4,b3,b2,b1,b0]) <= bits8ToInt [0,0,1,1,1,0,1,1] then (TP_PID_Bits5_0_Reserved100000_111011 (bits8ToInt ([0,0] ++ [b5,b4,b3,b2,b1,b0])), bits) else error ("[decode] TP_PID_Bits7_6_01 : " ++ show ([b5,b4,b3,b2,b1,b0]++bits)) ) decode tp_pid_bits7_6 = \bits -> error ("[decode] : " ++ show tp_pid_bits7_6 ++ show bits) instance Variant TP_PID_Bits5_0_ where valid = oneof [ elements [ TP_PID_Bits5_0_Short_message_type0, TP_PID_Bits5_0_Replace_short_message_type1, TP_PID_Bits5_0_Replace_short_message_type2, TP_PID_Bits5_0_Replace_short_message_type3, TP_PID_Bits5_0_Replace_short_message_type4, TP_PID_Bits5_0_Replace_short_message_type5, TP_PID_Bits5_0_Replace_short_message_type6, TP_PID_Bits5_0_Replace_short_message_type7 ], liftM TP_PID_Bits5_0_Reserved001000_011101 (choose (2^3, 2^4 + 2^3 + 2^2 + 2^0)), elements [ TP_PID_Bits5_0_Enhanced_message_service, TP_PID_Bits5_0_Return_call_message ], liftM TP_PID_Bits5_0_Reserved100000_111011 (choose (2^5, 2^5 + 2^4 + 2^3 + 2^1 + 2^0)), elements [ TP_PID_Bits5_0_Ansi_136_R_data, TP_PID_Bits5_0_ME_data_download, TP_PID_Bits5_0_ME_depersonalized_short_message, TP_PID_Bits5_0_U_SIM_data_download ] ] invalid = valid -------------------------------------------------------------------------------- -- TP-Data-Coding-Scheme (TP-DCS) -------------------------------------------------------------------------------- data TP_DCS = TP_DCS_General -- 00XX Bool -- b5 Uncompressed/Compressed Bool -- b4 No message class/The message class Message_Class -- b1 b0 Character_Set -- b3 b2 | TP_DCS_ADG -- 01XX Bool -- b5 Uncompressed/Compressed Bool -- b4 No message class/The message class Message_Class -- b1 b0 Character_Set -- b3 b2 | TP_DCS_Reserved Int -- 1000XXXX ~ 1011XXXX | TP_DCS_MWIG_Discard_Msg Bool Indication_Type -- 1100 | TP_DCS_MWIG_Store_Msg_GSM7bit Bool Indication_Type -- GSM7bit | TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2 Bool Indication_Type -- UCS2 | TP_DCS_Data_Coding_Class Bool Message_Class -- GSM7bit or UCS2 deriving (Show, Eq) dcsToCharacterSet (TP_DCS_General b1 b2 msg_class cs) = cs dcsToCharacterSet (TP_DCS_ADG b1 b2 msg_class cs) = cs dcsToCharacterSet (TP_DCS_Reserved i) = error ("[dcsToCharacterSet] " ++ show (TP_DCS_Reserved i)) dcsToCharacterSet (TP_DCS_MWIG_Discard_Msg b ind_type) = GSM7Bit dcsToCharacterSet (TP_DCS_MWIG_Store_Msg_GSM7bit b ind_type) = GSM7Bit dcsToCharacterSet (TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2 b ind_type) = UCS2_16Bit dcsToCharacterSet (TP_DCS_Data_Coding_Class False msg_class) = GSM7Bit dcsToCharacterSet (TP_DCS_Data_Coding_Class True msg_class) = CS_8Bit dcsToBytesPerChar dcs = case dcsToCharacterSet dcs of GSM7Bit -> 1 CS_8Bit -> 1 UCS2_16Bit -> 2 instance BitRep TP_DCS a where encode _ (TP_DCS_General flag_compressed flag_msgclass msgclass cs) = let b5 = if flag_compressed then 1 else 0 b4 = if flag_msgclass then 1 else 0 in [0,0] ++ [b5,b4] ++ encode () cs ++ encode () msgclass encode _ (TP_DCS_ADG flag_compressed flag_msgclass msgclass cs) = let b5 = if flag_compressed then 1 else 0 b4 = if flag_msgclass then 1 else 0 in [0,1] ++ [b5,b4] ++ encode () cs ++ encode () msgclass encode _ (TP_DCS_Reserved i) | 128 <= i && i <= 128+63 = intToBits8 i | otherwise = error ("[encode] TP_DCS_Reserved " ++ show i) encode _ (TP_DCS_MWIG_Discard_Msg flag_indication indtype) = let b3 = if flag_indication then 1 else 0 in [1,1,0,0] ++ [b3] ++ [0] ++ encode () indtype encode _ (TP_DCS_MWIG_Store_Msg_GSM7bit flag_indication indtype) = let b3 = if flag_indication then 1 else 0 in [1,1,0,1] ++ [b3] ++ [0] ++ encode () indtype encode _ (TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2 flag_indication indtype) = let b3 = if flag_indication then 1 else 0 in [1,1,1,0] ++ [b3] ++ [0] ++ encode () indtype encode _ (TP_DCS_Data_Coding_Class flag_cs msgclass) = let b2 = if flag_cs then 1 else 0 in [1,1,1,1] ++ [0] ++ [b2] ++ encode () msgclass decode _ (0:0:b5:b4:bits) = let (cs, bits1) = decode () bits (msg_class, bits2) = decode () bits1 in (TP_DCS_General (b5==1) (b4==1) msg_class cs, bits2) decode _ (0:1:b5:b4:bits) = let (cs, bits1) = decode () bits (msg_class, bits2) = decode () bits1 in (TP_DCS_ADG (b5==1) (b4==1) msg_class cs, bits2) decode _ (1:0:b5:b4:b3:b2:b1:b0:bits) = (TP_DCS_Reserved (bits8ToInt [0,0,b5,b4,b3,b2,b1,b0]), bits) decode _ (1:1:0:0:b3:b2:bits) | b2 == 0 = let (ind_type, bits') = decode () bits in (TP_DCS_MWIG_Discard_Msg (b3==1) ind_type, bits') | otherwise = error ("[decode] TP_DCS_MWIG_Discard : " ++ show (1:1:0:0:b3:b2:bits)) decode _ (1:1:0:1:b3:b2:bits) | b2 == 0 = let (ind_type, bits') = decode () bits in (TP_DCS_MWIG_Store_Msg_GSM7bit (b3==1) ind_type, bits') | otherwise = error ("[decode] TP_DCS_MWIG_Store_Msg_GSM7bit : " ++ show (1:1:0:1:b3:b2:bits)) decode _ (1:1:1:0:b3:b2:bits) | b2 == 0 = let (ind_type, bits') = decode () bits in (TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2 (b3==1) ind_type, bits') | otherwise = error ("[decode] (TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2)" ++ show (1:1:1:0:b3:b2:bits)) decode _ (1:1:1:1:0:b2:bits) = let (msg_class, bits') = decode () bits in (TP_DCS_Data_Coding_Class (b2==1) msg_class, bits') decode _ bits = error ("[decode] TP_DCS : " ++ show bits) instance Variant TP_DCS where valid = oneof [ liftM4 TP_DCS_General valid valid valid valid, liftM4 TP_DCS_ADG valid valid valid valid, -- TBD -- liftM TP_DCS_Reserved (choose (2^7, 2^7+2^5+2^4+2^3+2^2+2^1+2^0)), liftM2 TP_DCS_MWIG_Discard_Msg valid valid, liftM2 TP_DCS_MWIG_Store_Msg_GSM7bit valid valid, liftM2 TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2 valid valid, liftM2 TP_DCS_Data_Coding_Class valid valid ] invalid = valid -------------------------------------------------------------------------------- -- Message Class -------------------------------------------------------------------------------- data Message_Class = Class0 | Class1 | Class2 | Class3 deriving (Show, Eq) instance BitRep Message_Class a where encode _ Class0 = [0,0] encode _ Class1 = [0,1] encode _ Class2 = [1,0] encode _ Class3 = [1,1] decode _ (0:0:bits) = (Class0, bits) decode _ (0:1:bits) = (Class1, bits) decode _ (1:0:bits) = (Class2, bits) decode _ (1:1:bits) = (Class3, bits) instance Variant Message_Class where valid = elements [ Class0, Class1, Class2, Class3 ] invalid = valid -------------------------------------------------------------------------------- -- Character Set -------------------------------------------------------------------------------- data Character_Set = GSM7Bit | CS_8Bit | UCS2_16Bit | CS_Reserved deriving (Show, Eq) instance BitRep Character_Set a where encode _ GSM7Bit = [0,0] encode _ CS_8Bit = [0,1] encode _ UCS2_16Bit = [1,0] encode _ CS_Reserved = [1,1] decode _ (0:0:bits) = (GSM7Bit, bits) decode _ (0:1:bits) = (CS_8Bit, bits) decode _ (1:0:bits) = (UCS2_16Bit, bits) decode _ (1:1:bits) = (CS_Reserved, bits) instance Variant Character_Set where valid = elements [ GSM7Bit, CS_8Bit, UCS2_16Bit {- TBD , CS_Reserved -} ] invalid = valid -------------------------------------------------------------------------------- -- Indication Type -------------------------------------------------------------------------------- data Indication_Type = VoicemailMsgWaiting | FaxMsgWaiting | EMailMsgWaiting | OtherMsgWaiting deriving (Show, Eq) instance BitRep Indication_Type a where encode _ VoicemailMsgWaiting = [0,0] encode _ FaxMsgWaiting = [0,1] encode _ EMailMsgWaiting = [1,0] encode _ OtherMsgWaiting = [1,1] decode _ (0:0:bits) = (VoicemailMsgWaiting, bits) decode _ (0:1:bits) = (FaxMsgWaiting, bits) decode _ (1:0:bits) = (EMailMsgWaiting, bits) decode _ (1:1:bits) = (OtherMsgWaiting, bits) instance Variant Indication_Type where valid = elements [ VoicemailMsgWaiting, FaxMsgWaiting, EMailMsgWaiting, OtherMsgWaiting ] invalid = valid -------------------------------------------------------------------------------- -- Service Center Timestamp -------------------------------------------------------------------------------- data TP_SCTS = TP_SCTS Int Int Int -- Year : 0 ~ 99 -- Month : 1 ~ 12 -- Day : 1 ~ 31 Int Int Int -- Hour : 0 ~ 23 -- Minute : 0 ~59 -- Second : 0 ~ 59 Int -- Time Zone : -48 ~ 48 deriving (Show, Eq) {- Absolute time definition example 23rd December 01, 9:53:42 AM, GMT +1 hour Year : 0001 0000 0x10 Month : 0010 0001 0x21 Day : 0011 0010 0x32 Hour : 1001 0000 0x90 Minute : 0011 0101 0x35 Second : 0010 0100 0x24 Time Zone : 0100 0 000 0x40 -} instance BitRep TP_SCTS a where encode _ (TP_SCTS year month day hour minute second time_zone) = sctsToBit (year, month, day, hour, minute, second, time_zone) decode _ bits = (TP_SCTS year month day hour minute second time_zone, bits') where ((year, month, day, hour, minute, second, time_zone), bits') = sctsToCon bits sctsToBit (year, month, day, hour, minute, second, time_zone) | (0 <= year && year <= 99 && 1 <= month && month <= 12 && 1 <= day && day <= 31 && 0 <= hour && hour <= 23 && 0 <= minute && minute <= 59 && 0 <= second && second <= 59 && -48 <= time_zone && time_zone <= 48) = let { y1 = year `div` 10; y2 = year `mod` 10; mo1 = month `div` 10; mo2 = month `mod` 10; d1 = day `div` 10; d2 = day `mod` 10; h1 = hour `div` 10; h2 = hour `mod` 10; m1 = minute `div` 10; m2 = minute `mod` 10; s1 = second `div` 10; s2 = second `mod` 10; t1 = (if time_zone > 0 then time_zone else -time_zone) `div` 10; t2 = (if time_zone > 0 then time_zone else -time_zone) `mod` 10; signbit = if time_zone > 0 then 0 else 1 } in intToBits8 (y2 * 16 + y1) ++ intToBits8 (mo2 * 16 + mo1) ++ intToBits8 (d2 * 16 + d1) ++ intToBits8 (h2 * 16 + h1) ++ intToBits8 (m2 * 16 + m1) ++ intToBits8 (s2 * 16 + s1) ++ intToBits4 t2 ++ [signbit] ++ drop 1 (intToBits4 t1) | otherwise = error ("[sctsToBit] : " ++ show [year, month, day, hour, minute, second, time_zone]) sctsToCon bits | length bits >= 7*8 = let { y1 = bits4ToInt (take 4 bits); y2 = bits4ToInt (drop 4 (take 8 bits)); year = y2 * 10 + y1; mo1 = bits4ToInt (take 4 (drop 8 bits)); mo2 = bits4ToInt (drop 4 (take 8 (drop 8 bits))); month = mo2 * 10 + mo1; d1 = bits4ToInt (take 4 (drop 16 bits)); d2 = bits4ToInt (drop 4 (take 8 (drop 16 bits))); day = d2 * 10 + d1; h1 = bits4ToInt (take 4 (drop 24 bits)); h2 = bits4ToInt (drop 4 (take 8 (drop 24 bits))); hour = h2 * 10 + h1; m1 = bits4ToInt (take 4 (drop 32 bits)); m2 = bits4ToInt (drop 4 (take 8 (drop 32 bits))); minute = m2 * 10 + m1; s1 = bits4ToInt (take 4 (drop 40 bits)); s2 = bits4ToInt (drop 4 (take 8 (drop 40 bits))); second = s2 * 10 + s1; tz1 = bits4ToInt (take 4 (drop 48 bits)); (sign:tz2bits) = drop 4 (take 8 (drop 48 bits)); tz2 = bits4ToInt (0:tz2bits); time_zone = (if sign==0 then 1 else -1) * (tz2 * 10 + tz1); } in (if 0 <= year && year <= 99 && 1 <= month && month <= 12 && 1 <= day && day <= 31 && 0 <= hour && hour <= 23 && 0 <= minute && minute <= 59 && 0 <= second && second <= 59 && -48 <= time_zone && time_zone <= 48 then ((year, month, day, hour, minute, second, time_zone), drop 56 bits) else error ("[sctsToCon] : " ++ show (year, month, day, hour, minute, second, time_zone) ++ ", " ++ show (drop 56 bits)) ) | otherwise = error ("[sctsToCon] : " ++ show bits ++ ", (length) : " ++ show (length bits)) instance Variant TP_SCTS where valid = do year <- choose (0,99) month <- choose (1,12) day <- choose (1,31) hour <- choose (0,23) minute <- choose (0,59) second <- choose (0,59) timezone <- choose (-48,48) return (TP_SCTS year month day hour minute second timezone) invalid = valid -------------------------------------------------------------------------------- -- TP_Validity-Period (TP-VP) -------------------------------------------------------------------------------- data TP_VP = TP_VP_Relative Int | TP_VP_Absolute Int Int Int Int Int Int Int | TP_VP_Enhanced TP_VP_Enhanced {- Where does this come from? | TP_VP_Reserved -} deriving (Show, Eq) isTP_VP_Relative (TP_VP_Relative _) = True isTP_VP_Relative _ = False isTP_VP_Absolute (TP_VP_Absolute _ _ _ _ _ _ _) = True isTP_VP_Absolute _ = False isTP_VP_Enhanced (TP_VP_Enhanced _) = True isTP_VP_Enhanced _ = False -- isTP_VP_Reserved TP_VP_Reserved = True -- isTP_VP_Reserved _ = False instance BitRep TP_VP TP_VPF where encode TP_VP_Field_Present_Relative (TP_VP_Relative i) = if 0 <= i && i <= 143 then intToBits8 i else if 144 <= i && i <= 167 then intToBits8 i else if 168 <= i && i <= 196 then intToBits8 i else if 197 <= i && i <= 255 then intToBits8 i else error ("[encode] TP_VP_Field_Present_Relative :" ++ show i) encode TP_VP_Field_Present_Absolute (TP_VP_Absolute i1 i2 i3 i4 i5 i6 i7) = sctsToBit (i1,i2,i3,i4,i5,i6,i7) encode TP_VP_Field_Present_Enhanced (TP_VP_Enhanced tp_vp_enhanced) = encode () tp_vp_enhanced encode tp_vpf tp_vp = error ("[encode] TP_VP : tp_vpf="++ show tp_vpf ++ ", tp_vp=" ++ show tp_vp) decode TP_VP_Field_Present_Relative (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_VP_Relative (bits8ToInt (b7:b6:b5:b4:b3:b2:b1:b0:[])), bits) decode TP_VP_Field_Present_Absolute bits = let ((year, month, day, hour, minute, second, time_zone),bits') = sctsToCon bits in (TP_VP_Absolute year month day hour minute second time_zone, bits') decode TP_VP_Field_Present_Enhanced bits = let (tp_vp_enhanced, bits') = decode () bits in (TP_VP_Enhanced tp_vp_enhanced, bits') decode tp_vpf bits = error ("[decode] TP_VP : tp_vpf=" ++ show tp_vpf ++ ", bits=" ++ show bits) getRelativeValidityPeriod i = if 0 <= i && i <= 143 then (i + 1) * 5 -- Minutes else if 144 <= i && i <= 167 then 12 * 60 + (i - 143) * 30 -- Minutes else if 168 <= i && i <= 196 then (i - 166) * 24 * 60 -- Minutes else if 197 <= i && i <= 255 then (i - 192) * 24 * 7 * 60 -- Minutes else error ("[getRelativeValidityPeriod] " ++ show i) instance Variant TP_VP where valid = let tp_vp_relative = do i <- choose (0,255) return (TP_VP_Relative i) tp_vp_absolute = do year <- choose (0,99) month <- choose (1,12) day <- choose (1,31) hour <- choose (0,23) minute <- choose (0,59) second <- choose (0,59) time_zone <- choose (-48,48) return (TP_VP_Absolute year month day hour minute second time_zone) tp_vp_enhanced = liftM TP_VP_Enhanced valid -- tp_vp_reserved = elements [ TP_VP_Reserved ] in oneof [ tp_vp_relative, tp_vp_absolute, tp_vp_enhanced {- TBD , tp_vp_reserved -} ] invalid = valid -------------------------------------------------------------------------------- -- TP_Validity-Period Enhanced -------------------------------------------------------------------------------- data TP_VP_Enhanced = TP_VP_Enhanced_No_Validity_Period Bool {- XXXXX000 0 Octet -} | TP_VP_Enhanced_Relative_Period Bool Int {- XXXXX001 1 Octet -} | TP_VP_Enhanced_Relative_Period_Integer Bool Int {- XXXXX010 2 Octet -} | TP_VP_Enhanced_Relative_Period_HMS Bool Int Int Int {- XXXXX011 3 Octets -} | TP_VP_Enhanced_Reserved Int deriving (Show, Eq) instance BitRep TP_VP_Enhanced a where encode _ (TP_VP_Enhanced_No_Validity_Period singleshotsm) {- No extension bit -} = [0,b6,0,0,0,0,0,0] where b6 = if singleshotsm then 1 else 0 encode _ (TP_VP_Enhanced_Relative_Period singleshotsm i) {- Extension bit -} = [1,b6,0,0,0,0,0,1] ++ encode TP_VP_Field_Present_Relative (TP_VP_Relative i) where b6 = if singleshotsm then 1 else 0 encode _ (TP_VP_Enhanced_Relative_Period_Integer singleshotsm i) {- Extension bit -} = [1,b6,0,0,0,0,1,0] ++ intToBits8 i where b6 = if singleshotsm then 1 else 0 encode _ (TP_VP_Enhanced_Relative_Period_HMS singleshotsm i1 i2 i3) = [1,b6,0,0,0,0,1,1] ++ drop 4 (intToBits8 (i1 `div` 10)) ++ drop 4 (intToBits8 (i1 `mod` 10)) ++ drop 4 (intToBits8 (i2 `div` 10)) ++ drop 4 (intToBits8 (i2 `mod` 10)) ++ drop 4 (intToBits8 (i3 `div` 10)) ++ drop 4 (intToBits8 (i3 `mod` 10)) where b6 = if singleshotsm then 1 else 0 encode _ (TP_VP_Enhanced_Reserved i) = case intToBits8 i of [b7,b6,b5,b4,b3,b2,b1,b0] -> if b7 == 0 && 4 <= bits8ToInt [0,0,0,0,0,b2,b1,b0] && bits8ToInt [0,0,0,0,0,b2,b1,b0] <= 7 then [b7,b6,b5,b4,b3,b2,b1,b0] else error ("[encode] TP_VP_Enhanced_Reserved " ++ show i) _ -> error ("[encode] TP_VP_Enhanced_Reserved " ++ show i) decode _ (0:b:0:0:0:0:0:0:bits) = (TP_VP_Enhanced_No_Validity_Period singleshotsm, bits) where singleshotsm = if b==1 then True else False decode _ (1:b:0:0:0:0:0:1:b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_VP_Enhanced_Relative_Period singleshotsm (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) where singleshotsm = if b==1 then True else False decode _ (1:b:0:0:0:0:1:0:b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_VP_Enhanced_Relative_Period_Integer singleshotsm (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) where singleshotsm = if b==1 then True else False decode _ (1:b:0:0:0:0:1:1:b7:b6:b5:b4:b3:b2:b1:b0:b7':b6':b5':b4':b3':b2':b1':b0':b7'':b6'':b5'':b4'':b3'':b2'':b1'':b0'':bits) = (TP_VP_Enhanced_Relative_Period_HMS singleshotsm (bits8ToInt [0,0,0,0,b7,b6,b5,b4] * 10 + bits8ToInt[0,0,0,0,b3,b2,b1,b0]) (bits8ToInt [0,0,0,0,b7',b6',b5',b4'] * 10 + bits8ToInt[0,0,0,0,b3',b2',b1',b0']) (bits8ToInt [0,0,0,0,b7'',b6'',b5'',b4''] * 10 + bits8ToInt[0,0,0,0,b3'',b2'',b1'',b0'']), bits) where singleshotsm = if b==1 then True else False decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) | b7==0 && 4 <= bits8ToInt [0,0,0,0,0,b2,b1,b0] && bits8ToInt [0,0,0,0,0,b2,b1,b0] <= 7 = (TP_VP_Enhanced_Reserved (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) | otherwise = error ("[decode] TP_VP_Enhanced_... : " ++ show (b7:b6:b5:b4:b3:b2:b1:b0:bits)) decode _ bits = error ("[decode] TP_VP_Enhanced_... : " ++ show bits) instance Variant TP_VP_Enhanced where valid = let tp_vp_enhanced1 = liftM TP_VP_Enhanced_No_Validity_Period valid tp_vp_enhanced2 = do i <- choose (0,255) b <- valid return (TP_VP_Enhanced_Relative_Period b i) tp_vp_enhanced3 = do i <- choose (0,255) b <- valid return (TP_VP_Enhanced_Relative_Period_Integer b i) tp_vp_enhanced4 = do i1 <- choose (0,99) i2 <- choose (0,99) i3 <- choose (0,99) b <- valid return (TP_VP_Enhanced_Relative_Period_HMS b i1 i2 i3) -- tp_vp_enhanced5 = -- do i <- choose (0,255) -- return (TP_VP_Enhanced_Reserved i) in oneof [ tp_vp_enhanced1, tp_vp_enhanced2, tp_vp_enhanced3, tp_vp_enhanced4 {- TBD , tp_vp_enhanced5 -} ] invalid = valid -------------------------------------------------------------------------------- -- TP-Discharge-Time (TP-DT) -------------------------------------------------------------------------------- data TP_DT = TP_DT Int Int Int Int Int Int Int deriving (Show, Eq) instance BitRep TP_DT () where encode _ (TP_DT i1 i2 i3 i4 i5 i6 i7) = sctsToBit (i1,i2,i3,i4,i5,i6,i7) decode _ bits = (TP_DT year month day hour minute second time_zone, bits') where ((year, month, day, hour, minute, second, time_zone), bits') = sctsToCon bits instance Variant TP_DT where valid = do year <- choose (0,99) month <- choose (1,12) day <- choose (1,31) hour <- choose (0,23) minute <- choose (0,59) second <- choose (0,59) time_zone <- choose (-48,48) return (TP_DT year month day hour minute second time_zone) invalid = valid -------------------------------------------------------------------------------- -- TP-Recipient-Address (TP-RA) -------------------------------------------------------------------------------- data TP_RA = TP_RA AddrFields deriving (Show, Eq) instance BitRep TP_RA () where encode _ (TP_RA addrfields) = encode () addrfields decode _ bits = let (ra, bits') = decode () bits in (TP_RA ra, bits') instance Variant TP_RA where valid = liftM TP_RA valid invalid = valid -------------------------------------------------------------------------------- -- TP_Stauts (TP-ST) -------------------------------------------------------------------------------- data TP_ST = TP_ST_Short_msg_received_by_the_SME -- 00000000 | TP_ST_Short_msg_failed_to_confirm_delivery -- 00000001 | TP_ST_Short_msg_replaced_by_the_SC -- 00000010 | TP_ST_Short_msg_transaction_complted_Reserved Int -- 00000011 ~ 00001111 {- Temporary error, SC still trying to transfer SM -} | TP_ST_Temporary_error_Congestion -- 00100000 | TP_ST_Temporary_error_SME_busy -- 00100001 | TP_ST_Temporary_error_No_response_from_SME -- 00100010 | TP_ST_Temporary_error_Service_rejected -- 00100011 | TP_ST_Temporary_error_Quality_of_service_unavailable -- 00100100 | TP_ST_Temporary_error_Error_in_SME -- 00100101 | TP_ST_Temporary_error_Reserved Int -- 00100110 ~ 00101111 | TP_ST_Temporary_error_Values_specific_to_SC Int -- 00110000 ~ 00111111 | TP_ST_Permanent_error_Remote_procedure_error -- 01000000 | TP_ST_Permanent_error_Incompatible_destination -- 01000001 | TP_ST_Permanent_error_Connection_rejected_by_SME -- 01000010 | TP_ST_Permanent_error_Not_obtaineable -- 01000011 | TP_ST_Permanent_error_Quality_of_service_unavailable -- 01000100 | TP_ST_Permanent_error_No_interworking_available -- 01000101 | TP_ST_Permanent_error_SM_validity_peirod_expired -- 01000110 | TP_ST_Permanent_error_SM_deleted_by_originating_SME -- 01000111 | TP_ST_Permanent_error_SM_deleted_by_SC_administration -- 01001000 | TP_ST_Permanent_error_SM_not_present -- 01001001 | TP_ST_Permanent_error_Reserved Int -- 01001010 ~ 01001111 | TP_ST_Permanent_error_Values_specific_to_SC Int -- 01010000 ~ 01011111 {- Temporary error, SC is not making any more trnasfer attempts -} | TP_ST_Temporary_failure_Congenstion -- 01100000 | TP_ST_Temporary_failure_SME_busy -- 01100001 | TP_ST_Temporary_failure_No_response_from_SME -- 01100010 | TP_ST_Temporary_failure_Service_rejected -- 01100011 | TP_ST_Temporary_failure_Quality_of_service_unavailable -- 01100100 | TP_ST_Temporary_failure_Error_in_SME -- 01100101 | TP_ST_Temporary_failure_Reserved1 Int -- 01100110 ~ 01101001 | TP_ST_Temporary_failure_Reserved2 Int -- 01101010 ~ 01101111 | TP_ST_Temporary_failure_Values_specific_to_SC Int -- 01110000 ~ 01111111 | TP_ST_Reserved Int -- 1XXXXXXX deriving (Show, Eq) instance BitRep TP_ST a where encode _ TP_ST_Short_msg_received_by_the_SME = [0,0,0,0,0,0,0,0] encode _ TP_ST_Short_msg_failed_to_confirm_delivery = [0,0,0,0,0,0,0,1] encode _ TP_ST_Short_msg_replaced_by_the_SC = [0,0,0,0,0,0,1,0] encode _ (TP_ST_Short_msg_transaction_complted_Reserved i) -- 0000 0011 ~ 0000 1111 | 3 <= i && i <= 15 = [0,0,0,0] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Short_msg_transaction_completed_Reserved " ++ show i) encode _ TP_ST_Temporary_error_Congestion = [0,0,1,0,0,0,0,0] encode _ TP_ST_Temporary_error_SME_busy = [0,0,1,0,0,0,0,1] encode _ TP_ST_Temporary_error_No_response_from_SME = [0,0,1,0,0,0,1,0] encode _ TP_ST_Temporary_error_Service_rejected = [0,0,1,0,0,0,1,1] encode _ TP_ST_Temporary_error_Quality_of_service_unavailable = [0,0,1,0,0,1,0,0] encode _ TP_ST_Temporary_error_Error_in_SME = [0,0,1,0,0,1,0,1] encode _ (TP_ST_Temporary_error_Reserved i) -- 0010 0110 ~ 0010 1111 | 6 <= i && i <= 15 = [0,0,1,0] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Temporary_error_Reserved " ++ show i) encode _ (TP_ST_Temporary_error_Values_specific_to_SC i) -- 0011 0000 ~ 0011 1111 | 0 <= i && i <= 15 = [0,0,1,1] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Temporary_error_Values_specific_to_SC " ++ show i) encode _ TP_ST_Permanent_error_Remote_procedure_error = [0,1,0,0,0,0,0,0] encode _ TP_ST_Permanent_error_Incompatible_destination = [0,1,0,0,0,0,0,1] encode _ TP_ST_Permanent_error_Connection_rejected_by_SME = [0,1,0,0,0,0,1,0] encode _ TP_ST_Permanent_error_Not_obtaineable = [0,1,0,0,0,0,1,1] encode _ TP_ST_Permanent_error_Quality_of_service_unavailable = [0,1,0,0,0,1,0,0] encode _ TP_ST_Permanent_error_No_interworking_available = [0,1,0,0,0,1,0,1] encode _ TP_ST_Permanent_error_SM_validity_peirod_expired = [0,1,0,0,0,1,1,0] encode _ TP_ST_Permanent_error_SM_deleted_by_originating_SME = [0,1,0,0,0,1,1,1] encode _ TP_ST_Permanent_error_SM_deleted_by_SC_administration = [0,1,0,0,1,0,0,0] encode _ TP_ST_Permanent_error_SM_not_present = [0,1,0,0,1,0,0,1] encode _ (TP_ST_Permanent_error_Reserved i) -- 0100 1010 ~ 0100 1111 | 10 <= i && i <= 15 = [0,1,0,0] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Permanent_error_Reserved " ++ show i) encode _ (TP_ST_Permanent_error_Values_specific_to_SC i) -- 0101 0000 ~ 0101 1111 | 0 <= i && i <= 15 = [0,1,0,1] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Permanent_error_Values_specific_to_SC " ++ show i) encode _ TP_ST_Temporary_failure_Congenstion = [0,1,1,0,0,0,0,0] encode _ TP_ST_Temporary_failure_SME_busy = [0,1,1,0,0,0,0,1] encode _ TP_ST_Temporary_failure_No_response_from_SME = [0,1,1,0,0,0,1,0] encode _ TP_ST_Temporary_failure_Service_rejected = [0,1,1,0,0,0,1,1] encode _ TP_ST_Temporary_failure_Quality_of_service_unavailable = [0,1,1,0,0,1,0,0] encode _ TP_ST_Temporary_failure_Error_in_SME = [0,1,1,0,0,1,0,1] encode _ (TP_ST_Temporary_failure_Reserved1 i) -- 0110 0110 ~ 0110 1001 | 6 <= i && i <= 9 = [0,1,1,0] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Temporary_failure_Reserved1 " ++ show i) encode _ (TP_ST_Temporary_failure_Reserved2 i) -- 0110 1010 ~ 0110 1111 | 10 <= i && i <= 15 = [0,1,1,0] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Temporary_failure_Reserved2 " ++ show i) encode _ (TP_ST_Temporary_failure_Values_specific_to_SC i) -- 0111 0000 ~ 0111 1111 | 0 <= i && i <= 15 = [0,1,1,1] ++ intToBits4 i | otherwise = error ("[encode] TP_ST_Temporary_failure_Values_specific_to_SC " ++ show i) encode _ (TP_ST_Reserved i) -- 1XXXXXXX | 0 <= i && i <= 127 = [1] ++ drop 1 (intToBits8 i) | otherwise = error ("[encode] TP_ST_Reserved " ++ show i) decode _ (0:0:0:0:0:0:0:0:bits) = (TP_ST_Short_msg_received_by_the_SME, bits) decode _ (0:0:0:0:0:0:0:1:bits) = (TP_ST_Short_msg_failed_to_confirm_delivery, bits) decode _ (0:0:0:0:0:0:1:0:bits) = (TP_ST_Short_msg_replaced_by_the_SC, bits) decode _ (0:0:0:0:b3:b2:b1:b0:bits) -- 0000 0011 ~ 0000 1111 = (TP_ST_Short_msg_transaction_complted_Reserved (bits4ToInt [b3,b2,b1,b0]), bits) decode _ (0:0:1:0:0:0:0:0:bits) = (TP_ST_Temporary_error_Congestion, bits) decode _ (0:0:1:0:0:0:0:1:bits) = (TP_ST_Temporary_error_SME_busy, bits) decode _ (0:0:1:0:0:0:1:0:bits) = (TP_ST_Temporary_error_No_response_from_SME, bits) decode _ (0:0:1:0:0:0:1:1:bits) = (TP_ST_Temporary_error_Service_rejected, bits) decode _ (0:0:1:0:0:1:0:0:bits) = (TP_ST_Temporary_error_Quality_of_service_unavailable, bits) decode _ (0:0:1:0:0:1:0:1:bits) = (TP_ST_Temporary_error_Error_in_SME, bits) decode _ (0:0:1:0:b3:b2:b1:b0:bits) -- 0010 0110 ~ 0010 1111 | 6 <= (bits4ToInt [b3,b2,b1,b0]) && (bits4ToInt [b3,b2,b1,b0]) <= 15 = (TP_ST_Temporary_error_Reserved (bits4ToInt [b3,b2,b1,b0]), bits) | otherwise = error ("[decode] TP_ST_Temporary_error_Reserved " ++ show [b3,b2,b1,b0]) decode _ (0:0:1:1:b3:b2:b1:b0:bits) -- 0011 0000 ~ 0011 1111 = (TP_ST_Temporary_error_Values_specific_to_SC (bits4ToInt [b3,b2,b1,b0]), bits) decode _ (0:1:0:0:0:0:0:0:bits) = (TP_ST_Permanent_error_Remote_procedure_error, bits) decode _ (0:1:0:0:0:0:0:1:bits) = (TP_ST_Permanent_error_Incompatible_destination, bits) decode _ (0:1:0:0:0:0:1:0:bits) = (TP_ST_Permanent_error_Connection_rejected_by_SME, bits) decode _ (0:1:0:0:0:0:1:1:bits) = (TP_ST_Permanent_error_Not_obtaineable, bits) decode _ (0:1:0:0:0:1:0:0:bits) = (TP_ST_Permanent_error_Quality_of_service_unavailable, bits) decode _ (0:1:0:0:0:1:0:1:bits) = (TP_ST_Permanent_error_No_interworking_available, bits) decode _ (0:1:0:0:0:1:1:0:bits) = (TP_ST_Permanent_error_SM_validity_peirod_expired, bits) decode _ (0:1:0:0:0:1:1:1:bits) = (TP_ST_Permanent_error_SM_deleted_by_originating_SME, bits) decode _ (0:1:0:0:1:0:0:0:bits) = (TP_ST_Permanent_error_SM_deleted_by_SC_administration, bits) decode _ (0:1:0:0:1:0:0:1:bits) = (TP_ST_Permanent_error_SM_not_present, bits) decode _ (0:1:0:0:b3:b2:b1:b0:bits) -- 0100 1010 ~ 0100 1111 | 10 <= (bits4ToInt [b3,b2,b1,b0]) && (bits4ToInt [b3,b2,b1,b0]) <= 15 = (TP_ST_Permanent_error_Reserved (bits4ToInt [b3,b2,b1,b0]), bits) | otherwise = error ("[decode] TP_ST_Permanent_error_Reserved " ++ show [b3,b2,b1,b0]) decode _ (0:1:0:1:b3:b2:b1:b0:bits) -- 0101 0000 ~ 0101 1111 = (TP_ST_Permanent_error_Values_specific_to_SC (bits4ToInt [b3,b2,b1,b0]), bits) decode _ (0:1:1:0:0:0:0:0:bits) = (TP_ST_Temporary_failure_Congenstion, bits) decode _ (0:1:1:0:0:0:0:1:bits) = (TP_ST_Temporary_failure_SME_busy, bits) decode _ (0:1:1:0:0:0:1:0:bits) = (TP_ST_Temporary_failure_No_response_from_SME, bits) decode _ (0:1:1:0:0:0:1:1:bits) = (TP_ST_Temporary_failure_Service_rejected, bits) decode _ (0:1:1:0:0:1:0:0:bits) = (TP_ST_Temporary_failure_Quality_of_service_unavailable, bits) decode _ (0:1:1:0:0:1:0:1:bits) = (TP_ST_Temporary_failure_Error_in_SME, bits) decode _ (0:1:1:0:b3:b2:b1:b0:bits) -- 0110 0110 ~ 0110 1001 | 6 <= bits4ToInt [b3,b2,b1,b0] && bits4ToInt [b3,b2,b1,b0] <= 9 = (TP_ST_Temporary_failure_Reserved1 (bits4ToInt [b3,b2,b1,b0]), bits) | 10 <= bits4ToInt [b3,b2,b1,b0] && bits4ToInt [b3,b2,b1,b0] <= 15 = (TP_ST_Temporary_failure_Reserved2 (bits4ToInt [b3,b2,b1,b0]), bits) | otherwise = error ("[decode] TP_ST_Temporary_failure_Reserved1,2 " ++ show (bits4ToInt [b3,b2,b1,b0])) decode _ (0:1:1:1:b3:b2:b1:b0:bits) -- 0111 0000 ~ 0111 1111 = (TP_ST_Temporary_failure_Values_specific_to_SC (bits4ToInt [b3,b2,b1,b0]), bits) decode _ (1:b6:b5:b4:b3:b2:b1:b0:bits) -- 1XXXXXXX = (TP_ST_Reserved (bits8ToInt [0,b6,b5,b4,b3,b2,b1,b0]), bits) instance Variant TP_ST where valid = oneof [ elements [ TP_ST_Short_msg_received_by_the_SME, TP_ST_Short_msg_failed_to_confirm_delivery, TP_ST_Short_msg_replaced_by_the_SC ], -- 0000 0011 ~ 0000 1111 liftM TP_ST_Short_msg_transaction_complted_Reserved (choose (3,15)), elements [ TP_ST_Temporary_error_Congestion, TP_ST_Temporary_error_SME_busy, TP_ST_Temporary_error_No_response_from_SME, TP_ST_Temporary_error_Service_rejected, TP_ST_Temporary_error_Quality_of_service_unavailable, TP_ST_Temporary_error_Error_in_SME ], -- 0010 0110 ~ 0010 1111 liftM TP_ST_Temporary_error_Reserved (choose (2^2+2^1, 2^3+2^2+2^1+2^0)), -- 0011 0000 ~ 0011 1111 liftM TP_ST_Temporary_error_Values_specific_to_SC (choose (0, 2^3+2^2+2^1+2^0)), elements [ TP_ST_Permanent_error_Remote_procedure_error, TP_ST_Permanent_error_Incompatible_destination, TP_ST_Permanent_error_Connection_rejected_by_SME, TP_ST_Permanent_error_Not_obtaineable, TP_ST_Permanent_error_Quality_of_service_unavailable, TP_ST_Permanent_error_No_interworking_available, TP_ST_Permanent_error_SM_validity_peirod_expired, TP_ST_Permanent_error_SM_deleted_by_originating_SME, TP_ST_Permanent_error_SM_deleted_by_SC_administration, TP_ST_Permanent_error_SM_not_present ], -- 0100 1010 ~ 0100 1111 liftM TP_ST_Permanent_error_Reserved (choose (2^3+2^1, 2^3+2^2+2^1+2^0)), -- 0101 0000 ~ 0101 1111 liftM TP_ST_Permanent_error_Values_specific_to_SC (choose (0, 2^3+2^2+2^1+2^0)), elements [ TP_ST_Temporary_failure_Congenstion, TP_ST_Temporary_failure_SME_busy, TP_ST_Temporary_failure_No_response_from_SME, TP_ST_Temporary_failure_Service_rejected, TP_ST_Temporary_failure_Quality_of_service_unavailable, TP_ST_Temporary_failure_Error_in_SME ], -- 0110 0110 ~ 0110 1001 liftM TP_ST_Temporary_failure_Reserved1 (choose (2^2+2^1, 2^3+2^0)), -- 0110 1010 ~ 0110 1111 liftM TP_ST_Temporary_failure_Reserved2 (choose (2^3+2^1, 2^3+2^2+2^1+2^0)), -- 0111 0000 ~ 0111 1111 liftM TP_ST_Temporary_failure_Values_specific_to_SC (choose (0, 2^3+2^2+2^1+2^0)), -- 1XXXXXXX liftM TP_ST_Reserved (choose (0, 2^7-1)) ] invalid = valid -------------------------------------------------------------------------------- -- TP-Reply-Path (TP-RP) -------------------------------------------------------------------------------- data TP_RP = TP_RP Bool deriving (Show, Eq) instance BitRep TP_RP a where encode _ (TP_RP False) = [0] encode _ (TP_RP True) = [1] decode _ (0:bits) = (TP_RP False, bits) decode _ (1:bits) = (TP_RP True, bits) instance Variant TP_RP where valid = liftM TP_RP valid invalid = valid -------------------------------------------------------------------------------- -- TP-Message-Number (TP-MN) -------------------------------------------------------------------------------- data TP_MN = TP_MN Int deriving (Show, Eq) instance BitRep TP_MN a where encode _ (TP_MN i) | 0<=i && i<=255 = intToBits8 i | otherwise = error ("[encode] TP_MN " ++ show i) decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) | 0<=(bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]) && (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0])<=255 = (TP_MN (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) | otherwise = error ("[decode] TP_MN " ++ show [b7,b6,b5,b4,b3,b2,b1,b0]) decode _ bits = error ("[decode] TP_MN " ++ show bits) instance Variant TP_MN where valid = do i <- choose (0,255) return(TP_MN i) invalid = valid -------------------------------------------------------------------------------- -- TP-Command-Type (TP-CT) -------------------------------------------------------------------------------- data TP_CT = TP_CT_Enquiry_on_submitted_short_message -- 00000000 SRR==1 | TP_CT_Cancel_status_report_request -- 00000001 SRR==0 | TP_CT_Delete_submitted_short_message -- 00000010 SRR==0 | TP_CT_Enable_status_report_request -- 00000011 SRR==0 | TP_CT_Reserved Int -- 00000100~00011111 SRR=Unspecified | TP_CT_Values_specific_to_SC Int -- 11100000~11111111 SRR=1or0 deriving (Show, Eq) isTP_CT_Enquiry_on_submitted_short_message TP_CT_Enquiry_on_submitted_short_message = True isTP_CT_Enquiry_on_submitted_short_message _ = False isTP_CT_Cancel_status_report_request TP_CT_Cancel_status_report_request = True isTP_CT_Cancel_status_report_request _ = False isTP_CT_Delete_submitted_short_message TP_CT_Delete_submitted_short_message = True isTP_CT_Delete_submitted_short_message _ = False isTP_CT_Enable_status_report_request TP_CT_Enable_status_report_request = True isTP_CT_Enable_status_report_request _ = False isTP_CT_Reserved (TP_CT_Reserved _) = True isTP_CT_Reserved (_) = False isTP_CT_Values_specific_to_SC (TP_CT_Values_specific_to_SC _) = True isTP_CT_Values_specific_to_SC (_) = False instance BitRep TP_CT TP_SRR where encode TP_SRR_Status_Report_Requested TP_CT_Enquiry_on_submitted_short_message = [0,0,0,0,0,0,0,0] encode TP_SRR_No_Status_Report_Requested TP_CT_Cancel_status_report_request = [0,0,0,0,0,0,0,1] encode TP_SRR_No_Status_Report_Requested TP_CT_Delete_submitted_short_message = [0,0,0,0,0,0,1,0] encode TP_SRR_No_Status_Report_Requested TP_CT_Enable_status_report_request = [0,0,0,0,0,0,1,1] encode _ (TP_CT_Reserved i) -- 000 00100 ~ 000 11111 | 4 <= i && i <= 31 = [0,0,0] ++ drop 3 (intToBits8 i) | otherwise = error ("[encode] TP_CT_Reserved "++ show i) encode _ (TP_CT_Values_specific_to_SC i) -- 111 00000 ~ 111 11111 | 0 <= i && i <= 31 = [1,1,1] ++ drop 3 (intToBits8 i) | otherwise = error ("[encode] TP_CT_Values_specific_to_SC "++ show i) decode TP_SRR_Status_Report_Requested (0:0:0:0:0:0:0:0:bits) = (TP_CT_Enquiry_on_submitted_short_message, bits) decode TP_SRR_No_Status_Report_Requested (0:0:0:0:0:0:0:1:bits) = (TP_CT_Cancel_status_report_request, bits) decode TP_SRR_No_Status_Report_Requested (0:0:0:0:0:0:1:0:bits) = (TP_CT_Delete_submitted_short_message, bits) decode TP_SRR_No_Status_Report_Requested (0:0:0:0:0:0:1:1:bits) = (TP_CT_Enable_status_report_request, bits) decode _ (0:0:0:b4:b3:b2:b1:b0:bits) -- 000 00100 ~ 000 11111 | 4 <= (bits8ToInt[0,0,0,b4,b3,b2,b1,b0]) && (bits8ToInt [0,0,0,b4,b3,b2,b1,b0]) <= 31 = (TP_CT_Reserved (bits8ToInt[0,0,0,b4,b3,b2,b1,b0]), bits) | otherwise = error ("[encode] TP_CT_Reserved " ++ show (0:0:0:b4:b3:b2:b1:b0:bits)) decode _ (1:1:1:b4:b3:b2:b1:b0:bits) -- 111 00000 ~ 111 11111 | 0 <= bits8ToInt [0,0,0,b4,b3,b2,b1,b0] && bits8ToInt [0,0,0,b4,b3,b2,b1,b0] <= 31 = (TP_CT_Values_specific_to_SC (bits8ToInt [0,0,0,b4,b3,b2,b1,b0]), bits) | otherwise = error ("[encode] TP_CT_Values_specific_to_SC " ++ show (0:0:0:b4:b3:b2:b1:b0:bits)) instance Variant TP_CT where valid = oneof [ elements [ TP_CT_Enquiry_on_submitted_short_message, TP_CT_Cancel_status_report_request, TP_CT_Delete_submitted_short_message, TP_CT_Enable_status_report_request ], -- 000 00100 ~ 000 11111 liftM TP_CT_Reserved (choose (4,31)), -- 111 00000 ~ 111 11111 liftM TP_CT_Values_specific_to_SC (choose (0,31)) ] invalid = valid -------------------------------------------------------------------------------- -- TP-Command-Data-Length (TP-CDL) -------------------------------------------------------------------------------- data TP_CDL = TP_CDL Int deriving (Show, Eq) instance BitRep TP_CDL a where encode _ (TP_CDL i) = intToBits8 i decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_CDL (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) instance Variant TP_CDL where valid = do i <- choose (0,157) return (TP_CDL i) invalid = valid -------------------------------------------------------------------------------- -- TP-Command-Data (TP-CD) -------------------------------------------------------------------------------- data TP_CD = TP_CD [Int] -- 157 octets deriving (Show, Eq) lenTP_CD (TP_CD octets) = length octets instance BitRep TP_CD TP_CDL where encode (TP_CDL i) (TP_CD octets) | and (map (\x -> 0 <= x && x <= 255) octets) {- TBD : && 0 <= i && i <= 157 -} {- TBD : && length octets == i -} = concat (map intToBits8 octets) | otherwise = error ("[encode] TP_CD "++ show octets) decode (TP_CDL i) bits | True {- TBD : 0 <= i && i <= 157 && i <= length bits * 8 -} = let g n (b7:b6:b5:b4:b3:b2:b1:b0:bits) = let (octets0, bits0) = g (n-1) bits in (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0] : octets0, bits0) g 0 bits = ([], bits) (octets1, bits1) = g i bits in (TP_CD octets1, bits1) | otherwise = error ("[decode] TP_CD "++ show i ++ ", " ++ show bits) instance Variant TP_CD where valid = do len <- choose (0, 157) str <- getRandomText len return (TP_CD (map Char.ord str)) invalid = valid -------------------------------------------------------------------------------- -- TP-Failure-Cause (TP-FCS) -------------------------------------------------------------------------------- data TP_FCS = TP_FCS Int deriving (Show, Eq) instance BitRep TP_FCS a where encode _ (TP_FCS i) = intToBits8 i decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_FCS (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) decode _ bits = error ("[decode] TP_FCS "++ show bits) instance Variant TP_FCS where valid = liftM TP_FCS (choose (0,2^8-1)) invalid = valid -------------------------------------------------------------------------------- -- TP-User-Data-Header-Indicator (TP-UDHI) -------------------------------------------------------------------------------- data TP_UDHI = TP_UDHI Bool deriving (Eq, Show) isTP_UDHI (TP_UDHI b) = b instance BitRep TP_UDHI a where encode _ (TP_UDHI False) = [0] encode _ (TP_UDHI True) = [1] decode _ (0:bits) = (TP_UDHI False, bits) decode _ (1:bits) = (TP_UDHI True, bits) decode _ bits = error ("[decode] TP_UDHI " ++ show bits) instance Variant TP_UDHI where valid = liftM TP_UDHI (elements [ False ]) invalid = valid -------------------------------------------------------------------------------- -- TP-User Data (TP-UD) -------------------------------------------------------------------------------- data TP_UD = TP_UD_NoUDH Int -- UDL String -- Short message | TP_UD_UDH Int -- UDL Int -- UDHL [(Int, Int, [Int])] -- (IEI,IEIDL,IED)* String -- Short message deriving (Show, Eq) isTP_UD_NoUDH (TP_UD_NoUDH _ _) = True isTP_UD_NoUDH (_) = False isTP_UD_UDH (TP_UD_UDH _ _ _ _) = True isTP_UD_UDH (_) = False lenTP_UD (TP_UD_NoUDH udl _) = udl lenTP_UD (TP_UD_UDH udl _ _ _) = udl instance BitRep TP_UD (TP_UDHI, Character_Set) where encode (TP_UDHI False, GSM7Bit) (TP_UD_NoUDH udl short_msg) = intToBits8 udl ++ bytesToGsm7bit short_msg encode (TP_UDHI False, CS_8Bit) (TP_UD_NoUDH udl short_msg) = intToBits8 udl ++ bytesToCS8bit short_msg encode (TP_UDHI False, UCS2_16Bit) (TP_UD_NoUDH udl short_msg) = intToBits8 (udl * 2) ++ bytesToUCS16bit short_msg encode (TP_UDHI True, cs) (TP_UD_UDH udl udhl ieis short_msg) | 0 <= udl && udl <= 255 && 0 <= udhl && udhl <= 255 && and (map (\(iei,ieidl,ieid)-> 0 <= iei && iei <= 255 && 0 <= ieidl && ieidl <= 255) ieis) = intToBits8 udl ++ intToBits8 udhl ++ concat (map (\(iei,ieidl,ieid)-> intToBits8 iei ++ intToBits8 ieidl ++ concat (map intToBits8 ieid)) ieis) ++ concat (map (intToBits8 . Char.ord) short_msg) | otherwise = error ("[encode] TP_UD " ++ ", " ++ show cs ++ ", " ++ show udl ++ ", " ++ show udhl ++ ", " ++ show ieis ++ ", " ++ short_msg) encode (tp_udhi, cs) tp_ud = error ("[encode] TP_UD : " ++ show tp_udhi ++ ", " ++ show cs ++ ", " ++ show tp_ud) decode (TP_UDHI False, GSM7Bit) (b7: b6 : b5 : b4 : b3 : b2 : b1 : b0 : bits) = let len = bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0] (s, bits') = gsm7bitToBytes len bits in (TP_UD_NoUDH len s, bits') decode (TP_UDHI False, CS_8Bit) (b7: b6 : b5 : b4 : b3 : b2 : b1 : b0 : bits) = let len = bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0] (s, bits') = cs8bitToBytes len bits in (TP_UD_NoUDH len s, bits') decode (TP_UDHI False, UCS2_16Bit) (b7: b6 : b5 : b4 : b3 : b2 : b1 : b0 : bits) = let len = bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0] (s, bits') = ucs16bitToBytes (len `div` 2) bits in (TP_UD_NoUDH (len `div` 2) s, bits') decode (tp_udhi, cs) bits = error ("[decode] TP_UD : tp_udhi=" ++ show tp_udhi ++ ", cs=" ++ show cs ++ ", bits=" ++ show bits) instance Variant TP_UD where valid = do maxLen <- elements [140, 158, 159, 140, 151, 152, 160, 140, 70, 255] len <- choose (0, maxLen) str <- getRandomText len return (TP_UD_NoUDH len str) {- TBD : TP_UD_UDH -} invalid = valid -------------------------------------------------------------------------------- -- TP-Reject-Duplicates (TP-RD) -------------------------------------------------------------------------------- data TP_RD = TP_RD Bool deriving (Show, Eq) instance BitRep TP_RD a where encode _ (TP_RD False) = [0] encode _ (TP_RD True) = [1] decode _ (0:bits) = (TP_RD False, bits) decode _ (1:bits) = (TP_RD True, bits) decode _ bits = error ("[decode] TP_RD " ++ show bits) instance Variant TP_RD where valid = liftM TP_RD valid invalid = valid -------------------------------------------------------------------------------- -- TP-Status-Report-Qualifier (TP-SRQ) -------------------------------------------------------------------------------- data TP_SRQ = TP_SRQ Bool deriving (Show, Eq) instance BitRep TP_SRQ a where encode _ (TP_SRQ False) = [0] encode _ (TP_SRQ True) = [1] decode _ (0:bits) = (TP_SRQ False, bits) decode _ (1:bits) = (TP_SRQ True, bits) decode _ bits = error ("[decode] TP_SRQ " ++ show bits) instance Variant TP_SRQ where valid = liftM TP_SRQ valid invalid = valid -------------------------------------------------------------------------------- -- TP-Parameter-Indicator (TP-PI) -------------------------------------------------------------------------------- data TP_PI = TP_PI Bool -- Extension bit Int -- 4 Reserved bits Bool -- TP-UDL Bool -- TP-DCS Bool -- TP-PID deriving (Show, Eq) instance BitRep TP_PI a where encode _ (TP_PI extension i udl dcs pid) | 0 <= i && i <= 15 = let b7 = if extension then 1 else 0 b2 = if udl then 1 else 0 b1 = if dcs then 1 else 0 b0 = if pid then 1 else 0 in [b7] ++ drop 4 (intToBits8 i) ++ [b2,b1,b0] | otherwise = error ("[encode] TP_PI " ++ show extension ++ ", " ++ show i ++ ", " ++ show udl ++ ", " ++ show dcs ++ ", " ++ show pid) decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_PI extension (bits4ToInt [b6,b5,b4,b3]) udl dcs pid, bits) where extension = b7 == 1 udl = b2 == 1 dcs = b1 == 1 pid = b0 == 1 decode _ bits = error ("[decode] TP_PI " ++ show bits) instance Variant TP_PI where valid = liftM5 TP_PI valid (choose (0,2^4-1)) valid valid valid invalid = valid -------------------------------------------------------------------------------- -- TP-UDL -------------------------------------------------------------------------------- data TP_UDL = TP_UDL Int deriving (Eq, Show) instance BitRep TP_UDL a where encode _ (TP_UDL i) | 0 <= i && i <= 2^8-1 = intToBits8 i | otherwise = error ("[encode] TP_UDL : " ++ show i) decode _ (b7:b6:b5:b4:b3:b2:b1:b0:bits) = (TP_UDL (bits8ToInt [b7,b6,b5,b4,b3,b2,b1,b0]), bits) instance Variant TP_UDL where valid = liftM TP_UDL (choose (0,2^8-1)) invalid = valid -------------------------------------------------------------------------------- -- SMS PDUs -------------------------------------------------------------------------------- data SMS_PDU = SMS_Deliver TP_MMS TP_RP TP_UDHI TP_SRI TP_OA TP_PID TP_DCS TP_SCTS TP_UD {- 140 bytes -} | SMS_Deliver_Report_for_RP_NAck TP_UDHI TP_FCS TP_PI (Maybe TP_PID) (Maybe TP_DCS) {- (Maybe TP_UDL) -} (Maybe TP_UD) {- 158 bytes -} | SMS_Deliver_Report_for_RP_Ack TP_UDHI TP_PI TP_SCTS (Maybe TP_PID) (Maybe TP_DCS) {- (Maybe TP_UDL) -} (Maybe TP_UD) {- 159 bytes -} | SMS_Submit TP_RD TP_VPF TP_RP TP_UDHI TP_SRR TP_MR TP_DA TP_PID TP_DCS (Maybe TP_VP) TP_UD {- 140 bytes -} | SMS_Submit_Report_for_RP_NAck TP_UDHI TP_FCS TP_PI TP_SCTS (Maybe TP_PID) (Maybe TP_DCS) {- (Maybe TP_UDL) -} (Maybe TP_UD) {- 151 bytes -} | SMS_Submit_Report_for_RP_Ack TP_UDHI TP_PI TP_SCTS (Maybe TP_PID) (Maybe TP_DCS) {- (Maybe TP_UDL) -} (Maybe TP_UD) {- 152 bytes -} | SMS_Status_Report TP_UDHI TP_MMS TP_SRQ TP_MR TP_RA TP_SCTS TP_DT TP_ST TP_PI (Maybe TP_PID) (Maybe TP_DCS) {- (Maybe TP_UDL) -} (Maybe TP_UD) {- Dependent on TP-DCS GSM alphabet, 7bit : 160 characters 8-bite data : 140 characters UCS2, 16bit : 70 complex characters -} | SMS_Command TP_UDHI TP_SRR TP_MR TP_PID TP_CT TP_MN TP_DA TP_CDL (Maybe TP_CD) {- Dependent on TP-CDL : # of octets -} deriving (Show, Eq) isSMS_Deliver (SMS_Deliver _ _ _ _ _ _ _ _ _) = True isSMS_Deliver (_) = False isSMS_Deliver_Report_for_RP_NAck (SMS_Deliver_Report_for_RP_NAck _ _ _ _ _ _ ) = True isSMS_Deliver_Report_for_RP_NAck (_) = False isSMS_Deliver_Report_for_RP_Ack (SMS_Deliver_Report_for_RP_Ack _ _ _ _ _ _) = True isSMS_Deliver_Report_for_RP_Ack (_) = False isSMS_Submit_Report_for_RP_NAck (SMS_Submit_Report_for_RP_NAck _ _ _ _ _ _ _) = True isSMS_Submit_Report_for_RP_NAck (_) = False isSMS_Submit_Report_for_RP_Ack (SMS_Submit_Report_for_RP_Ack _ _ _ _ _ _) = True isSMS_Submit_Report_for_RP_Ack (_) = False isSMS_Submit (SMS_Submit _ _ _ _ _ _ _ _ _ _ _) = True isSMS_Submit (_) = False isSMS_Status_Report (SMS_Status_Report _ _ _ _ _ _ _ _ _ _ _ _) = True isSMS_Status_Report (_) = False isSMS_Command (SMS_Command _ _ _ _ _ _ _ _ _) = True isSMS_Command (_) = False instance BitRep SMS_PDU (Direction, Maybe Acknowledgement) where encode (MStoSC,Nothing) (SMS_Submit tp_rd tp_vpf tp_rp tp_udhi tp_srr tp_mr tp_da tp_pid tp_dcs maybe_tp_vp tp_ud) = encode () tp_rp ++ encode () tp_udhi ++ encode () tp_srr ++ encode () tp_vpf ++ encode () tp_rd ++ encode (MStoSC, Nothing :: Maybe Acknowledgement) SMS_SUBMIT ++ encode () tp_mr ++ encode () tp_da ++ encode () tp_pid ++ encode () tp_dcs ++ encode (tp_vpf /= TP_VP_Field_Not_Present, tp_vpf) maybe_tp_vp ++ encode (tp_udhi,dcsToCharacterSet tp_dcs) tp_ud encode (SCtoMS,Just Ack) (SMS_Submit_Report_for_RP_Ack tp_udhi tp_pi tp_scts maybe_tp_pid maybe_tp_dcs -- maybe_tp_udl maybe_tp_ud) = let (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi in [0] ++ encode () tp_udhi ++ [0,0,0,0] ++ encode (SCtoMS, Just Ack) SMS_SUBMIT_REPORT_ACK ++ encode () tp_pi ++ encode () tp_scts ++ encode (flag_tp_pid, ()) maybe_tp_pid ++ encode (flag_tp_dcs, ()) maybe_tp_dcs ++ -- encode (flag_tp_udl, ()) maybe_tp_udl ++ encode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -}, (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) maybe_tp_ud encode (SCtoMS,Just NAck) (SMS_Submit_Report_for_RP_NAck tp_udhi tp_fcs tp_pi tp_scts maybe_tp_pid maybe_tp_dcs -- maybe_tp_udl maybe_tp_ud) = let (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi in [0] ++ encode () tp_udhi ++ [0,0,0,0] ++ encode (SCtoMS,Just NAck) SMS_SUBMIT_REPORT_NACK ++ encode () tp_fcs ++ encode () tp_pi ++ encode () tp_scts ++ encode (flag_tp_pid, ()) maybe_tp_pid ++ encode (flag_tp_dcs, ()) maybe_tp_dcs ++ -- encode (flag_tp_udl, ()) maybe_tp_udl ++ encode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -}, (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) maybe_tp_ud encode (SCtoMS, Nothing) (SMS_Deliver tp_mms tp_rp tp_udhi tp_sri tp_oa tp_pid tp_dcs tp_scts tp_ud) = encode () tp_rp ++ encode () tp_udhi ++ encode () tp_sri ++ [0,0] ++ encode () tp_mms ++ encode (SCtoMS, Nothing :: Maybe Acknowledgement) SMS_DELIVER ++ encode () tp_oa ++ encode () tp_pid ++ encode () tp_dcs ++ encode () tp_scts ++ encode (tp_udhi, dcsToCharacterSet tp_dcs) tp_ud encode (MStoSC, Just Ack) (SMS_Deliver_Report_for_RP_Ack tp_udhi tp_pi tp_scts maybe_tp_pid maybe_tp_dcs -- maybe_tp_udl maybe_tp_ud) = let (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi in [0] ++ encode () tp_udhi ++ [0,0,0,0] ++ encode (MStoSC, Just Ack) SMS_DELIVER_REPORT_ACK ++ encode () tp_pi ++ encode () tp_scts ++ encode (flag_tp_pid, ()) maybe_tp_pid ++ encode (flag_tp_dcs, ()) maybe_tp_dcs ++ -- encode (flag_tp_udl, ()) maybe_tp_udl ++ encode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -}, (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) maybe_tp_ud encode (MStoSC, Just NAck) (SMS_Deliver_Report_for_RP_NAck tp_udhi tp_fcs tp_pi maybe_tp_pid maybe_tp_dcs -- maybe_tp_udl maybe_tp_ud) = let (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi in [0] ++ encode () tp_udhi ++ [0,0,0,0] ++ encode (MStoSC, Just NAck) SMS_DELIVER_REPORT_NACK ++ encode () tp_fcs ++ encode () tp_pi ++ encode (flag_tp_pid, ()) maybe_tp_pid ++ encode (flag_tp_dcs, ()) maybe_tp_dcs ++ -- encode (flag_tp_udl, ()) maybe_tp_udl ++ encode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -}, (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) maybe_tp_ud encode (SCtoMS, Nothing) (SMS_Status_Report tp_udhi tp_mms tp_srq tp_mr tp_ra tp_scts tp_dt tp_st tp_pi maybe_tp_pid maybe_tp_dcs -- maybe_tp_udl maybe_tp_ud) = let (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi in [0] ++ encode () tp_udhi ++ encode () tp_srq ++ [0,0] ++ encode () tp_mms ++ encode (SCtoMS, Nothing :: Maybe Acknowledgement) SMS_STATUS_REPORT ++ encode () tp_mr ++ encode () tp_ra ++ encode () tp_scts ++ encode () tp_dt ++ encode () tp_st ++ encode () tp_pi ++ encode (flag_tp_pid, ()) maybe_tp_pid ++ encode (flag_tp_dcs, ()) maybe_tp_dcs ++ -- encode (flag_tp_udl, ()) maybe_tp_udl ++ encode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -}, (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) maybe_tp_ud encode (MStoSC, Nothing) (SMS_Command tp_udhi tp_srr tp_mr tp_pid tp_ct tp_mn tp_da tp_cdl maybe_tp_cd) = [0] ++ encode () tp_udhi ++ encode () tp_srr ++ [0,0,0] ++ encode (MStoSC,Nothing :: Maybe Acknowledgement) SMS_COMMAND ++ encode () tp_mr ++ encode () tp_pid ++ encode (tp_srr) tp_ct ++ encode () tp_mn ++ encode () tp_da ++ encode () tp_cdl ++ encode (tp_cdl /= TP_CDL 0, tp_cdl) maybe_tp_cd encode dir_maybe_ack sms_pdu = error ("[encode] SMS_PDU : " ++ show dir_maybe_ack ++ ", " ++ show sms_pdu) {- MStoSC/Nothing : SMS_SUBMIT, SMS_COMMAND -} decode (MStoSC, Nothing) bits = let (tp_mti, _) = case bits of (b7:b6:b5:b4:b3:b2:b1:b0:bitss) -> decode (MStoSC, Nothing :: Maybe Acknowledgement) (b1:b0:bitss) _ -> error ("[decode] MStoSC/Nothing : " ++ show bits) in case tp_mti of SMS_SUBMIT -> let (tp_rp, bits2) = decode () bits (tp_udhi, bits3) = decode () bits2 (tp_srr, bits4) = decode () bits3 (tp_vpf, bits5) = decode () bits4 (tp_rd, bits6) = decode () bits5 (_, bits7) = decode (MStoSC, Nothing :: Maybe Acknowledgement) bits6 :: (TP_MTI, [Int]) (tp_mr, bits8) = decode () bits7 (tp_da, bits9) = decode () bits8 (tp_pid, bits10) = decode () bits9 (tp_dcs, bits11) = decode () bits10 (maybe_tp_vp, bits12) = decode (tp_vpf /= TP_VP_Field_Not_Present, tp_vpf) bits11 (tp_ud, bits13) = decode (tp_udhi, dcsToCharacterSet tp_dcs) bits12 in (SMS_Submit tp_rd tp_vpf tp_rp tp_udhi tp_srr tp_mr tp_da tp_pid tp_dcs maybe_tp_vp tp_ud, bits13) SMS_COMMAND -> let (_, bits2) = (take 1 bits, drop 1 bits) (tp_udhi, bits3) = decode () bits2 (tp_srr, bits4) = decode () bits3 (_, bits5) = (take 3 bits4, drop 3 bits4) (_, bits6) = decode (MStoSC, Nothing :: Maybe Acknowledgement) bits5 :: (TP_MTI, [Int]) (tp_mr, bits7) = decode () bits6 (tp_pid, bits8) = decode () bits7 (tp_ct, bits9) = decode (tp_srr) bits8 (tp_mn, bits10) = decode () bits9 (tp_da, bits11) = decode () bits10 (tp_cdl, bits12) = decode () bits11 (maybe_tp_cd, bits13) = decode (tp_cdl /= TP_CDL 0, tp_cdl) bits12 in (SMS_Command tp_udhi tp_srr tp_mr tp_pid tp_ct tp_mn tp_da tp_cdl maybe_tp_cd, bits13) _ -> error ("[decode] (MStoSC,Nothing) " ++ show bits) {- MStoSC/Just acknowledgement : SMS_DELIVER_REPORT_ACK/NACK -} decode (MStoSC, Just acknowledgement) bits = let (tp_udhi,(tp_mti, bits1)) = case bits of (b7:b6:b5:b4:b3:b2:b1:b0:bits') -> (fst (decode () (b6:b5:b4:b3:b2:b1:b0:bits')), decode (MStoSC, Just acknowledgement) (b1:b0:bits')) _ -> error ("[decode] SCtoMS " ++ show (Just acknowledgement) ++ ", " ++ show bits) in case tp_mti of SMS_DELIVER_REPORT_ACK -> let (tp_pi, bits2) = decode () bits1 (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi (tp_scts, bits3) = decode () bits2 (maybe_tp_pid, bits4) = decode (flag_tp_pid, ()) bits3 (maybe_tp_dcs, bits5) = decode (flag_tp_dcs, ()) bits4 -- (maybe_tp_udl, bits6) = decode (flag_tp_udl, ()) bits5 bits6 = bits5 (maybe_tp_ud, bits7) = decode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -}, (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) bits6 in (SMS_Deliver_Report_for_RP_Ack tp_udhi tp_pi tp_scts maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud, bits7) SMS_DELIVER_REPORT_NACK -> let (tp_fcs, bits2) = decode () bits1 (tp_pi, bits3) = decode () bits2 (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi (maybe_tp_pid, bits4) = decode (flag_tp_pid, ()) bits3 (maybe_tp_dcs, bits5) = decode (flag_tp_dcs, ()) bits4 -- (maybe_tp_udl, bits6) = decode (flag_tp_udl, ()) bits5 bits6 = bits5 (maybe_tp_ud, bits7) = decode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -} , (tp_udhi, if isJust maybe_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) bits6 in (SMS_Deliver_Report_for_RP_NAck tp_udhi tp_fcs tp_pi maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud, bits7) _ -> error ("[decode] MStoSC : " ++ show tp_mti ++ ", " ++ show (Just acknowledgement) ++ ", " ++ show bits) {- SCtoMS/Nothing : SMS_DELIVER, SMS_STATUS_REPORT -} decode (SCtoMS, Nothing) bits = let (tp_mti,_) = case bits of (b7:b6:b5:b4:b3:b2:b1:b0:bits') -> decode (SCtoMS,Nothing :: Maybe Acknowledgement) (b1:b0:bits') _ -> error ("[decode] (SCtoMS,Nothing) " ++ show bits) in case tp_mti of SMS_DELIVER -> let (tp_rp, bits2) = decode () bits (tp_udhi, bits3) = decode () bits2 (tp_sri, bits4) = decode () bits3 (_, bits5) = (take 2 bits4, drop 2 bits4) (tp_mms, bits6) = decode () bits5 (_, bits7) = decode (SCtoMS, Nothing :: Maybe Acknowledgement) bits6 :: (TP_MTI, [Int]) (tp_oa, bits8) = decode () bits7 (tp_pid, bits9) = decode () bits8 (tp_dcs, bits10) = decode () bits9 (tp_scts, bits11) = decode () bits10 (tp_ud, bits12) = decode (tp_udhi, dcsToCharacterSet tp_dcs) bits11 in (SMS_Deliver tp_mms tp_rp tp_udhi tp_sri tp_oa tp_pid tp_dcs tp_scts tp_ud, bits12) SMS_STATUS_REPORT -> let (_, bits2) = (take 1 bits, drop 1 bits) (tp_udhi, bits3) = decode () bits2 (tp_srq, bits4) = decode () bits3 (_, bits5) = (take 2 bits4, drop 2 bits4) (tp_mms, bits6) = decode () bits5 (_, bits7) = decode (SCtoMS, Nothing :: Maybe Acknowledgement) bits6 :: (TP_MTI, [Int]) (tp_mr, bits8) = decode () bits7 (tp_ra, bits9) = decode () bits8 (tp_scts, bits10) = decode () bits9 (tp_dt, bits11) = decode () bits10 (tp_st, bits12) = decode () bits11 (tp_pi, bits13) = decode () bits12 (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi (maybe_tp_pid, bits14) = decode (flag_tp_pid, ()) bits13 (maybe_tp_dcs, bits15) = decode (flag_tp_dcs, ()) bits14 -- (maybe_tp_udl, bits16) = decode (flag_tp_udl, ()) bits15 bits16 = bits15 (maybe_tp_ud, bits17) = decode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -} , (tp_udhi, if flag_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) bits16 in (SMS_Status_Report tp_udhi tp_mms tp_srq tp_mr tp_ra tp_scts tp_dt tp_st tp_pi maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud, bits17) _ -> error ("[decode] (SCtoMS,Nothing) " ++ show tp_mti ++ ", " ++ show bits) decode (SCtoMS, Just acknowledgement) bits {- SMS_SUBMIT_REPORT_ACK/NACK -} = let (tp_udhi,(tp_mti, bits1)) = case bits of (b7:b6:b5:b4:b3:b2:b1:b0:bits') -> (fst (decode () (b6:b5:b4:b3:b2:b1:b0:bits')), decode (SCtoMS, Just acknowledgement) (b1:b0:bits')) _ -> error ("[decode] SCtoMS " ++ show (Just acknowledgement) ++ ", " ++ show bits) in case tp_mti of SMS_SUBMIT_REPORT_ACK -> let (tp_pi, bits2) = decode () bits1 (tp_scts, bits3) = decode () bits2 (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi (maybe_tp_pid, bits4) = decode (flag_tp_pid, ()) bits3 (maybe_tp_dcs, bits5) = decode (flag_tp_dcs, ()) bits4 -- (maybe_tp_udl, bits6) = decode (flag_tp_udl, ()) bits5 bits6 = bits5 (maybe_tp_ud, bits7) = decode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -} , (tp_udhi, if flag_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) bits6 in (SMS_Submit_Report_for_RP_Ack tp_udhi tp_pi tp_scts maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud, bits7) SMS_SUBMIT_REPORT_NACK -> let (tp_fcs, bits2) = decode () bits1 (tp_pi, bits3) = decode () bits2 (tp_scts, bits4) = decode () bits3 (TP_PI ext_bit reserved_4bits flag_tp_udl flag_tp_dcs flag_tp_pid) = tp_pi (maybe_tp_pid, bits5) = decode (flag_tp_pid, ()) bits4 (maybe_tp_dcs, bits6) = decode (flag_tp_dcs, ()) bits5 -- (maybe_tp_udl, bits7) = decode (flag_tp_udl, ()) bits6 bits7 = bits6 (maybe_tp_ud, bits8) = decode (flag_tp_udl {- && fromJust maybe_tp_udl /= TP_UDL 0 -} , (tp_udhi, if flag_tp_dcs then dcsToCharacterSet (fromJust maybe_tp_dcs) else GSM7Bit)) bits7 in (SMS_Submit_Report_for_RP_NAck tp_udhi tp_fcs tp_pi tp_scts maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl-} maybe_tp_ud, bits8) _ -> error ("[decode] SCtoMS : " ++ show tp_mti ++ ", " ++ show (Just acknowledgement) ++ ", " ++ show bits) instance Variant SMS_PDU where valid = let genSmsSubmit = do tp_rd <- valid :: Gen TP_RD tp_vpf <- valid tp_rp <- valid tp_udhi <- valid tp_srr <- valid tp_mr <- valid tp_da <- valid tp_pid <- valid tp_dcs <- valid maybe_tp_vp <- valid `suchThat` (\maybe_tp_vp -> isTP_VP_Field_Not_Present tp_vpf && isNothing maybe_tp_vp || isTP_VP_Field_Present_Relative tp_vpf && isJust maybe_tp_vp && isTP_VP_Relative (fromJust maybe_tp_vp) || isTP_VP_Field_Present_Absolute tp_vpf && isJust maybe_tp_vp && isTP_VP_Absolute (fromJust maybe_tp_vp) || isTP_VP_Field_Present_Enhanced tp_vpf && isJust maybe_tp_vp && isTP_VP_Enhanced (fromJust maybe_tp_vp) ) tp_ud <- valid `suchThat` (\tp_ud -> isTP_UDHI tp_udhi==False && isTP_UD_NoUDH tp_ud && lenTP_UD tp_ud * (dcsToBytesPerChar tp_dcs) <= 140 || isTP_UDHI tp_udhi==True && isTP_UD_UDH tp_ud && lenTP_UD tp_ud * (dcsToBytesPerChar tp_dcs) <= 140) return (SMS_Submit tp_rd tp_vpf tp_rp tp_udhi tp_srr tp_mr tp_da tp_pid tp_dcs maybe_tp_vp tp_ud) genSmsSubmitRpAck = do tp_udhi <- valid tp_pi@(TP_PI ext_bit reserved_int flag_tp_udl flag_tp_dcs flag_tp_pid) <- valid tp_scts <- valid maybe_tp_pid <- valid `suchThat` (\maybe_tp_pid -> flag_tp_pid==True && isJust maybe_tp_pid || flag_tp_pid==False && isNothing maybe_tp_pid) maybe_tp_dcs <- valid `suchThat` (\maybe_tp_dcs -> flag_tp_dcs==True && isJust maybe_tp_dcs || flag_tp_dcs==False && isNothing maybe_tp_dcs) -- maybe_tp_udl <- valid `suchThat` -- (\maybe_tp_udl -> -- flag_tp_udl==True && isJust maybe_tp_udl -- || flag_tp_udl==False && isNothing maybe_tp_udl) maybe_tp_ud <- valid `suchThat` (\maybe_tp_ud -> flag_tp_udl==True && isJust maybe_tp_ud && lenTP_UD (fromJust maybe_tp_ud) * (if flag_tp_dcs && isJust maybe_tp_dcs then dcsToBytesPerChar (fromJust maybe_tp_dcs) else 1) <= 152 || flag_tp_udl==False && isNothing maybe_tp_ud) return (SMS_Submit_Report_for_RP_Ack tp_udhi tp_pi tp_scts maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud) genSmsSubmitRpNack = do tp_udhi <- valid tp_fcs <- valid tp_pi@(TP_PI ext_bit reserved_int flag_tp_udl flag_tp_dcs flag_tp_pid) <- valid tp_scts <- valid maybe_tp_pid <- valid `suchThat` (\maybe_tp_pid -> flag_tp_pid==True && isJust maybe_tp_pid || flag_tp_pid==False && isNothing maybe_tp_pid) maybe_tp_dcs <- valid `suchThat` (\maybe_tp_dcs -> flag_tp_dcs==True && isJust maybe_tp_dcs || flag_tp_dcs==False && isNothing maybe_tp_dcs) -- maybe_tp_udl <- valid `suchThat` -- (\maybe_tp_udl -> -- flag_tp_udl==True && isJust maybe_tp_udl -- || flag_tp_udl==False && isNothing maybe_tp_udl) maybe_tp_ud <- valid `suchThat` (\maybe_tp_ud -> flag_tp_udl==True && isJust maybe_tp_ud && lenTP_UD (fromJust maybe_tp_ud) * (if flag_tp_dcs && isJust maybe_tp_dcs then dcsToBytesPerChar (fromJust maybe_tp_dcs) else 1)<= 151 || flag_tp_udl==False && isNothing maybe_tp_ud) return (SMS_Submit_Report_for_RP_NAck tp_udhi tp_fcs tp_pi tp_scts maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud) genSmsDeliver = do tp_mms <- valid tp_rp <- valid tp_udhi <- valid tp_sri <- valid tp_oa <- valid tp_pid <- valid tp_dcs <- valid tp_scts <- valid tp_ud <- valid `suchThat` (\tp_ud -> isTP_UDHI tp_udhi==False && isTP_UD_NoUDH tp_ud && lenTP_UD tp_ud * dcsToBytesPerChar tp_dcs <= 140 || isTP_UDHI tp_udhi==True && isTP_UD_UDH tp_ud && lenTP_UD tp_ud * dcsToBytesPerChar tp_dcs <= 140) return (SMS_Deliver tp_mms tp_rp tp_udhi tp_sri tp_oa tp_pid tp_dcs tp_scts tp_ud) genSmsDeliverRpAck = do tp_udhi <- valid tp_pi@(TP_PI ext_bit reserved_int flag_tp_udl flag_tp_dcs flag_tp_pid) <- valid tp_scts <- valid maybe_tp_pid <- valid `suchThat` (\maybe_tp_pid -> flag_tp_pid==True && isJust maybe_tp_pid || flag_tp_pid==False && isNothing maybe_tp_pid) maybe_tp_dcs <- valid `suchThat` (\maybe_tp_dcs -> flag_tp_dcs==True && isJust maybe_tp_dcs || flag_tp_dcs==False && isNothing maybe_tp_dcs) -- maybe_tp_udl <- valid `suchThat` -- (\maybe_tp_udl -> -- flag_tp_udl==True && isJust maybe_tp_udl -- || flag_tp_udl==False && isNothing maybe_tp_udl) maybe_tp_ud <- valid `suchThat` (\maybe_tp_ud -> flag_tp_udl==True && isJust maybe_tp_ud && lenTP_UD (fromJust maybe_tp_ud) * (if flag_tp_dcs && isJust maybe_tp_dcs then dcsToBytesPerChar (fromJust maybe_tp_dcs) else 1) <= 159 || flag_tp_udl==False && isNothing maybe_tp_ud) return (SMS_Deliver_Report_for_RP_Ack tp_udhi tp_pi tp_scts maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud) genSmsDeliverRpNack = do tp_udhi <- valid tp_fcs <- valid tp_pi@(TP_PI ext_bit reserved_int flag_tp_udl flag_tp_dcs flag_tp_pid) <- valid maybe_tp_pid <- valid `suchThat` (\maybe_tp_pid -> flag_tp_pid==True && isJust maybe_tp_pid || flag_tp_pid==False && isNothing maybe_tp_pid) maybe_tp_dcs <- valid `suchThat` (\maybe_tp_dcs -> flag_tp_dcs==True && isJust maybe_tp_dcs || flag_tp_dcs==False && isNothing maybe_tp_dcs) -- maybe_tp_udl <- valid `suchThat` -- (\maybe_tp_udl -> -- flag_tp_udl==True && isJust maybe_tp_udl -- || flag_tp_udl==False && isNothing maybe_tp_udl) maybe_tp_ud <- valid `suchThat` (\maybe_tp_ud -> flag_tp_udl==True && isJust maybe_tp_ud && lenTP_UD (fromJust maybe_tp_ud) * (if flag_tp_dcs && isJust maybe_tp_dcs then dcsToBytesPerChar (fromJust maybe_tp_dcs) else 1) <= 158 || flag_tp_udl==False && isNothing maybe_tp_ud) return (SMS_Deliver_Report_for_RP_NAck tp_udhi tp_fcs tp_pi maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud) genSmsStatusReport = do tp_udhi <- valid tp_mms <- valid tp_srq <- valid tp_mr <- valid tp_ra <- valid tp_scts <- valid tp_dt <- valid tp_st <- valid tp_pi@(TP_PI ext_bit reserved_int flag_tp_udl flag_tp_dcs flag_tp_pid) <- valid maybe_tp_pid <- valid `suchThat` (\maybe_tp_pid -> flag_tp_pid==True && isJust maybe_tp_pid || flag_tp_pid==False && isNothing maybe_tp_pid) maybe_tp_dcs <- valid `suchThat` (\maybe_tp_dcs -> flag_tp_dcs==True && isJust maybe_tp_dcs || flag_tp_dcs==False && isNothing maybe_tp_dcs) -- maybe_tp_udl <- valid `suchThat` -- (\maybe_tp_udl -> -- flag_tp_udl==True && isJust maybe_tp_udl -- || flag_tp_udl==False && isNothing maybe_tp_udl) maybe_tp_ud <- valid `suchThat` (\maybe_tp_ud -> flag_tp_udl==True && isJust maybe_tp_ud && lenTP_UD (fromJust maybe_tp_ud) * (if flag_tp_dcs && isJust maybe_tp_dcs then dcsToBytesPerChar (fromJust maybe_tp_dcs) else 1) <= 160 || flag_tp_udl==False && isNothing maybe_tp_ud) return (SMS_Status_Report tp_udhi tp_mms tp_srq tp_mr tp_ra tp_scts tp_dt tp_st tp_pi maybe_tp_pid maybe_tp_dcs {- maybe_tp_udl -} maybe_tp_ud) genSmsCommand = do tp_udhi <- valid tp_srr <- valid tp_mr <- valid tp_pid <- valid tp_ct <- valid `suchThat` (\tp_ct -> isTP_CT_Enquiry_on_submitted_short_message tp_ct && isTP_SRR_Status_Report_Requested tp_srr || isTP_CT_Cancel_status_report_request tp_ct && isTP_SRR_No_Status_Report_Requested tp_srr || isTP_CT_Delete_submitted_short_message tp_ct && isTP_SRR_No_Status_Report_Requested tp_srr || isTP_CT_Enable_status_report_request tp_ct && isTP_SRR_No_Status_Report_Requested tp_srr || isTP_CT_Reserved tp_ct || isTP_CT_Values_specific_to_SC tp_ct) tp_mn <- valid tp_da <- valid tp_cdl <- valid maybe_tp_cd <- valid `suchThat` (\maybe_tp_cd -> case tp_cdl of TP_CDL len -> len == 0 && isNothing maybe_tp_cd || len > 0 && isJust maybe_tp_cd && lenTP_CD (fromJust maybe_tp_cd) == len) -- Could be too slow to generate! return (SMS_Command tp_udhi tp_srr tp_mr tp_pid tp_ct tp_mn tp_da tp_cdl maybe_tp_cd) in oneof [ genSmsSubmit, genSmsSubmitRpAck, genSmsSubmitRpNack, genSmsDeliver, genSmsDeliverRpAck, genSmsDeliverRpNack, genSmsStatusReport, genSmsCommand ] invalid = valid -------------------------------------------------------------------------------- -- SMSC Information -------------------------------------------------------------------------------- data SMSC_Information = SMSC_Information AddrFields deriving (Show, Eq) instance BitRep SMSC_Information a where encode _ (SMSC_Information addrfields) = encode () addrfields decode _ bits = let (addrfields,bits') = decode () bits in (SMSC_Information addrfields, bits') instance Variant SMSC_Information where valid = liftM SMSC_Information valid invalid = valid data SMS_Pdu_With_SMSC = SMS_Pdu_With_SMSC SMSC_Information SMS_PDU deriving (Show, Eq) instance BitRep SMS_Pdu_With_SMSC (Direction, Maybe Acknowledgement) where encode (dir, maybe_acknow) (SMS_Pdu_With_SMSC smsc sms_pdu) = encode () smsc ++ encode (dir,maybe_acknow) sms_pdu decode (dir, maybe_acknow) bits = let (smsc, bits1) = decode () bits (sms_pdu, bits2) = decode (dir, maybe_acknow) bits1 in (SMS_Pdu_With_SMSC smsc sms_pdu, bits2) instance Variant SMS_Pdu_With_SMSC where valid = liftM2 SMS_Pdu_With_SMSC valid valid invalid = valid -------------------------------------------------------------------------------- -- Test Suite -------------------------------------------------------------------------------- data OptionArg = Normal | GenC | Send test_suite option = let f (sms_pdu,i) = let (dir,ack) = if isSMS_Submit sms_pdu then (MStoSC, Nothing :: Maybe Acknowledgement) else if isSMS_Deliver sms_pdu then (SCtoMS, Nothing :: Maybe Acknowledgement) else if isSMS_Deliver_Report_for_RP_Ack sms_pdu then (MStoSC, Just Ack) else if isSMS_Deliver_Report_for_RP_NAck sms_pdu then (MStoSC, Just NAck) else if isSMS_Submit_Report_for_RP_Ack sms_pdu then (SCtoMS, Just Ack) else if isSMS_Submit_Report_for_RP_NAck sms_pdu then (SCtoMS, Just NAck) else if isSMS_Status_Report sms_pdu then (SCtoMS, Nothing) else if isSMS_Command sms_pdu then (MStoSC, Nothing) else error ("[test_suite] Not Supported : " ++ show sms_pdu) bits = encode (dir,ack) sms_pdu (sms_pdu',bits') = decode (dir,ack) bits sanity_test = sms_pdu == sms_pdu' && bits' == [] in (i, (sms_pdu, bits, sms_pdu', bits', sanity_test)) toCHex (b7:b6:b5:b4:b3:b2:b1:b0:hexs) = do putStr ( "0x" ++ [bits4ToHexdigit [b7,b6,b5,b4]] ++ [bits4ToHexdigit [b3,b2,b1,b0]] ) (if null hexs then return () else do { putStr ", "; toCHex hexs }) toCHex [] = return () g GenC (i, (sms_pdu, bits, sms_pdu', bits', sanity_test)) = do putStrLn ("/* sms_pdu" ++ show i) putStrLn (show sms_pdu) putStrLn (each8Bits bits) putStrLn "*/" putStrLn ("int sms_pdu_len" ++ show i ++ " = " ++ show (length bits `div` 8) ++ ";\n" ) putStrLn ("char sms_pdu" ++ show i ++ "[]= {") toCHex bits putStrLn "};" (if sanity_test then putStrLn "" else putStrLn ("\n" ++ show sms_pdu' ++ "\n" ++ show bits')) g Normal (i, (sms_pdu, bits, sms_pdu', bits', sanity_test)) = do putStrLn (show sms_pdu) putStrLn "->" putStrLn (bitsToHexString bits) (if sanity_test then putStrLn "" else putStrLn ("\n" ++ show sms_pdu' ++ "\n" ++ show bits')) g Send (i, (sms_pdu, bits, sms_pdu', bits', sanity_test)) = do let hexstr = bitsToHexString bits putStrLn (show sms_pdu) putStrLn "->" putStrLn hexstr (if sanity_test then send (length hexstr) hexstr else putStrLn ("\n" ++ show sms_pdu' ++ "\n" ++ show bits')) -- send len s_hexstr = -- do h <- openFile "/dev/emr" WriteMode -- let msg = concat -- [ -- "LiMo.Test.SmsPdu.Event1", " ", "2", "\n", -- "int", " ", show len, "\n", -- "string", " ", s_hexstr, "\n"] -- putStr msg -- hPutStr h msg -- hClose h in do sms_pdus1 <- mysample (valid :: Gen SMS_PDU) let sms_pdus = sms_pdus1 mapM_ (g option . f) (zip sms_pdus [1..]) -- | Generates some example values. mysample :: Gen a -> IO [a] mysample (MkGen m) = do rnd <- newStdGen let rnds rnd = rnd1 : rnds rnd2 where (rnd1,rnd2) = split rnd return [(m r n) | (r,n) <- rnds rnd `zip` [0,2..200] ] send len s_hexstr = do h <- openFile "/dev/emr" WriteMode let msg = concat [ "LiMo.Test.SmsPdu.Event1", " ", "2", "\n", "int", " ", show len, "\n", "string", " ", s_hexstr, "\n" ] putStr msg myHPutStr h msg hFlush h hClose h each8Bits [] = "" each8Bits (b7:b6:b5:b4:b3:b2:b1:b0:bits) = show (b7:b6:b5:b4:b3:b2:b1:b0:[]) ++ " : " ++ bitsToHexString (b7:b6:b5:b4:b3:b2:b1:b0:[]) ++ "\n" ++ each8Bits bits myHPutStr h [] = return () myHPutStr h (c:cs) = do hPutChar h c myHPutStr h cs {- SMS_Command (TP_UDHI False) TP_SRR_Status_Report_Requested (TP_MR 18) (TP_PID TP_PID_Bits7_6_SC_specific_use (TP_PID_Bits5_0_SC_Specific_Use 43)) (TP_CT_Reserved 9) (TP_MN 192) (TP_DA (AddrFields (AddrLen 5) (TypeOfAddr TON_Internation_number NPI_Private_numbering_plan) (AddrValue "984a6"))) (TP_CDL 80) (Just (TP_CD [89,111,117,32,97,114,101,32,100,105,115,104,111,110,101,115,116,44,32,98,117,116,32,110,101,118,101,114,32,116,111,32,116,104,101,32,112,111,105,110,116,32,111,102,32,104,117,114,116,105,110,103,32,97,32,102,114,105,101,110,100,46,89,111,117,32,97,114,101,32,99,97,112,97,98,108,101,32,111,102])) LiMo.Test.SmsPdu.Event1 2 int 182 string 2212EB09C0059989C4F650596F752061726520646973686F6E6573742C20627574206E6576657220746F2074686520706F696E74206F662068757274696E67206120667269656E642E596F75206172652063617061626C65206F66 -} {- TODO : Relative => decomposition (Not so important!) -} -------------------------------------------------------------------------------- -- Examples -------------------------------------------------------------------------------- -- sample_sms_submit = -- SMS_Submit -- (TP_RD False) -- TP_VP_Field_Present_Relative -- (TP_RP False) -- (TP_UDHI False) -- TP_SRR_No_Status_Report_Requested -- (TP_MR 10) -- (TP_DA -- (AddrFields (AddrLen 11) -- (TypeOfAddr TON_Unknown NPI_ISDN_Tel_numbering_plan) -- (AddrValue "01022188990"))) -- (TP_PID -- TP_PID_Bits7_6_00 -- (TP_PID_Bit5_Bits4_0 -- TP_PID_Bit5_Sme_to_sme_protocol -- (TP_PID_Bits4_0_STSP 0))) -- (TP_DCS_General False False Class0 GSM7Bit) -- (Just (TP_VP_Relative 167)) -- (TP_UD_NoUDH 11 "Hello World") -- sample_sms_submit_rp_ack = -- SMS_Submit_Report_for_RP_Ack -- (TP_UDHI False) -- (TP_PI False 0 False False False) -- (TP_SCTS 9 12 25 0 0 0 9) -- Nothing -- Nothing -- Nothing -- Nothing -- sample_sms_submit_rp_nack = -- SMS_Submit_Report_for_RP_NAck -- (TP_UDHI False) -- (TP_FCS (8*16 + 15)) -- (TP_PI False 0 False False False) -- (TP_SCTS 10 2 12 0 0 0 9) -- Nothing -- Nothing -- Nothing -- Nothing -- sample_sms_deliver = -- SMS_Deliver -- TP_MMS_No_More_Messages -- (TP_RP False) -- (TP_UDHI False) -- TP_SRI_No_Status_Report_Indication -- (TP_OA -- (AddrFields (AddrLen 11) -- (TypeOfAddr TON_Unknown NPI_ISDN_Tel_numbering_plan) -- (AddrValue "01022188990"))) -- (TP_PID -- TP_PID_Bits7_6_00 -- (TP_PID_Bit5_Bits4_0 -- TP_PID_Bit5_Sme_to_sme_protocol -- (TP_PID_Bits4_0_STSP 0))) -- (TP_DCS_General False False Class0 GSM7Bit) -- (TP_SCTS 9 12 25 0 0 0 9) -- (TP_UD_NoUDH 11 "Hello World") -- sample_sms_deliver_rep_ack = -- SMS_Deliver_Report_for_RP_Ack -- (TP_UDHI False) -- (TP_PI False 0 False False False) -- (TP_SCTS 9 12 25 0 0 0 9) -- Nothing -- (Maybe TP_PID) -- Nothing -- (Maybe TP_DCS) -- Nothing -- (Maybe TP_UDL) -- Nothing -- (Maybe TP_UD) -- sample_sms_deliver_rep_nack = -- SMS_Deliver_Report_for_RP_NAck -- SMS-DELIVER-REPORT for RP-ERROR and Rp-ACK -- (TP_UDHI False) -- (TP_FCS (13*16 + 0)) -- (TP_PI False 0 False False False) -- Nothing -- (Maybe TP_PID) -- Nothing -- (Maybe TP_DCS) -- Nothing -- (Maybe TP_UDL) -- Nothing -- (Maybe TP_UD) -- sample_sms_deliver_bits = "040BC87238880900F10000993092516195800AE8329BFD4697D9EC37" -- test_suite1 = -- [ -- decode (MStoSC,Nothing :: Maybe Acknowledgement) (encode (MStoSC,Nothing :: Maybe Acknowledgement) sample_sms_submit), -- decode (SCtoMS, Just Ack) (encode (SCtoMS, Just Ack) sample_sms_submit_rp_ack), -- decode (SCtoMS,Just NAck) (encode (SCtoMS,Just NAck) sample_sms_submit_rp_nack), -- decode (SCtoMS,Nothing::Maybe Acknowledgement) (encode (SCtoMS,Nothing::Maybe Acknowledgement) sample_sms_deliver), -- decode (MStoSC,Just Ack) (encode (MStoSC,Just Ack) sample_sms_deliver_rep_ack), -- decode (MStoSC,Just NAck) (encode (MStoSC,Just NAck) sample_sms_deliver_rep_nack) -- ] :: [ (SMS_PDU, [Int]) ] {- SMS_Status_Report (TP_UDHI False) TP_MMS_No_More_Messages (TP_SRQ False) (TP_MR 62) (TP_RA (AddrFields (AddrLen 7) (TypeOfAddr TON_Unknown NPI_National_numbering_plan) (AddrValue "49b89#a"))) (TP_SCTS 0 94 0 12 84 60 64) (TP_DT 74 30 47 17 15 47 (-5)) (TP_ST_Temporary_failure_Reserved2 13) (TP_PI True 8 True True True) (Just (TP_PID TP_PID_Bits7_6_01 (TP_PID_Bits5_0_ (TP_PID_Bits5_0_Reserved100000_111011 39)))) (Just (TP_DCS_General True False Class3 CS_8Bit)) (Just (TP_UD_NoUDH 104 "Q:\tWhat happens if you've got TWO flats?\nA:\tThey replace your generator.I don't know half of you half as")) LiMo.Test.SmsPdu.Event1 2 int 262 string 063E0788948DA9FC00490021480646470374715174586DC7672768513A09576861742068617070656E7320696620796F7527766520676F742054574F20666C6174733F0A413A0954686579207265706C61636520796F75722067656E657261746F722E4920646F6E2774206B6E6F772068616C66206F6620796F752068616C66206173 -} -- aa = send 262 "063E0788948DA9FC00490021480646470374715174586DC7672768513A09576861742068617070656E7320696620796F7527766520676F742054574F20666C6174733F0A413A0954686579207265706C61636520796F75722067656E657261746F722E4920646F6E2774206B6E6F772068616C66206F6620796F752068616C66206173\x00" -- bbb = encode (SCtoMS, Nothing::Maybe Acknowledgement) (SMS_Status_Report (TP_UDHI False) TP_MMS_No_More_Messages (TP_SRQ False) (TP_MR 62) (TP_RA (AddrFields (AddrLen 7) (TypeOfAddr TON_Unknown NPI_National_numbering_plan) (AddrValue "49b89#a"))) (TP_SCTS 0 94 0 12 84 60 64) (TP_DT 74 30 47 17 15 47 (-5)) (TP_ST_Temporary_failure_Reserved2 13) (TP_PI True 8 True True True) (Just (TP_PID TP_PID_Bits7_6_01 (TP_PID_Bits5_0_ (TP_PID_Bits5_0_Reserved100000_111011 39)))) (Just (TP_DCS_General True False Class3 CS_8Bit)) (Just (TP_UD_NoUDH 104 "Q:\tWhat happens if you've got TWO flats?\nA:\tThey replace your generator.I don't know half of you half as"))) {- SMS_Submit (TP_RD True) TP_VP_Field_Present_Relative (TP_RP True) (TP_UDHI False) TP_SRR_Status_Report_Requested (TP_MR 55) (TP_DA (AddrFields (AddrLen 16) (TypeOfAddr TON_Internation_number NPI_Telex_numbering_plan) (AddrValue "189*55080bc5911*"))) (TP_PID TP_PID_Bits7_6_00 (TP_PID_Bit5_Bits4_0 TP_PID_Bit5_Sme_to_sme_protocol (TP_PID_Bits4_0_STSP 23))) (TP_DCS_MWIG_Store_Msg_UnCompressed_UCS2 False OtherMsgWaiting) (Just (TP_VP_Relative 176)) (TP_UD_NoUDH 30 "You will have good luck and ov") -> B537109481B95580D05E19B117E3B01E0059006F0075002000770069006C006C0020006800610076006500200067006F006F00640020006C00750063006B00200061006E00640020006F0076 -} -- ddd = send 152 "B537109481B95580D05E19B117E3B01E0059006F0075002000770069006C006C0020006800610076006500200067006F006F00640020006C00750063006B00200061006E00640020006F0076\x00" -- iddd = length "B537109481B95580D05E19B117E3B01E0059006F0075002000770069006C006C0020006800610076006500200067006F006F00640020006C00750063006B00200061006E00640020006F0076" paper_example = SMS_Submit (TP_RD True) TP_VP_Field_Present_Absolute (TP_RP True) (TP_UDHI False) TP_SRR_Status_Report_Requested (TP_MR 122) (TP_DA (AddrFields (AddrLen 8) (TypeOfAddr TON_Alphanumeric_gsm7bit NPI_Service_center_specific_plan2) (AddrValue "a01b*7a2"))) (TP_PID TP_PID_Bits7_6_00 (TP_PID_Bit5_Bits4_0 TP_PID_Bit5_Telematic_interworking TP_PID_Bits4_0_Specific_to_SC6)) (TP_DCS_General False False Class3 GSM7Bit) (Just (TP_VP_Absolute 59 11 15 12 12 41 33)) (TP_UD_NoUDH 3 "You")